Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

RGB calculation tool

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • RGB calculation tool

    I have been playing with custom colors lately and needed a tool to quickly
    view and calculate the RGB() values. I searched the forums and couldn't
    find one, so I made one. It's kinda neat, so I thought I would share.

    It is also an example of using multiple horizontal scrollbars.

    Enjoy!

    Code:
    '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~
    '  RGB Calculator          - by William Burns   revised on 01/24/2003
    '
    '  A simple tool to help program with RGB colors
    '
    '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    #INCLUDE "win32api.inc"
    %FRAME1             = 100
    %LABRGB             = 110
    %LABCOLOR           = 120
    %LABBLUE            = 130
    %LABGREEN           = 135
    %LABRED             = 140
    %HSCROLLR           = 151
    %HSCROLLG           = 152
    %HSCROLLB           = 153
    %TXTR               = 161
    %TXTG               = 162
    %TXTB               = 163
    %BUTCOPY            = 220
    %BUTCOPYVAL         = 230
    %BUTCLOSE           = 240
    DECLARE CALLBACK FUNCTION DlgProc
    GLOBAL hDlg    AS LONG
    '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~
    FUNCTION PBMAIN
       DIALOG NEW 0, "RGB calculator", 0, 0,  219,  167, %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER, 0 TO hDlg
       CONTROL ADD FRAME, hDlg,  %FRAME1,  "Color Mix", 2, 10, 214, 66, %WS_CHILD OR %WS_VISIBLE OR %BS_GROUPBOX, %WS_EX_TRANSPARENT
       CONTROL ADD LABEL, hDlg,  %LABRGB,  "RGB(0, 0, 0) = &&H0001", 10, 145, 140, 12, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
       CONTROL ADD LABEL, hDlg,  %LABCOLOR,  $CRLF + $CRLF + "Color", 5, 81, 80, 59, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_CLIENTEDGE
       CONTROL ADD LABEL, hDlg,  %LABBLUE,  "Blue", 192, 59, 19, 12, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
       CONTROL ADD LABEL, hDlg,  %LABGREEN,  "Green", 192, 42, 19, 12, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
       CONTROL ADD LABEL, hDlg,  %LABRED,  "Red", 192, 25, 19, 7, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
       CONTROL ADD SCROLLBAR, hDlg,  %HSCROLLR,  "", 5, 22, 157, 10, %WS_CHILD OR %WS_VISIBLE OR %SBS_HORZ
       CONTROL ADD SCROLLBAR, hDlg,  %HSCROLLG,  "", 5, 39, 157, 10, %WS_CHILD OR %WS_VISIBLE OR %SBS_HORZ
       CONTROL ADD SCROLLBAR, hDlg,  %HSCROLLB,  "", 5, 57, 157, 10, %WS_CHILD OR %WS_VISIBLE OR %SBS_HORZ
       CONTROL ADD TEXTBOX, hDlg,  %TXTR,  " 15", 165, 22, 21, 12, %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
       CONTROL ADD TEXTBOX, hDlg,  %TXTG,  " 150", 165, 39, 21, 12, %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
       CONTROL ADD TEXTBOX, hDlg,  %TXTB,  " 150", 165, 57, 21, 12, %WS_CHILD OR %WS_VISIBLE OR %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
       CONTROL ADD "Button", hDlg,  %BUTCOPY,  "&Copy RGB statement to clipboard", 93, 81, 123, 15, %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP
       CONTROL ADD "Button", hDlg,  %BUTCOPYVAL,  "Copy RGB &value to clipboard", 93, 101, 123, 15, %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP
       CONTROL ADD "Button", hDlg,  %BUTCLOSE,  "&Close", 163, 140, 53, 15, %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP
       CONTROL SET COLOR hDlg, %LABRED, &H0FF, -1
       CONTROL SET COLOR hDlg, %LABGREEN, &H0FF00, -1
       CONTROL SET COLOR hDlg, %LABBLUE, &H0FF0000, -1
       DIALOG SHOW MODAL hDlg, CALL DlgProc
    END FUNCTION
    '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~
    FUNCTION SendClipBoardText(sText AS STRING) AS LONG
       LOCAL hData AS LONG
       LOCAL hGlob AS LONG
       hData = GlobalAlloc(%GMEM_MOVEABLE OR %GMEM_DDESHARE, LEN(sText)+1)
       hGlob = GlobalLock(hData)
       POKE$ hGlob, sText + CHR$(0)
       GlobalUnlock hData
       IF OpenClipboard(%NULL) THEN
          EmptyClipboard
          FUNCTION = SetClipboardData(%CF_TEXT, hData)
          CloseClipboard
       ELSE
          GlobalFree hData
       END IF
    END FUNCTION
    '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~
    SUB UpdateRGB(BYVAL iRed AS LONG, BYVAL iGreen AS LONG, BYVAL iBlue AS LONG)
       CONTROL SET TEXT hDlg, %LABRGB, "RGB(" + FORMAT$(iRed) + "," + STR$(iGreen) + "," + STR$(iBlue) + ") = &&H0" + HEX$(RGB(iRed, iGreen, iBlue))
       IF (iRed + iGreen + iBlue) > 400 THEN
          CONTROL SET COLOR hDlg, %LABCOLOR, %BLACK, RGB(iRed, iGreen, iBlue)
       ELSE
          CONTROL SET COLOR hDlg, %LABCOLOR, %WHITE, RGB(iRed, iGreen, iBlue)
       END IF
       CONTROL REDRAW hDlg, %LABCOLOR
    END SUB
    '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~
    CALLBACK FUNCTION DlgProc
       LOCAL iID         AS LONG
       LOCAL iCounter    AS LONG
       LOCAL sText       AS STRING
       STATIC iColor()   AS LONG  'store each scrollbar position
       STATIC iBar()     AS LONG  'store true scrollbar handles
       SELECT CASE CBMSG
          CASE %WM_INITDIALOG
             REDIM iColor(1:3)
             REDIM iBar(1:3)
             iColor(1) = 15
             iColor(2) = 150
             iColor(3) = 150
             FOR iCounter = 1 TO 3
                CONTROL HANDLE CBHNDL, 150 + iCounter TO iBar(iCounter)
                SetScrollRange iBar(iCounter), %SB_CTL, 0, 255, %FALSE
                SetScrollPos iBar(iCounter),   %SB_CTL, iColor(iCounter), %TRUE
             NEXT iCounter
             CALL UpdateRGB(iColor(1), iColor(2), iColor(3))
          CASE %WM_HSCROLL
             iID = GetDlgCtrlID(CBLPARAM) - 150     'get the correct scroll bar
             SELECT CASE LOWRD(CBWPARAM)
                CASE %SB_LINERIGHT : INCR iColor(iID)
                CASE %SB_PAGERIGHT : iColor(iID) = iColor(iID) + 32
                CASE %SB_LINELEFT  : DECR iColor(iID)
                CASE %SB_PAGELEFT  : iColor(iID) = iColor(iID) - 32
                CASE %SB_THUMBPOSITION, %SB_THUMBTRACK : iColor(iID) = HIWRD(CBWPARAM)
                CASE ELSE : EXIT FUNCTION
             END SELECT
             iColor(iID) = MAX&(0, MIN&(iColor(iID), 255))' Ensure range is correct 0-255
             CONTROL SET TEXT hDlg, iID + 160, FORMAT$(iColor(iID))
             FUNCTION = 1
          CASE %WM_CLOSE
          CASE %WM_COMMAND
             SELECT CASE CBCTL
                CASE %TXTR, %TXTG, %TXTB  'typed number
                   IF CBCTLMSG = %EN_CHANGE THEN
                      CONTROL GET TEXT hDlg, CBCTL TO sText
                      iColor(CBCTL - 160) = MAX&(0, MIN&(VAL(sText), 255))' Ensure range is correct 0-255
                      SetScrollPos iBar(CBCTL - 160), %SB_CTL, iColor(CBCTL - 160), %TRUE
                      CALL UpdateRGB(iColor(1), iColor(2), iColor(3))
                   END IF
                CASE %BUTCOPY
                   IF CBCTLMSG = %BN_CLICKED THEN
                      sText = "RGB(" + FORMAT$(iColor(1)) + "," + STR$(iColor(2)) + "," + STR$(iColor(3)) + ")"
                      IF SendClipBoardText(sText) THEN
                         MSGBOX sText + " is now in the clipboard ready to paste", %MB_ICONINFORMATION,"Done."
                      ELSE
                         MSGBOX "Error sending " + sText + " to clipboard!",,"Error"
                      END IF
                   END IF
                CASE %BUTCOPYVAL
                   IF CBCTLMSG = %BN_CLICKED THEN
                      sText = "&H0" + HEX$(RGB(iColor(1),iColor(2),iColor(3)))
                      IF SendClipBoardText(sText) THEN
                         MSGBOX sText + " is now in the clipboard ready to paste",%MB_ICONINFORMATION,"Done."
                      ELSE
                         MSGBOX "Error sending " + sText + " to clipboard!",,"Error"
                      END IF
                   END IF
                CASE %BUTCLOSE
                   IF CBCTLMSG = %BN_CLICKED THEN
                      DIALOG END hDlg
                   END IF
                CASE ELSE
             END SELECT
          CASE ELSE
       END SELECT
    END FUNCTION
    '=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~
    ------------------
    "I haven't lost my mind... its backed up on tape... I think??"



    [This message has been edited by William Burns (edited January 24, 2003).]
    "I haven't lost my mind... its backed up on tape... I think??" :D

  • #2
    another one to add... http://www.powerbasic.com/support/pb...ad.php?t=23041

    regards,
    jules


    Best regards
    Jules
    www.rpmarchildon.com

    Comment


    • #3
      and the petzold one:


      ------------------
      patrice terrier mailto[email protected][email protected]</a>
      provider of winlift (skin engine), gdi+ wrapper (graphic package), dvbtree (index manager)
      http://www.zapsolution.com
      home of zap image solution,
      zap audio player, zap media browser, zap slide show, zap picture browser.
      Patrice Terrier
      www.zapsolution.com
      www.objreader.com
      Addons: GDImage.DLL 32/64-bit (Graphic library), WinLIFT.DLL 32/64-bit (Skin Engine).

      Comment


      • #4
        CONTROL SET COLOR is not supported in PBDLL 6.1

        ------------------
        Kind Regards
        Mike

        Comment

        Working...
        X