Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Debug Error On
#Include "Win32API.inc"
#Include "CommCtrl.inc"
%IDC_Toolbar = 500
%IDC_Button = 501
%IDT_ButtonBase = 600 'reserve 600-649 to allow for 50 buttons
Type TBData
ID As Long
Style As Long
Txt As String * 20
Vis As Long
End Type
Global hDlg,hToolbar,hConsole As Dword, TB() As TBData, ButtonCount As Long
Function PBMain()
Dialog New Pixels, 0, "Toolbar Modifications",500,500,200,125, %WS_SysMenu, To hDlg
Control Add Button, hDlg, %IDC_Button, "Edit", 10,50,50,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local NMT As NMToolbar Ptr, temp$, bCount As Long
Static StartMoveIndex,EndMoveIndex As Long
Select Case Cb.Msg
Case %WM_InitDialog
Settings_INI "get"
If ButtonCount = 0 Then SetToolbarDefaults
SetToolbarDefaults
CreateToolbar
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Button
Control Send hDlg, %IDC_Toolbar, %TB_Customize,0,0
End Select
Case %WM_Destroy
Settings_INI "save"
Case %WM_ContextMenu
SetToolbarDefaults
CreateToolbar
Case %WM_Notify
Select Case Cb.NmId
Case %IDC_Toolbar
Toolbar Get Count hDlg, %IDC_Toolbar To bCount : Decr bCount 'to get zero-based answer
Select Case Cb.NmCode 'order received: QueryDelete --> QueryInsert --> DeletingButton
Case %TBN_InitCustomize
'MSDN says apps usually do not respond to this notification code
Function = %TBNRF_HideHelp 'prevents Help button from being displayed
Cprint "init_customize"
Case %TBN_BeginAdjust
'MSDN says apps usually do not respond to this notification code
Cprint "begin_adjust"
Case %TBN_QueryDelete
'sent when customization dialog is initiated
'determines if a button is allowed to be deleted
'pointer to NMTOOLBAR structure received
Cprint "query_delete"
Function = %True
Case %TBN_QueryInsert
'received under 2 circumstances:
'1. when customization dialog starts, for each button
' determines if new button may be inserted to the left of this button
'2. when user changes button location, or adds a button
'pointer to NMTOOLBAR structure received
Cprint "query_insert"
Function = %True
Case %TBN_GetButtonInfo
'a series of these is received to populate the "available" list
'return True to add additional buttons
'return False when no more buttons need to be added
'NMTOOLBAR structure defines button to be added
'hdr 'NMHDR structure
'iItem 'button CMD ID
'tbButton 'valid only in QueryInsert and QueryDelete TBButton structure
'cchText; 'length of text INT
'pszText; 'pointer to text
'rcButton 'area covered by button RECT str
'TBBUTTON structure
'bitmap int zero-based button index
'idCommand int CMD ID
'fsState byte button state flags TBState_checked -ellipses _enabled _hidden _indeterminate _marked _pressed _wrap
'fsStyle byte button styles TBStyle_altdrag _customerase _flat _list _registerdrop _tooltips _transparent _wrapable
'dwData dword app-defend data
'iString Int_ptr ptr to string buffer
Static iAsk As Long
Incr iAsk
If iAsk < 5 Then
CPrint "iAsk = " + Str$(iAsk)
Function = %True
End If
Cprint "get_buttoninfo"
Case %TBN_DeletingButton
'received when user is about to delete button
'pointer to NMTOOLBAR structure received
Cprint "deleting_button"
Case %TBN_ToolbarChange
'received when button has been added/moved/deleted
'pointer to NMHDR structure
Cprint "toolbar_change"
Case %TBN_Reset
'received when user has clicked the Reset button
'pointer to NMHDR structure
Cprint "reset"
Case %TBN_EndAdjust
'received when the customization dialog has been destroyed
'pointer to NMHDR structure
Cprint "end_adjust"
End Select
End Select
End Select
End Function
Sub CreateToolbar
Local i As Long
Control Kill hDlg, %IDC_Toolbar
Control Add Toolbar, hDlg, %IDC_Toolbar,"", 0,0,0,0, %WS_Child Or %WS_Visible Or %WS_Border Or %CCS_Top Or %TbStyle_Flat Or %CCS_Adjustable
Control Handle hDlg, %IDC_Toolbar To hToolbar
For i = 1 To UBound(TB)
If TB(i).vis Then Toolbar Add Button hDlg, %IDC_Toolbar, 0, TB(i).Id, TB(i).Style, Trim$(TB(i).txt)
Next i
End Sub
Sub SetToolbarDefaults
ButtonCount = 6
ReDim TB(1 To 6)
TB(1).Id = %IDT_ButtonBase + 0 : TB(1).Style = %TbStyle_Button : TB(1).txt = "one" : TB(1).vis = 1
TB(2).Id = %IDT_ButtonBase + 1 : TB(2).Style = %TbStyle_Button : TB(2).txt = "two" : TB(2).vis = 1
TB(3).Id = %IDT_ButtonBase + 3 : TB(3).Style = %TbStyle_Button : TB(3).txt = "three" : TB(3).vis = 1
TB(4).Id = %IDT_ButtonBase + 3 : TB(4).Style = %TbStyle_Button : TB(4).txt = "four" : TB(4).vis = 1
TB(5).Id = %IDT_ButtonBase + 4 : TB(5).Style = %TbStyle_Button : TB(5).txt = "five" : TB(5).vis = 0
TB(6).Id = %IDT_ButtonBase + 5 : TB(6).Style = %TbStyle_Button : TB(6).txt = "six" : TB(6).vis = 0
End Sub
Sub Settings_INI(Task$)
Local i,x,y As Long, xResult, yResult, tempz, INIFileName As Asciiz * %Max_Path
INIFileName = EXE.Path$ + "application.ini" 'set ini filename
If Task$ = "get" Then
'get dialog top/left from INI file and use to set Dialog location
Getprivateprofilestring "All", "Left", "500", xResult, %Max_Path, INIFileName
Getprivateprofilestring "All", "Top", "600", yResult, %Max_Path, INIFileName
Dialog Set Loc hDlg, Val(xResult$), Val(yResult$) 'left/top
'get dialog width/height from INI file and use to set Dialog size
GetPrivateProfileString "All", "Width", "300", xResult, %Max_Path, INIFileName
GetPrivateProfileString "All", "Height", "200", yResult, %Max_Path, INIFileName
Dialog Set Size hDlg,Val(xResult$), Val(yResult$) 'width/height
'get value for numeric variables
Getprivateprofilestring "All", "ButtonCount", "0", tempz, %Max_Path, INIFileName
ButtonCount = Val(tempz)
ReDim TB(1 To ButtonCount)
If ButtonCount Then
For i = 1 To ButtonCount
Getprivateprofilestring "Custom", "ButtonID" + Format$(i,"00"), "", tempz, %Max_Path, INIFileName
TB(i).Id = Val(tempz)
Getprivateprofilestring "Custom", "ButtonStyle" + Format$(i,"00"), "", tempz, %Max_Path, INIFileName
TB(i).Style = Val(tempz)
GetPrivateProfileString "Custom", "ButtonText" + Format$(i,"00"), "", tempz, %Max_Path, INIFileName
TB(i).txt = tempz
Next i
End If
End If
If Task$ = "save" Then
If IsFile(INIFileName) Then Kill INIFileName
'save dialog size/location unless minimized or maximized
If IsFalse(IsIconic(hDlg) Or IsZoomed(hDlg)) Then
Dialog Get Loc hDlg To x,y
WritePrivateProfileString "All", "Left", Str$(x), INIFileName
WritePrivateProfileString "All", "Top", Str$(y), INIFileName
Dialog Get Size hDlg To x,y
WritePrivateProfileString "All", "Width", Str$(x), INIFileName
WritePrivateProfileString "All", "Height", Str$(y), INIFileName
End If
'save numeric variable
WritePrivateProfileString "All", "ButtonCount", (Str$(ButtonCount)), INIFileName
For i = 1 To UBound(TB)
tempz = Str$(TB(i).Id)
WritePrivateProfileString "Custom", "ButtonID" + Format$(i,"00"), tempz, INIFileName
tempz = Str$(TB(i).Style)
WritePrivateProfileString "Custom", "ButtonStyle" + Format$(i,"00"), tempz, INIFileName
WritePrivateProfileString "Custom", "ButtonText" + Format$(i,"00"), (TB(i).txt), INIFileName
Next i
End If
End Sub
Sub CPrint (SOut As String)
Static cWritten As Long, iMsgCount As Long
Incr iMsgCount
SOut = Str$(iMsgCount) + " " + SOut
If hConsole = 0 Then AllocConsole: hConsole = GetStdHandle(-11&)
WriteConsole hConsole, ByCopy sOut + $CrLf, Len(sOut) + 2, cWritten, ByVal 0&
End Sub
'gbs_00821
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm