Adjust Color Dialog - Fixed Equates

Date: 02-16-2022

Return to Index

 
'Provides a dialog in which to adjust sliders to create a desired color
 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc"
%IDC_RGB   = 500
%IDC_Value = 501
%IDC_Color = 502
%IDC_R     = 503
%IDC_G     = 504
%IDC_B     = 505
Global hScroll, hDlg As Dword, R,G,B As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0, "RGB Color",300,300,200,130, %WS_SysMenu, 0 To hDlg
   Control Add Label, hDlg,%IDC_Color, "Color", 25,10,150,30, %WS_Border
   Control Add Label, hDlg, %IDC_RGB, "R" + $CrLf +$CrLf + "G" + $CrLf + $CrLf + "B", 10,53,10,80
   Control Add Label, hDlg, %IDC_Value, "" + $CrLf + $CrLf + "128   (12)", 140,53,60,80
   Control Add ScrollBar, hDlg, %IDC_R,"", 25,50,100,20
   Control Add ScrollBar, hDlg, %IDC_G,"", 25,75,100,20
   Control Add ScrollBar, hDlg, %IDC_B,"", 25,100,100,20
   ScrollBar Set Range hDlg, %IDC_R, 0,264
   ScrollBar Set Range hDlg, %IDC_G, 0,264
   ScrollBar Set Range hDlg, %IDC_B, 0,264
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local iPos, Delta As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         R = 110 : G = 140 : B = 170
         ScrollBar Set Pos hDlg, %IDC_R, R
         ScrollBar Set Pos hDlg, %IDC_G, G
         ScrollBar Set Pos hDlg, %IDC_B, B
         UpdateLabels
      Case %WM_HScroll
         ScrollBar Get Pos hDlg, GetDlgCtrlID(Cb.LParam) To iPos
         Select Case Lo(Word, Cb.WParam)
            Case %SB_LineLeft   : ScrollBar Set Pos hDlg, GetDlgCtrlID(Cb.LParam), iPos - 1
            Case %SB_LineRight  : ScrollBar Set Pos hDlg, GetDlgCtrlID(Cb.LParam), iPos + 1
            Case %SB_PageLeft   : ScrollBar Set Pos hDlg, GetDlgCtrlID(Cb.LParam), iPos - 10
            Case %SB_PageRight  : ScrollBar Set Pos hDlg, GetDlgCtrlID(Cb.LParam), iPos + 10
            Case %SB_ThumbTrack : ScrollBar Set Pos hDlg, GetDlgCtrlID(Cb.LParam), Hi(Word, Cb.WParam)
         End Select
         UpdateLabels
   End Select
End Function
 
Sub UpdateLabels
   Local R,G,B As Long
   ScrollBar Get Pos hDlg, %IDC_R To R
   ScrollBar Get Pos hDlg, %IDC_G To G
   ScrollBar Get Pos hDlg, %IDC_B To B
   Control Set Color hDlg, %IDC_Color, RGB(R,G,B), RGB(R,G,B)
   Control Set Text hDlg, %IDC_Value, _
      Str$(R) + Space$(5) + Hex$(R) + $CrLf + $CrLf + _
      Str$(G) + Space$(5) + Hex$(G) + $CrLf + $CrLf + _
      Str$(B) + Space$(5) + Hex$(B)
   Control ReDraw hDlg, %IDC_Color
End Sub
 
'gbs_00868
'Date: 03-10-2012

created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm