Tweet
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.
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
Comment