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

TrackBar Demo

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

  • TrackBar Demo

    I originally posted this on the POWERBasic for Windows Forum. It was suggested that I move it this this forum, so here it is.

    While attempting to learn about using trackbars, I assembled this demo from various examples I found on this site. Hopefully, this demo will be of some value to anyone trying to incorporate trackbars into a program.

    Code:
    #COMPILE EXE
    #DIM ALL
    
    '---Includes...
    #INCLUDE "WIN32API.INC"
    #INCLUDE "COMMCTRL.INC"
    #INCLUDE "PBForms.INC"
    
    '---Constants...
    %RedSlider      = 1601
    %GrnSlider      = 1602
    %BluSlider      = 1603
    
    %RedLabel       = 1611
    %GrnLabel       = 1612
    %BluLabel       = 1613
    
    %Display        = 1700
    
    %RedFrame       = 1801
    %GrnFrame       = 1802
    %BluFrame       = 1803
    
    %MaxColor       = 255
    %Mincolor       =   0
    
    '---Declare Functions...
    DECLARE CALLBACK FUNCTION ShowForm1Proc()
    DECLARE FUNCTION ShowForm1(BYVAL hParent AS DWORD) AS LONG
    
    '---Declare Subroutines
    DECLARE SUB UpdateColorPanel(BYVAL hDlg AS DWORD, BYVAL Ctrl AS DWORD, BYVAL Value AS DWORD)
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    SUB UpdateColorPanel(BYVAL hDlg AS DWORD, BYVAL Ctrl AS DWORD, BYVAL Value AS DWORD)
        LOCAL Lbl       AS DWORD
    
        STATIC Red      AS BYTE
        STATIC Grn      AS BYTE
        STATIC Blu      AS BYTE
    
        '-update the values
        SELECT CASE Ctrl
            CASE %RedSlider
                Lbl = %RedLabel
                Red = Value
                EXIT SELECT
    
            CASE %GrnSlider
                Lbl = %GrnLabel
                Grn = Value
                EXIT SELECT
    
            CASE %BluSlider
                Lbl = %BluLabel
                Blu = Value
        END SELECT
    
        CONTROL SET TEXT hDlg, Lbl, STR$(Value)
        CONTROL SET COLOR hDlg, %Display, %WHITE, RGB(Red, Grn, Blu)
        CONTROL REDRAW hDlg, %Display
    END SUB
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN()
        CALL ShowForm1(%HWND_DESKTOP)
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowForm1Proc()
    
        LOCAL Value AS DWORD
        LOCAL Ctrl  AS DWORD
        '---
        SELECT CASE AS LONG CBMSG
            '---
            CASE %WM_INITDIALOG
                'Trackbars Setup
                CONTROL SEND CBHNDL,%RedSlider, %TBM_SETRANGE, %TRUE, MAKDWD(00,255) 'set range
                CONTROL SEND CBHNDL,%RedSlider, %TBM_SETPOS, %TRUE, 255
                CONTROL SET COLOR CBHNDL, %RedSlider, 0, RGB(255, 0, 0)
    
                CONTROL SEND CBHNDL,%GrnSlider, %TBM_SETRANGE,  %TRUE,MAKDWD(00,255) 'set range
                CONTROL SEND CBHNDL,%GrnSlider, %TBM_SETPOS, %TRUE, 255
                CONTROL SET COLOR CBHNDL, %GrnSlider, 0, RGB(0, 255, 0)
    
                CONTROL SEND CBHNDL,%BluSlider, %TBM_SETRANGE, %TRUE, MAKDWD(00,255) 'set range
                CONTROL SEND CBHNDL,%BluSlider, %TBM_SETPOS, %TRUE, 255
                CONTROL SET COLOR CBHNDL, %BluSlider, 0, RGB(0, 0, 255)
    
            '---
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CBWPARAM THEN
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
            '---
    
    '        CASE %WM_COMMAND
    '            SELECT CASE AS LONG CBCTL
    '            END SELECT
            '---
    
            CASE %WM_VSCROLL ' Handle each trackbar separately
                SELECT CASE CBLPARAM
                    CASE GetDlgItem(CBHNDL, %RedSlider)
                        Ctrl = %RedSlider
                        CONTROL SEND CBHNDL, %RedSlider, %TBM_GETPOS, 0, 0 TO Value
                        EXIT SELECT
    
                    CASE GetDlgItem(CBHNDL, %GrnSlider)
                        Ctrl = %GrnSlider
                        CONTROL SEND CBHNDL, %GrnSlider, %TBM_GETPOS, 0, 0 TO Value
                        EXIT SELECT
    
                    CASE GetDlgItem(CBHNDL, %BluSlider)
                        Ctrl = %BluSlider
                        CONTROL SEND CBHNDL, %BluSlider, %TBM_GETPOS, 0, 0 TO Value
                END SELECT
    
                        Value = LOWRD(255 - Value)
                        CALL UpdateColorPanel(CBHNDL, Ctrl, Value)
        END SELECT
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    FUNCTION ShowForm1(BYVAL hParent AS DWORD) AS LONG
    
        LOCAL lRslt  AS LONG
        LOCAL hDlg   AS DWORD
        LOCAL hFont1 AS DWORD
    
        DIALOG NEW hParent, "Trackbar Demo", 131, 82, 406, 211, %WS_SYSMENU OR %WS_BORDER OR %WS_DLGFRAME, , TO hDlg
    
        CONTROL ADD FRAME, hDlg, %RedFrame,   "Red", 200, 2, 32, 198
        CONTROL ADD LABEL, hDlg, %RedLabel,   " 0",206,188,20,8,%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD "msctls_trackbar32", hDlg, %RedSlider,"",204,15,25,170,%WS_CHILD OR %WS_VISIBLE OR %TBS_VERT OR %TBS_BOTH OR %TBS_NOTICKS
    
        CONTROL ADD FRAME, hDlg, %GrnFrame,   "Green", 235, 2, 32, 198
        CONTROL ADD LABEL, hDlg, %GrnLabel,   " 0", 241, 188, 20,8,%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD "msctls_trackbar32", hDlg, %GrnSlider,"",239,15,25,170,%WS_CHILD OR %WS_VISIBLE OR %TBS_VERT OR %TBS_BOTH OR %TBS_NOTICKS
    
        CONTROL ADD FRAME, hDlg, %BluFrame,   "Blue", 270, 2, 32, 198
        CONTROL ADD LABEL, hDlg, %BluLabel,   " 0", 278, 188, 20,8,%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD "msctls_trackbar32", hDlg, %BluSlider,"",274,15,25,170,%WS_CHILD OR %WS_VISIBLE OR %TBS_VERT OR %TBS_BOTH OR %TBS_NOTICKS
    
        CONTROL ADD LABEL, hDlg, %Display, "", 10, 10, 160, 160
        CONTROL SET COLOR  hDlg, %Display, %WHITE, %BLACK
    
        hFont1 = PBFormsMakeFont("MS Sans Serif",10,700,%FALSE,%FALSE,%FALSE,%ANSI_CHARSET)
    
    
        CONTROL SEND hDlg, %RedLabel, %WM_SETFONT, hFont1, 0
        CONTROL SEND hDlg, %GrnLabel, %WM_SETFONT, hFont1, 0
        CONTROL SEND hDlg, %BluLabel, %WM_SETFONT, hFont1, 0
        
        DIALOG SHOW MODAL hDlg, CALL ShowForm1Proc TO lRslt
    
        CALL DeleteObject(hFont1)
    
        FUNCTION = lRslt
    END FUNCTION
    Last edited by Walt Thompson; 8 Nov 2008, 07:43 PM. Reason: Add comment.

  • #2
    Updated Track Bar Demo

    Added a master control that moves the Red, Green and Blue controls together. If the controls are preset the master control maintains their relative positions.

    Code:
    #COMPILE EXE
    #DIM ALL
    
    '---Includes...
    #INCLUDE    "WIN32API.INC"
    #INCLUDE    "COMMCTRL.INC"
    #INCLUDE    "PBForms.INC"
    
    '---Constants...
    %MstrSlider     = 1600
    %RedSlider      = 1601
    %GrnSlider      = 1602
    %BluSlider      = 1603
    
    %MstrLabel      = 1610
    %RedLabel       = 1611
    %GrnLabel       = 1612
    %BluLabel       = 1613
    
    %Display        = 1700
    
    %MstrFrame      = 1800
    %RedFrame       = 1801
    %GrnFrame       = 1802
    %BluFrame       = 1803
    
    %MaxColor       = 255
    %Mincolor       =   0
    
    '---Declare Functions...
    DECLARE CALLBACK FUNCTION ShowForm1Proc()
    DECLARE FUNCTION ShowForm1(BYVAL hParent AS DWORD) AS LONG
    
    '---Declare Subroutines
    DECLARE SUB UpdateColorPanel(BYVAL hDlg AS DWORD, BYVAL Ctrl AS DWORD, BYVAL Value AS DWORD)
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    SUB UpdateColorPanel(BYVAL hDlg AS DWORD, BYVAL Ctrl AS DWORD, BYVAL Value AS DWORD)
        LOCAL Lbl       AS DWORD
    
        STATIC Red      AS BYTE
        STATIC Grn      AS BYTE
        STATIC Blu      AS BYTE
        STATIC Mstr     AS LONG
        STATIC MstrPos  AS LONG
        STATIC MstrMax  AS LONG
        STATIC MaxPos   AS LONG
        STATIC MinPos   AS LONG
    
    
        '-update the values
        SELECT CASE Ctrl
            CASE %RedSlider
                Lbl = %RedLabel
                Red = Value
                EXIT SELECT
    
            CASE %GrnSlider
                Lbl = %GrnLabel
                Grn = Value
                EXIT SELECT
    
            CASE %BluSlider
                Lbl = %BluLabel
                Blu = Value
                EXIT SELECT
    
            CASE %MstrSlider
                Lbl = %MstrLabel
                CONTROL SEND hDlg, %MstrSlider, %TBM_GETPOS, 0, 0 TO MstrPos
                CONTROL SET TEXT hDlg, Lbl, STR$(%MaxColor - MstrPos)
    
                Mstr = MstrPos - Red
                CONTROL SEND hDlg, %RedSlider, %TBM_SETPOS, %TRUE, Mstr
                IF Red + (%MaxColor - MstrPos) <= %MaxColor THEN CONTROL SET TEXT hDlg, %RedLabel, STR$(Red + (%MaxColor - MstrPos))
    
                Mstr = MstrPos - Grn
                CONTROL SEND hDlg, %GrnSlider, %TBM_SETPOS, %TRUE, Mstr
                IF Grn + (%MaxColor - MstrPos) <= %MaxColor THEN CONTROL SET TEXT hDlg, %GrnLabel, STR$(Grn + (%MaxColor - MstrPos))
    
                Mstr = MstrPos - Blu
                CONTROL SEND hDlg, %BluSlider, %TBM_SETPOS, %TRUE, Mstr
                IF Blu + (%MaxColor - MstrPos) <= %MaxColor THEN CONTROL SET TEXT hDlg, %BluLabel, STR$(Blu + (%MaxColor - MstrPos))
    
    
                MaxPos = %MaxColor - MAX&(Red, Grn, Blu)
                MinPos = %MaxColor - MIN&(Red, Grn, Blu)
                CONTROL SEND hDlg, %MstrSlider, %TBM_SETPOS, %TRUE, MstrPos
    
                CONTROL SET COLOR hDlg, %Display, %WHITE, RGB(%MaxColor - (MstrPos - Red), %MaxColor - (MstrPos - Grn), %MaxColor - (MstrPos - Blu))
                CONTROL REDRAW hDlg, %Display
    
                CONTROL SEND hDlg, %MstrSlider, %TBM_SETSELSTART, %TRUE, (MAX&(Red, Grn, Blu)+ MIN&(Red, Grn, Blu))- MIN&(Red, Grn, Blu)
                CONTROL SEND hDlg, %MstrSlider, %TBM_SETSELEND,   %TRUE, (%MaxColor)
                EXIT SUB
        END SELECT
    
        CONTROL SET TEXT hDlg, Lbl, STR$(Value)
        CONTROL SET COLOR hDlg, %Display, %WHITE, RGB(Red, Grn, Blu)
        CONTROL REDRAW hDlg, %Display
    
        CONTROL SEND hDlg, %MstrSlider, %TBM_CLEARSEL, %TRUE, 0
    END SUB
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN()
        CALL ShowForm1(%HWND_DESKTOP)
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowForm1Proc()
    
        LOCAL Value AS DWORD
        LOCAL Ctrl  AS DWORD
        '---
        SELECT CASE AS LONG CBMSG
            '---
            CASE %WM_INITDIALOG
                'Trackbars Setup
                CONTROL SEND CBHNDL, %RedSlider, %TBM_SETRANGE, %TRUE, MAKDWD(00, %MaxColor) 'set range
                CONTROL SEND CBHNDL, %RedSlider, %TBM_SETPOS, %TRUE, %MaxColor
                CONTROL SET COLOR CBHNDL, %RedSlider, 0, RGB(%MaxColor, 0, 0)
    
                CONTROL SEND CBHNDL, %GrnSlider, %TBM_SETRANGE,  %TRUE,MAKDWD(00, %MaxColor) 'set range
                CONTROL SEND CBHNDL, %GrnSlider, %TBM_SETPOS, %TRUE, %MaxColor
                CONTROL SET COLOR CBHNDL, %GrnSlider, 0, RGB(0, %MaxColor, 0)
    
                CONTROL SEND CBHNDL, %BluSlider, %TBM_SETRANGE, %TRUE, MAKDWD(00, %MaxColor) 'set range
                CONTROL SEND CBHNDL, %BluSlider, %TBM_SETPOS, %TRUE, %MaxColor
                CONTROL SET COLOR CBHNDL, %BluSlider, 0, RGB(0, 0, %MaxColor)
    
                CONTROL SEND CBHNDL, %MstrSlider, %TBM_SETRANGE, %TRUE, MAKDWD(00, %MaxColor) 'set range
                CONTROL SEND CBHNDL, %MstrSlider, %TBM_SETPOS, %TRUE, %MaxColor
                CONTROL SEND CBHNDL, %MstrSlider, %TBM_SETTICFREQ, 8, 0
                CONTROL SET COLOR CBHNDL, %MstrSlider, 0, RGB(200, 200, 200)
    
            '---
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CBWPARAM THEN
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
            '---
    
    '        CASE %WM_COMMAND
    '            SELECT CASE AS LONG CBCTL
    '            END SELECT
            '---
    
            CASE %WM_VSCROLL ' Handle each trackbar separately
                SELECT CASE CBLPARAM
                    CASE GetDlgItem(CBHNDL, %RedSlider)
                        Ctrl = %RedSlider
                        CONTROL SEND CBHNDL, %RedSlider, %TBM_GETPOS, 0, 0 TO Value
                        EXIT SELECT
    
                    CASE GetDlgItem(CBHNDL, %GrnSlider)
                        Ctrl = %GrnSlider
                        CONTROL SEND CBHNDL, %GrnSlider, %TBM_GETPOS, 0, 0 TO Value
                        EXIT SELECT
    
                    CASE GetDlgItem(CBHNDL, %BluSlider)
                        Ctrl = %BluSlider
                        CONTROL SEND CBHNDL, %BluSlider, %TBM_GETPOS, 0, 0 TO Value
                        EXIT SELECT
    
                    CASE GetDlgItem(CBHNDL, %MstrSlider)
                        Ctrl = %MstrSlider
                        CONTROL SEND CBHNDL, %MstrSlider, %TBM_GETPOS, 0, 0 TO Value
                END SELECT
    
                        Value = LOWRD(%MaxColor - Value)
                        CALL UpdateColorPanel(CBHNDL, Ctrl, Value)
        END SELECT
    END FUNCTION
    
    '------------------------------------------------------------------------------
    '
    '------------------------------------------------------------------------------
    FUNCTION ShowForm1(BYVAL hParent AS DWORD) AS LONG
    
        LOCAL lRslt  AS LONG
        LOCAL hDlg   AS DWORD
        LOCAL hFont1 AS DWORD
    
        DIALOG NEW hParent, "Trackbar Demo", 131, 82, 406, 211, %WS_SYSMENU OR %WS_BORDER OR %WS_DLGFRAME, , TO hDlg
    
        CONTROL ADD FRAME, hDlg, %RedFrame,   "Red", 200, 2, 32, 198
        CONTROL ADD LABEL, hDlg, %RedLabel,   " 0",206,188,20,8,%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD "msctls_trackbar32", hDlg, %RedSlider, "", 204, 15, 25, 170, %WS_CHILD OR %WS_VISIBLE OR %TBS_VERT OR %TBS_BOTH OR %TBS_NOTICKS
    
        CONTROL ADD FRAME, hDlg, %GrnFrame,   "Green", 235, 2, 32, 198
        CONTROL ADD LABEL, hDlg, %GrnLabel,   " 0", 241, 188, 20,8,%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD "msctls_trackbar32", hDlg, %GrnSlider, "", 239, 15, 25, 170, %WS_CHILD OR %WS_VISIBLE OR %TBS_VERT OR %TBS_BOTH OR %TBS_NOTICKS
    
        CONTROL ADD FRAME, hDlg, %BluFrame,   "Blue", 270, 2, 32, 198
        CONTROL ADD LABEL, hDlg, %BluLabel,   " 0", 278, 188, 20,8,%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD "msctls_trackbar32", hDlg, %BluSlider, "", 274, 15, 25, 170, %WS_CHILD OR %WS_VISIBLE OR %TBS_VERT OR %TBS_BOTH OR %TBS_NOTICKS
    
        CONTROL ADD FRAME, hDlg, %MstrFrame,   "Master", 305, 2, 32, 198
        CONTROL ADD LABEL, hDlg, %MstrLabel,   " 0", 315, 188, 20,8,%WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL ADD "msctls_trackbar32", hDlg, %MstrSlider, "", 309, 15, 25, 170, %WS_CHILD OR %WS_VISIBLE OR %TBS_VERT OR %TBS_BOTH OR %TBS_AUTOTICKS OR %TBS_ENABLESELRANGE
    
        CONTROL ADD LABEL, hDlg, %Display, "", 10, 10, 160, 160
        CONTROL SET COLOR  hDlg, %Display, %WHITE, %BLACK
    
    
        hFont1 = PBFormsMakeFont("MS Sans Serif",10,700,%FALSE,%FALSE,%FALSE,%ANSI_CHARSET)
    
        CONTROL SEND hDlg, %RedLabel,  %WM_SETFONT, hFont1, 0
        CONTROL SEND hDlg, %GrnLabel,  %WM_SETFONT, hFont1, 0
        CONTROL SEND hDlg, %BluLabel,  %WM_SETFONT, hFont1, 0
        CONTROL SEND hDlg, %MstrLabel, %WM_SETFONT, hFont1, 0
    
        DIALOG SHOW MODAL hDlg, CALL ShowForm1Proc TO lRslt
    
        CALL DeleteObject(hFont1)
    
        FUNCTION = lRslt
    END FUNCTION

    Comment

    Working...
    X