Tweet
'
Code:
'May 2009
'Sample code - arrays to set up buttons and using button flags for multiple purposes
'PBWIN 9.01 - WinApi 05/2008 - XP Pro SP3
'Button colors compliments of Laurence Jackson
#Compile Exe
#Dim All
#Optimize SPEED 'Fly baby Fly!!!
#Debug Display On '<<<<<<<<<<<<<<< Remember to turn off for production code
#Include "WIN32API.INC"
'these next included files needed for button colors can be found here:
'http://www.powerbasic.com/support/pbforums/showthread.php?t=38904
#Include "C:\Only_My_Programs\Include Files\ButtonPlus.bas"
#Resource "C:\Only_My_Programs\Include Files\ButtonPlusDemo.pbr"
%Button_Ids_Start_At = 1000
'
Global hdlg As Dword
Global Btn_bg_Colors(), Btn_Id(), Btn_Flag() As Long
Global Btn_Description() As String
'
' *******************************************************
'
Macro Common_Locals
'Normally I use an #Include file here:
''' #Include "C:\Power Basic\Includes\Variables_Common_to_All_Programs.inc"
' that has variables I commonly use.
'
Local Btn_Face_Color, Btn_Text_Color, Btn_Width, Btn_Height As Long
Local col, col1, col2, col3, col4, col5 As Long
Local ctr, ctr1, ctr2, ctr3, ctr4, ctr5 As Long
Local Id, Wdth, Hght, Stile As Long
Local Row, Row1, Row2, Row3, Row4, Row5 As Long
Local t, t1, t2, t3 As String
End Macro
'
' *******************************************************
'
Macro Btn_Set_Text_Color = ButtonPlus hDlg, Id, %BP_TEXT_COLOR, Btn_Text_Color '&H003F3F7F
' ButtonPlus h_Dlg, Ctrl_Id, %BP_ICON_ID, %IDR_ICON
' ButtonPlus h_Dlg, Ctrl_Id, %BP_ICON_WIDTH, 24
' ButtonPlus h_Dlg, Ctrl_Id, %BP_ICON_POS, %BS_RIGHT
Macro Btn_Set_Face_Color = ButtonPlus hdlg, Id, %BP_FACE_BLEND, 255 : ButtonPlus hDlg, Id, %BP_FACE_COLOR, Btn_Face_Color ' &H008FDF8F
' ButtonPlus h_Dlg, Ctrl_Id, %BP_FACE_BLEND, &H6F
'
Macro Btn_Rnd_Bg_Color
ctr5 = Rnd(LBound(Btn_bg_Colors()), UBound(Btn_bg_Colors()))
Btn_Face_Color = Btn_bg_Colors(ctr5)
Btn_Set_Face_Color
End Macro
'
' *******************************************************
'
Sub Set_Up_at_Start
Common_Locals
Dim Btn_bg_Colors(1 To 10)
Btn_bg_Colors(1) = %Black + 1
Btn_bg_Colors(2) = %Blue
Btn_bg_Colors(3) = %Green
Btn_bg_Colors(4) = %Cyan
Btn_bg_Colors(5) = %Red
Btn_bg_Colors(6) = %Magenta
Btn_bg_Colors(7) = %Yellow
Btn_bg_Colors(8) = %White
Btn_bg_Colors(9) = %Gray
Btn_bg_Colors(10) = %LtGray
ctr3 = 50 'way way more than usually needed
ReDim Btn_Id(1 To ctr3)
ReDim Btn_Flag(1 To ctr3) 'set when programmed/assigned
ReDim Btn_Description$(1 To ctr3) 'set when assigning button
'set up ID's
ctr2 = %Button_Ids_Start_At
For ctr = LBound(Btn_Id()) To UBound(Btn_Id())
Incr ctr2 'Id number
Btn_Id(ctr) = ctr2
Incr ctr3 'no black
If ctr3 > UBound(Btn_bg_Colors()) Then ctr3 = 2'LBound(Btn_bg_Colors())
Btn_Flag(ctr) = ctr3'Actually will be set when button is assigned somewhere _
Btn_Description$(ctr) = Using$("## Flag=# ", Ctr, ctr3)' actually will be set when button is assigned
Next ctr
Btn_Description$(UBound(Btn_Id())) = "Abandon Ship" 'last button for exit
End Sub
'
' *******************************************************
'
CallBack Function PB_Main_Dialog_Processor
common_Locals
Select Case CbMsg 'This is TO determine the message TYPE
'
Case %WM_INITDIALOG'<- Initialization when the program loads
'
Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes
'
Case %WM_COMMAND 'processes command messages
Select Case CbCtl 'determine which CONTROL
'
Case Btn_Id(UBound(Btn_Id())) 'Abandon ship
Dialog End CB.Hndl
'
Case Btn_Id(LBound(Btn_Id())) To Btn_Id(UBound(Btn_Id()))
' Control Set Text CbHndl, CbCtl, "Button Clicked"
Id = CB.Ctl
' Btn_Text_Color = %Black: Btn_Set_Text_Color
' Control ReDraw CB.Hndl, CB.Ctl 'needed to chg color
winbeep 200, 1
'Sleep 100 'allow time to see "Button Clicked"
Local Actual_Btn_Id As Long
Actual_Btn_Id = CB.Ctl - %Button_Ids_Start_At
'Note this next Select Case series would inside _
'whatever Sub/Function is called. _
'ie Call Button_Number_Clicked(Btn_Flag(Actual_Btn_Id))
'
Select Case Btn_Flag(Actual_Btn_Id)
Case 0 'flag not set so do default action
t$ = "Default action"
Case 1 'flag set to 1 so do something here
t$ = "Case 1 used"
Case 2 'flag set to 2 so do something else here
t$ = "Case 2 used"
Case 3 'flag set to 3 so do something different here
t$ = "Case 4 used"
Case Else
t$ = Using$("Flag set at # ", Btn_Flag(Actual_Btn_Id))
End Select
Btn_Face_Color = %Black + 1: Btn_Set_Face_Color
Btn_Text_Color = %White: Btn_Set_Text_Color
Control Set Text CbHndl, CB.Ctl, t$ '& Str$(ctr5)
End Select
End Select
End Function
'
' *******************************************************
'
Sub Set_Up_Display
'by keeping the displays in separate subs, it makes maintenance
' and programming changes easier to manage (at least for me).
Common_Locals
t$ = Space$(150) '150 looks okay
CSet t$ = "Multiple Button Use Demonstrator Version (0.000000001.3.5) {May 2009} "
' Main dialog window
Dialog Font "Arial", 10
Wdth = 460
Hght = 280
'
Stile = %WS_CAPTION
Stile = Stile Or %WS_SYSMENU
Stile = Stile Or %WS_THICKFRAME
Stile = Stile Or %WM_HELP
Stile = Stile Or %WS_Border''doesn't do anything
'
Dialog New hDlg, t$, _
, , _ 'center it
Wdth, Hght, _
Stile, _
%WS_Ex_WindowEdge, _
To hDlg
'
Btn_Width = 100 'Len(Btn_Description$(1)) * 'most characters 5 units wide on average _
'so make wider
Btn_Height = 12
Stile = 0
Row = 1
Row1 = Row 'remember top row
Col = 1
'
For ctr = LBound(Btn_Id()) To UBound(Btn_Id())
GoSub Draw_Button
Id = Btn_Id(ctr) 'coloring does not accept array, use long
'vary bg colors
ctr4 = Btn_Flag(ctr)
Btn_Face_Color = Btn_bg_Colors(ctr4) 'set color to flag just for demo
Btn_Set_Face_Color
Control Set Text hdlg, btn_Id(ctr), Btn_Description(ctr) & " " & Str$(ctr4) 'Hex$(Btn_Face_Color)
Select Case ctr4
Case 1, 2, 9
Btn_Text_Color = %White
Case Else
Btn_Text_Color = %Black
End Select
Btn_Set_Text_Color
Next ctr
'
Exit Sub
'***********
Draw_Button:
'
Control Add Button, hDlg, Btn_Id(ctr), Btn_Description$(ctr), _
Col, Row, _
Btn_Width, Btn_Height, _
0' Stile
'
Row = Row + Btn_Height + 5 '5 leaves room in between
If row > Hght - Btn_Height Then 'no more room so move over
Col = col + Btn_Width + 15 '15 nice space between
Row = Row1 'start back at top row
End If
Return
End Sub
'
' *******************************************************
'
Function PBMain
Call Set_Up_at_Start
'
Call Set_UP_Display
'
Dialog Show Modal hDlg Call PB_Main_Dialog_Processor
'
End Function
'
' *******************************************************
'
'''
'
Comment