Post by metro on Mar 31, 2018 4:21:01 GMT -5
Taken from Zack's tutorial on designing GUIs
'Creating a toolbar
NoMainWin
Dim hTB(10) 'toolbar hwnd storage
Dim btnTxt$(0)
True = 1
False = 0
struct rect,_
left as long,_
top as long,_
right as long,_
bottom as long
open "LB3_toolbars.dll" for dll as #toolbar
WindowWidth = 500
WindowHeight = 400
UpperLeftX = Int((DisplayWidth - WindowWidth) / 2)
UpperLeftY = Int((DisplayHeight - WindowHeight) / 2)
open "ToolBar DLL Demo 1" for window as #1
#1, "trapclose [quit]"
#1, "resizehandler [resize]"
hParent = hwnd(#1)
Gosub [Init]'initialize style variables
'define the toolbar
bmp$ = "tool.bmp" 'bitmap with all button images
hasBtnTxt = True 'buttons have text
'see [Toolbar.Styles]
TBstyle = TBSTYLE.FLAT
' TBstyle = TBSTYLE.LIST
' TBstyle = TBSTYLE.WRAPABLE
' TBstyle = TBSTYLE.FLAT or TBSTYLE.WRAPABLE
' TBstyle = TBSTYLE.LIST or TBSTYLE.WRAPABLE
' TBstyle = TBSTYLE.FLAT or TBSTYLE.LIST
'see [Toolbar.Button.Styles]
btnStyle = TBSTYLE.BUTTON
tbID = 0 'toolbar ID number
btnCount = 6 'number of toolbar buttons
bmpWidth = 28 'width for each button bitmap
bmpHeight = 28 'height of toolbar buttons
'tooltip list
tipList$ = "Create new file|Open existing file|Save current file|Cut|Copy|Paste"
'create the toolbar
hTB1 = CreateToolBar(hParent,tbID,btnCount,bmpWidth,bmpHeight,_
bmp$,TBstyle,tipList$,btnStyle)
hTB(0) = hTB1
Redim btnTxt$(5)
btnTxt$(0) = "New"
btnTxt$(1) = "Open"
btnTxt$(2) = "Save"
btnTxt$(3) = "Cut"
btnTxt$(4) = "Copy"
btnTxt$(5) = "Paste"
For i = 0 to 5
btnTxt$ = btnTxt$(i)
ret = InitButtons(hTB1, i, btnTxt$, hasBtnTxt, btnStyle)
Next i
'finish the toolbar
ret = DisplayTB(hTB1)
Callback lpfnTbClick, TbOnClick(long,long,long,long),long
calldll #toolbar, "SetCallback",hParent as ulong, lpfnTbClick as long,_
ret as long
goto [resize]
[MainLoop]
scan 'do not use Wait if callback functions are used.
goto [MainLoop]
[quit]
close #1
close #toolbar
end
[resize]
' Resize the toolbar(s).
calldll #user32, "GetClientRect", hParent as ulong, rect as ptr, ret as boolean
calldll #toolbar, "PlaceTB",hTB1 As ulong,rect as ptr, ret as void
goto [MainLoop]
'************************ Functions / Subs *************************
Function TbOnClick(hWnd,uMsg,wParam,lParam)
Select Case uMsg
Case _WM_COMMAND
Select Case lParam
Case hTB(0)
Select Case wParam
Case 1
Notice "New"
Case 2
Notice "Open"
Case 3
Notice "Save"
Case 4
Notice "Cut"
Case 5
Notice "Copy"
Case 6
Notice "Paste"
End Select
End Select
End Select
End Function
Function CreateToolBar(hParent,tbID,btnCnt,width,height,bmpPath$,TBstyle,tipList$,btnStyle)
calldll #toolbar, "CreateToolBar",hParent as ulong, tbID as long,_
btnCnt as long, width as long, height as long, bmpPath$ as ptr,_
TBstyle as long, tipList$ as ptr,btnStyle as long, hTB as long
CreateToolBar = hTB
End Function
Function InitButtons(hTB, btnPos, btnTxt$, hasTxt, btnStyle)
calldll #toolbar, "InitBtns", hTB as ulong, btnPos as long, btnTxt$ as ptr,_
hasTxt as long, btnStyle as long, ret as long
InitButtons = ret
End Function
Function DisplayTB(hTB)
calldll #toolbar, "ShowToolbar",hTB as ulong, ret as boolean
DisplayTB = ret
End Function
[Init]
' [Toolbar.Styles]
TBSTYLE.FLAT = 2048 'flat Explorer style buttons with
'transparent background.
TBSTYLE.LIST = 4096 'use for buttons with text on right side of bitmap.
TBSTYLE.WRAPABLE = 512 'Allows increase in height so buttons not fitting
'on one row can be displayed on additional rows.
'You must resize the toolbar for the buttons
'to wrap.
'[Toolbar.Button.Styles]
TBSTYLE.BUTTON = 0
TBSTYLE.SEP = 1
TBSTYLE.CHECK = 2
TBSTYLE.GROUP = 4
Return
'A button's style determines how the button appears and how it responds
'to user input. The TBSTYLE_BUTTON style creates a toolbar button that
'behaves like a standard push button. A button that has the TBSTYLE_CHECK
'style is similar to a standard push button, except it toggles between the
'pressed and nonpressed states each time the user clicks it.
'You can create groups of toolbar buttons by using the TBSTYLE_GROUP.
'To cause a button to stay pressed until the user chooses another button
'in the group use TBSTYLE_GROUP ored together with TBSTYLE_CHECK.
'The TBSTYLE_SEP style creates a small gap and separates buttons into
'different groups.
'A button with this style does not receive user input.
'-----------------------------------------------------------------------------------'
'A classic button type toolbar.
nomainwin
WindowWidth = 175
WindowHeight = 130
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
stylebits #main.q, _BS_BITMAP,0,0,0
button #main.q,"Zomg",[quit2], UL, 35, 37, 45, 40
open "Super duper" for window_nf as #main
print #main, "trapclose [otherquit]"
loadbmp "Rawr","liberty.bmp"
Rawr.hbmp=hbmp("Rawr")
thwnd=hwnd(#main.q)
calldll #user32, "SendMessageA",thwnd as ulong,_BM_SETIMAGE as long,_IMAGE_BITMAP as long,Rawr.hbmp as long,ret as long
wait
[otherquit]
unloadbmp "Rawr"
close #main
end
[quit2]
notice "OK!"
wait
'Creating a toolbar
NoMainWin
Dim hTB(10) 'toolbar hwnd storage
Dim btnTxt$(0)
True = 1
False = 0
struct rect,_
left as long,_
top as long,_
right as long,_
bottom as long
open "LB3_toolbars.dll" for dll as #toolbar
WindowWidth = 500
WindowHeight = 400
UpperLeftX = Int((DisplayWidth - WindowWidth) / 2)
UpperLeftY = Int((DisplayHeight - WindowHeight) / 2)
open "ToolBar DLL Demo 1" for window as #1
#1, "trapclose [quit]"
#1, "resizehandler [resize]"
hParent = hwnd(#1)
Gosub [Init]'initialize style variables
'define the toolbar
bmp$ = "tool.bmp" 'bitmap with all button images
hasBtnTxt = True 'buttons have text
'see [Toolbar.Styles]
TBstyle = TBSTYLE.FLAT
' TBstyle = TBSTYLE.LIST
' TBstyle = TBSTYLE.WRAPABLE
' TBstyle = TBSTYLE.FLAT or TBSTYLE.WRAPABLE
' TBstyle = TBSTYLE.LIST or TBSTYLE.WRAPABLE
' TBstyle = TBSTYLE.FLAT or TBSTYLE.LIST
'see [Toolbar.Button.Styles]
btnStyle = TBSTYLE.BUTTON
tbID = 0 'toolbar ID number
btnCount = 6 'number of toolbar buttons
bmpWidth = 28 'width for each button bitmap
bmpHeight = 28 'height of toolbar buttons
'tooltip list
tipList$ = "Create new file|Open existing file|Save current file|Cut|Copy|Paste"
'create the toolbar
hTB1 = CreateToolBar(hParent,tbID,btnCount,bmpWidth,bmpHeight,_
bmp$,TBstyle,tipList$,btnStyle)
hTB(0) = hTB1
Redim btnTxt$(5)
btnTxt$(0) = "New"
btnTxt$(1) = "Open"
btnTxt$(2) = "Save"
btnTxt$(3) = "Cut"
btnTxt$(4) = "Copy"
btnTxt$(5) = "Paste"
For i = 0 to 5
btnTxt$ = btnTxt$(i)
ret = InitButtons(hTB1, i, btnTxt$, hasBtnTxt, btnStyle)
Next i
'finish the toolbar
ret = DisplayTB(hTB1)
Callback lpfnTbClick, TbOnClick(long,long,long,long),long
calldll #toolbar, "SetCallback",hParent as ulong, lpfnTbClick as long,_
ret as long
goto [resize]
[MainLoop]
scan 'do not use Wait if callback functions are used.
goto [MainLoop]
[quit]
close #1
close #toolbar
end
[resize]
' Resize the toolbar(s).
calldll #user32, "GetClientRect", hParent as ulong, rect as ptr, ret as boolean
calldll #toolbar, "PlaceTB",hTB1 As ulong,rect as ptr, ret as void
goto [MainLoop]
'************************ Functions / Subs *************************
Function TbOnClick(hWnd,uMsg,wParam,lParam)
Select Case uMsg
Case _WM_COMMAND
Select Case lParam
Case hTB(0)
Select Case wParam
Case 1
Notice "New"
Case 2
Notice "Open"
Case 3
Notice "Save"
Case 4
Notice "Cut"
Case 5
Notice "Copy"
Case 6
Notice "Paste"
End Select
End Select
End Select
End Function
Function CreateToolBar(hParent,tbID,btnCnt,width,height,bmpPath$,TBstyle,tipList$,btnStyle)
calldll #toolbar, "CreateToolBar",hParent as ulong, tbID as long,_
btnCnt as long, width as long, height as long, bmpPath$ as ptr,_
TBstyle as long, tipList$ as ptr,btnStyle as long, hTB as long
CreateToolBar = hTB
End Function
Function InitButtons(hTB, btnPos, btnTxt$, hasTxt, btnStyle)
calldll #toolbar, "InitBtns", hTB as ulong, btnPos as long, btnTxt$ as ptr,_
hasTxt as long, btnStyle as long, ret as long
InitButtons = ret
End Function
Function DisplayTB(hTB)
calldll #toolbar, "ShowToolbar",hTB as ulong, ret as boolean
DisplayTB = ret
End Function
[Init]
' [Toolbar.Styles]
TBSTYLE.FLAT = 2048 'flat Explorer style buttons with
'transparent background.
TBSTYLE.LIST = 4096 'use for buttons with text on right side of bitmap.
TBSTYLE.WRAPABLE = 512 'Allows increase in height so buttons not fitting
'on one row can be displayed on additional rows.
'You must resize the toolbar for the buttons
'to wrap.
'[Toolbar.Button.Styles]
TBSTYLE.BUTTON = 0
TBSTYLE.SEP = 1
TBSTYLE.CHECK = 2
TBSTYLE.GROUP = 4
Return
'A button's style determines how the button appears and how it responds
'to user input. The TBSTYLE_BUTTON style creates a toolbar button that
'behaves like a standard push button. A button that has the TBSTYLE_CHECK
'style is similar to a standard push button, except it toggles between the
'pressed and nonpressed states each time the user clicks it.
'You can create groups of toolbar buttons by using the TBSTYLE_GROUP.
'To cause a button to stay pressed until the user chooses another button
'in the group use TBSTYLE_GROUP ored together with TBSTYLE_CHECK.
'The TBSTYLE_SEP style creates a small gap and separates buttons into
'different groups.
'A button with this style does not receive user input.
'-----------------------------------------------------------------------------------'
'A classic button type toolbar.
nomainwin
WindowWidth = 175
WindowHeight = 130
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
stylebits #main.q, _BS_BITMAP,0,0,0
button #main.q,"Zomg",[quit2], UL, 35, 37, 45, 40
open "Super duper" for window_nf as #main
print #main, "trapclose [otherquit]"
loadbmp "Rawr","liberty.bmp"
Rawr.hbmp=hbmp("Rawr")
thwnd=hwnd(#main.q)
calldll #user32, "SendMessageA",thwnd as ulong,_BM_SETIMAGE as long,_IMAGE_BITMAP as long,Rawr.hbmp as long,ret as long
wait
[otherquit]
unloadbmp "Rawr"
close #main
end
[quit2]
notice "OK!"
wait