Announcement

Collapse
No announcement yet.

RGB Color Slider-Bank

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

  • RGB Color Slider-Bank

    Hello,

    I've spent the last couple of days trying to make an RGB slider
    bank like those you'd see in most paint packages-- Three
    horizontal scrollbars, with a little color 'swatch' showing the
    current (24-bit) color determined by the combined values of the
    sliders.

    The whole application that the slider-bank is a part of is a
    single-dialog, modal program with multiple text, combo, and
    list boxes along with a fair amount of buttons. Some of these
    text boxes rely on the RGB information provided from the
    sliders.

    Any examples, ideas, suggestions, would be DEEPLY appreciated!

    BTW, I'd be happy to send what I've got so far if requested.

    To make matters worse, I'm supposed to have this little app
    done by tommorrow morning.

    Thanks in advance!

    Scott Martindale

  • #2
    For starters, Petzold conversion...

    Regards,
    Jules
    Code:
    '
    ' ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
    ' Û Û Ûßß Û ßÛß Û Û    Û Û Û ÛßÛ ßÛß Ûßß ÛßÛ ÛßÛ         51 Broxholm Road
    ' ÛÜÝ ÛÜ  Û  Û  ÛÜÛ    Û Û Û ÛÜÛ  Û  ÛÜ  ÛÜß ßþÜ         London SE27 ONA
    ' Û Û ÛÜÜ Û  Û  Û Û    ßÜßÜß Û Û  Û  ÛÜÜ Û Û ÛÜÛ
    ' ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ
    '
    '
    ' COLORS1.BAS ------------------------------------ (c) Keith A. Waters 1998
    '
    ' This program is a translation from C of the program COLORS1.C described
    ' and analysed in Chapter 3 of Charles Petzold's book, Programming Windows 95.
    '
     
    $COMPILE EXE                      'Compile to an executable
    $DEBUG ERROR ON
    $DIM ALL
     
    $INCLUDE "WIN32API.INC"           'C:\PBDLL32\WINAPI\WIN32API.INC'
     
    GLOBAL hWndRect    AS LONG,_
           hWndScrol() AS LONG,_
           hWndLabel() AS LONG,_
           hWndValue() AS LONG,_
           color()     AS LONG,_
           iFocus      AS LONG,_
           fnOldScr()  AS LONG
    
     
    DECLARE FUNCTION ScrollProc (BYVAL hWnd    AS DWORD,_
                                 BYVAL wMsg    AS DWORD,_
                                 BYVAL wParam  AS DWORD,_
                                 BYVAL lParam  AS DWORD) AS LONG
    
     
    ' ---------------------------------------------------------------------
    'FUNCTION WinMain (BYVAL hCurrInstance AS LONG,_
    '                  BYVAL hPrevInstance AS LONG,_
    '                  lpCmdLine           AS ASCIIZ PTR,_
    '                  BYVAL nCmdShow      AS LONG) AS LONG
    '
    '   hCurrInstance AS LONG        instance handle - a number that uniquely
    '                                  identifies program while it is running
    '   hPrevInstance AS LONG        previous instance - obsolete under Windows 95
    '   lpCmdLine     AS ASCIIZ PTR  command-line parameters used with program
    '   nCmdShow      AS LONG        number indicating how window should be
    '                                  initially displayed.  Takes values
    '                                  %SW_SHOWNORMAL or %SW_SHOWMINNOACTIVE.
    '
    '   This function is the entry point to the program.  If the function
    '   succeeds, terminating when it receives a WM_QUIT message, it should
    '   return the exit value contained in that message's wParam parameter.
    '   If the function terminates before entering the message loop, it should
    '   return zero.
    '
    FUNCTION WinMain (BYVAL hCurrInstance AS LONG,_
                      BYVAL hPrevInstance AS LONG,_
                      lpCmdLine           AS ASCIIZ PTR,_
                      BYVAL nCmdShow      AS LONG) AS LONG
     
      STATIC szClassName    AS ASCIIZ*9,_
             szColorLabel() AS ASCIIZ*6
     
      LOCAL  Msg            AS tagMsg,_
             wClass         AS WndClassEx,_
             hWnd           AS DWORD,_
             i              AS LONG
     
      DIM szColorLabel(0:2)
     
      DIM fnOldScr (0:2),_            'Dimension globals
          hWndScrol(0:2),_
          hWndLabel(0:2),_
          hWndValue(0:2),_
          color    (0:2)
     
    ' Initialize
    ' ~~~~~~~~~~
      szClassName = "Colors1"      'Set class name
     
      szColorLabel(0) = "Red"
      szColorLabel(1) = "Green"
      szColorLabel(2) = "Blue"
     
    ' Fill window class structure
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~
      wClass.cbSize        = SIZEOF(wClass)
      wClass.style         = %CS_HREDRAW OR %CS_VREDRAW
      wClass.lpfnWndProc   = CODEPTR(MainWndProc)
      wClass.cbClsExtra    = 0
      wClass.cbWndExtra    = 0
      wClass.hInstance     = hCurrInstance
      wClass.hIcon         = LoadIcon  (%NULL, BYVAL %IDI_APPLICATION) 'loads an icon for use by the program
      wClass.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)       'loads a mouse cursor for use by the program
      wClass.hbrBackground = CreateSolidBrush(0)                       'obtains a graphics object (in this case a brush used for painting the window's background)
      wClass.lpszMenuName  = %NULL
      wClass.lpszClassName = VARPTR(szClassName)
      wClass.hIConSm       = LoadIcon  (%NULL, BYVAL %IDI_APPLICATION) 'loads an icon for use by the program
     
    ' Register the window-class
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~
      CALL RegisterClassEx (wClass)                'registers a window class for the program window
     
    ' Create the main window                       'creates a window based on registered window class
    ' ~~~~~~~~~~~~~~~~~~~~~~
      hWnd = CreateWindow (szClassName,_                'window class name
                           "Color Scroll",_             'window caption
                           %WS_OVERLAPPEDWINDOW,_       'window style
                           %CW_USEDEFAULT,_             'initial x position
                           %CW_USEDEFAULT,_             'initial y position
                           %CW_USEDEFAULT,_             'initial x size
                           %CW_USEDEFAULT,_             'initial y
                           %NULL,_                      'parent window handle
                           %NULL,_                      'window menu handle
                           hCurrInstance,_              'program instance handle
                           %NULL)                       'creation parameter
     
    ' Create static child window
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~
      hWndRect = CreateWindow ("static",_               'window class name
                           BYVAL %NULL,_                'window caption
                           %WS_CHILD OR %WS_VISIBLE OR %SS_WHITERECT,_  'window style
                           0, 0, 0, 0,_                 'initial y
                           hWnd,_                       'parent window handle
                           9,_                          'window menu handle
                           hCurrInstance,_              'program instance handle
                           %NULL)                       'creation parameter
     
    ' Create scrollbar and scrollbar label child windows
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      FOR i = 0 TO 2
        hWndScrol(i) = CreateWindow ("scrollbar",_      'window class name
                           BYVAL %NULL,_                'window caption
                           %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %SBS_VERT,_  'window style
                           0, 0, 0, 0,_                 'initial y
                           hWnd,_                       'parent window handle
                           i,_                          'window menu handle
                           hCurrInstance,_              'program instance handle
                           %NULL)                       'creation parameter
     
        hWndLabel(i) = CreateWindow ("static",_         'window class name
                           szColorLabel(i),_            'window caption
                           %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER,_  'window style
                           0, 0, 0, 0,_                 'initial y
                           hWnd,_                       'parent window handle
                           i + 3,_                      'window menu handle
                           hCurrInstance,_              'program instance handle
                           %NULL)                       'creation parameter
     
        hWndValue(i) = CreateWindow ("static",_         'window class name
                           "0",_                        'window caption
                           %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER,_  'window style
                           0, 0, 0, 0,_                 'initial y
                           hWnd,_                       'parent window handle
                           i + 6,_                      'window menu handle
                           hCurrInstance,_              'program instance handle
                           %NULL)                       'creation parameter
     
    '   Subclass each scroll bar
    '   ~~~~~~~~~~~~~~~~~~~~~~~~
        fnOldScr(i) = SetWindowLong(hWndScrol(i), %GWL_WNDPROC, CODEPTR(ScrollProc))
     
    '   Set scrollbar ranges and position
    '   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        CALL SetScrollRange (hWndScrol(i), %SB_CTL, 0, 255, %FALSE)
        CALL SetScrollPos   (hWndScrol(i), %SB_CTL, 0, %FALSE)
     
      NEXT
     
    ' Display main window
    ' ~~~~~~~~~~~~~~~~~~~
      CALL ShowWindow   (hWnd, nCmdShow)           'displays the window on the screen
      CALL UpdateWindow (hWnd)                     'directs the window to paint itself
     
    ' Main message loop of program
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      WHILE GetMessage(Msg, %NULL, 0, 0)           'gets a message from the message queque
        CALL TranslateMessage (Msg)                'translates some keyboard messages
        CALL DispatchMessage  (Msg)                'sends a message to a window procedure
      WEND
     
    ' Clean up and assign return value
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      FUNCTION = Msg.wParam
     
    END FUNCTION
     
    
    ' ----------------------------------------------------------------------
    'FUNCTION MainWndProc(BYVAL hWnd    AS DWORD,_
    '                     BYVAL wMsg    AS DWORD,_
    '                     BYVAL wParam  AS DWORD,_
    '                     BYVAL lParam  AS DWORD) EXPORT AS LONG
    '
    '   BYVAL hWnd    AS DWORD   handle of window to which message is directed
    '   BYVAL wMsg    AS DWORD   message identifier, eg. %WM_LBUTTONDOWN
    '   BYVAL wParam  AS DWORD   message parameter (meaning depends on message)
    '   BYVAL lParam  AS DWORD   message parameter (meaning depends on message)
    '
    '   This function is the "window procedure" for program's main (and only)
    '   window.  The function is called by Windows (it is a "CALLBACK" function).
    '   The function returns zero for all messages processed internally rather
    '   than by the default window procedure, DefWindowProc.
    '
    FUNCTION MainWndProc(BYVAL hWnd    AS DWORD,_
                         BYVAL wMsg    AS DWORD,_
                         BYVAL wParam  AS DWORD,_
                         BYVAL lParam  AS DWORD) EXPORT AS LONG
     
      STATIC crPrim()     AS LONG,_
             hBrush()     AS LONG,_
             hBrushStatic AS LONG,_
             cyChar       AS LONG,_
             rcColor      AS RECT
     
      LOCAL  szBuffer AS ASCIIZ*10,_
             i        AS LONG,_
             cxClient AS LONG,_
             cyClient AS LONG
     
      DIM hBrush(0:2),_
          crPrim(0:2)
    
     
      SELECT CASE wMsg
        CASE %WM_CREATE
          crPrim(0) = RGB(255, 0, 0)
          crPrim(1) = RGB(0, 255, 0)
          crPrim(2) = RGB(0, 0, 255)
     
    '     Create brushes for scrollbars
    '     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          FOR i = 0 TO 2
            hBrush(i) = CreateSolidBrush (crPrim(i))
          NEXT
     
          hBrushStatic = CreateSolidBrush (GetSysColor(%COLOR_BTNHIGHLIGHT))
     
          cyChar = HIWRD(GetDialogBaseUnits())
     
          FUNCTION = 0
     
    
        CASE %WM_SIZE
          cxClient = LOWRD(lParam)
          cyClient = HIWRD(lParam)
     
          CALL SetRect (rcColor, cxClient\2, 0, cxClient, cyClient)
     
          CALL MoveWindow(hWndRect, 0, 0, cxClient\2, cyClient, %TRUE)
     
          FOR i = 0 TO 2
            CALL MoveWindow(hWndScrol(i), (2*i + 1)*cxClient\14, 2*cyChar, _
                                           cxClient\14, cyClient - 4*cyChar, %TRUE)
     
            CALL MoveWindow(hWndLabel(i), (4*i + 1)*cxClient\28, cyChar\2, _
                                           cxClient\7, cyChar, %TRUE)
     
            CALL MoveWindow(hWndValue(i), (4*i + 1)*cxClient\28, _
                                           cyClient - 3*cyChar\2, _
                                           cxClient\7, cyChar, %TRUE)
          NEXT
     
          CALL SetFocus (hWnd)
     
          FUNCTION = 0
     
    
        CASE %WM_SETFOCUS
          CALL SetFocus (hWndScrol(iFocus))
     
          FUNCTION = 0
     
    
        CASE %WM_VSCROLL
          i = GetWindowLong (lParam, %GWL_ID)      'Get scrollbar ID
     
          SELECT CASE LOWRD(wParam)
            CASE %SB_PAGEDOWN
              color(i) = color(i) + 15
              color(i) = MIN(255, color(i) + 1)
     
            CASE %SB_LINEDOWN
              color(i) = MIN(255, color(i) + 1)
     
            CASE %SB_PAGEUP
              color(i) = color(i) - 15
              color(i) = MAX(0, color(i) - 1)
     
            CASE %SB_LINEUP
              color(i) = MAX(0, color(i) - 1)
     
            CASE %SB_TOP
              color(i) = 0
     
            CASE %SB_BOTTOM
              color(i) = 255
     
            CASE %SB_THUMBPOSITION, %SB_THUMBTRACK
              color(i) = HIWRD(wParam)
     
          END SELECT
     
          CALL SetScrollPos  (hWndScrol(i), %SB_CTL, color(i), %TRUE)
          CALL SetWindowText (hWndValue(i), STR$(color(i)))
     
    '     Create new brush, insert in class, delete old brush
    '     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          CALL DeleteObject(SetClassLong(hWnd, %GCL_HBRBACKGROUND, _
                            CreateSolidBrush(RGB(color(0), color(1), color(2)))))
     
          CALL InvalidateRect (hWnd, rcColor, %TRUE)  'Issue %WM_PAINT meesage
          CALL UpdateWindow   (hWnd)                  'Recolour immediately
     
          FUNCTION = 0
    
     
        CASE %WM_CTLCOLORSCROLLBAR               'Scrollbar about to be drawn
          i = GetWindowLong (lParam, %GWL_ID)    'Get scrollbar ID
     
          FUNCTION = hBrush(i)                   'Return red, green or blue brush
     
    
        CASE %WM_CTLCOLORSTATIC                  'Static control about to be drawn
          i = GetWindowLong (lParam, %GWL_ID)    'Get static ID
     
          IF (i => 3) AND (i <= 8) THEN          'Static text controls
            CALL SetTextColor (wParam, crPrim(i MOD 3))                   'Set text
            CALL SetBkColor   (wParam, GetSysColor(%COLOR_BTNHIGHLIGHT))  'colours
     
            FUNCTION = hBrushStatic              'Return brush for background
          ELSE
            FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
          END IF
     
     
        CASE %WM_SYSCOLORCHANGE                  'A system color setting has changed
          CALL DeleteObject (hBrushStatic)
     
          hBrushStatic = CreateSolidBrush (GetSysColor(%COLOR_BTNHIGHLIGHT))
     
          FUNCTION = 0
     
     
        CASE %WM_DESTROY
    '     Reset to stock object, delete solid brush
    '     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
          CALL DeleteObject (SetClassLong(hWnd, %GCL_HBRBACKGROUND, _
                                                GetStockObject(%WHITE_BRUSH)))
    '     Delete scrollbar brushes
    '     ~~~~~~~~~~~~~~~~~~~~~~~~
          FOR i = 0 TO 2
            CALL DeleteObject(i)
          NEXT
     
          CALL DeleteObject(hBrushStatic)
     
          CALL PostQuitMessage(0)                               'inserts "quit" message into message queue
          FUNCTION = 0
     
    
        CASE ELSE
          FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)  'performs default processing of message
     
      END SELECT
     
    END FUNCTION
     
    
    ' ----------------------------------------------------------------------
    'FUNCTION IAssign (BYVAL iCont AS LONG, _
    '                  BYVAL value1 AS LONG, BYVAL value2 AS LONG) AS LONG
    '    iCont  AS LONG      conditional variable or expression
    '    value1 AS LONG      return value
    '    value2 AS LONG      alternate return value
    '
    '    Returns value1 if iCont is true (non-zero), otherwise returns value2.
    '    The function allows simulation of a C statement of the form (eg.),
    '
    '      iVal = iAttr & EZ_ATTR_ITALIC    ?   1 : 0 ;
    '
    '    with
    '
    '      iVal = IAssign (iAttr AND %EZ_ATTR_ITALIC, 1, 0)
    '
    FUNCTION IAssign (BYVAL iCont AS LONG, _
                      BYVAL value1 AS LONG, BYVAL value2 AS LONG) AS LONG
     
      IF iCont THEN
        FUNCTION = value1
      ELSE
        FUNCTION = value2
      END IF
    END FUNCTION
    
     
    ' -------------------------------------------------------
    'FUNCTION ScrollProc (BYVAL hWnd    AS DWORD,_
    '                     BYVAL wMsg    AS DWORD,_
    '                     BYVAL wParam  AS DWORD,_
    '                     BYVAL lParam  AS DWORD) EXPORT AS LONG
    '
    '    This is our subclass window routine for the scrollbars.  After
    '    preprocessing messages, the routine releases control back to the
    '    internal (Windows) window routine.
    '
    FUNCTION ScrollProc (BYVAL hWnd    AS DWORD,_
                         BYVAL wMsg    AS DWORD,_
                         BYVAL wParam  AS DWORD,_
                         BYVAL lParam  AS DWORD) EXPORT AS LONG
      LOCAL i AS LONG
     
      i = GetWindowLong(hWnd, %GWL_ID)           'Get scrollbar ID
     
      SELECT CASE wMsg
        CASE %WM_KEYDOWN
          IF wParam = %VK_TAB THEN _
            CALL SetFocus (hWndScrol((i + IAssign(GetKeyState(%VK_SHIFT) < 0, 2, 1)) MOD 3))
     
        CASE %WM_SETFOCUS
          iFocus = i
     
      END SELECT
     
      FUNCTION = CallWindowProc(fnOldScr(i), hWnd, wMsg, wParam, lParam)
    END FUNCTION
    
    
     
    ' --------------------------------------------------------------------------
    '   NOTES:
    '
    '   Scroll bars can process keystrokes only if they have focus.  The
    '   %WS_TABSTOP identifier must be used when creating a scrollbar if it is
    '   to obtain input focus when clicked.  The main window specifically gives
    '   input focus to one of scroll bars by processing the %WM_SETFOCUS message.
    '   To be able to step the input focus from one scrollbar to the next is best
    '   done by subclassing the scrollbars.
    '
    '   Just after creating each scrollbar, the control is subclassed by setting
    '   the window procedure for the control to be ScrollProc.  At the same time
    '   the address of the native (ie. inside Windows) window procedure for the
    '   control is stored in fnOldScr().  The call that does this is:
    '
    '     fnOldScr(i) = SetWindowLong(hWndScrol(i), %GWL_WNDPROC, CODEPTR(ScrollProc))
    '
    '   This subclassing allows ScrollProc to do some preliminary scrollbar
    '   message processing and to then pass all messages on to the original
    '   native scrollbar window procedure.
    '
    ' --------------------------------------------------------------------------
    Best regards
    Jules
    www.rpmarchildon.com

    Comment

    Working...
    X