RGB Color Slider-Bank

[Scott Martindale]

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

[Jules Marchildon]

For starters, Petzold conversion...

Regards,
Jules

'
' ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß
' Û Û Ûßß Û ßÛß Û Û    Û Û Û ÛßÛ ßÛß Ûßß ÛßÛ ÛßÛ         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.
'
' --------------------------------------------------------------------------