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
%IDT_ButtonBase = 600 'reserve 600-649 to allow for 50 buttons
Type TBData
ID As Long
Style As Long
Txt As String * 20
End Type
Global hDlg,hConsole As Dword, TB() As TBData, ButtonCount As Long
Function PBMain()
Dialog New Pixels, 0, "Toolbar Shift-Drag Test",500,500,200,125, %WS_SysMenu, To hDlg
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
CreateToolbar
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_QueryDelete 'on mouse-down, zero-based index of button
NMT = Cb.LParam
StartMoveIndex = @NMT.iItem 'contains zero-based Index
EndMoveIndex = StartMoveIndex 'use later to test if move took place
Cprint "query_delete"
Function = %True 'always allows a move/delete to start
Case %TBN_QueryInsert 'on mouse-up, zero-based index of button, when user drops button on toolbar
NMT = Cb.LParam
EndMoveIndex = @NMT.iItem
Cprint "query_insert"
If StartMoveIndex <> EndMoveIndex Then Function = %True 'allow move only if move is to a new location
Case %TBN_ToolbarChange
Cprint "toolbarchange" + Str$(StartMoveIndex) + Str$(EndMoveIndex)
If StartMoveIndex = EndMoveIndex Then
'delete took place
Decr ButtonCount
Array Delete TB(StartMoveIndex+1)
ReDim Preserve TB(UBound(TB)-1)
Else
CPrint Str$(StartMoveIndex) + Str$(EndMoveIndex)
'move took place
Array Delete TB(StartMoveIndex+1) For (EndMoveIndex-StartMoveIndex), TB(StartMoveIndex+1)
End If
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
For i = 1 To UBound(TB)
Toolbar Add Button hDlg, %IDC_Toolbar, 0, TB(i).Id, TB(i).Style, Trim$(TB(i).txt)
Next i
End Sub
Sub SetToolbarDefaults
ButtonCount = 4
ReDim TB(1 To 4)
TB(1).Id = %IDT_ButtonBase + 0 : TB(1).Style = %TbStyle_Button : TB(1).txt = "one"
TB(2).Id = %IDT_ButtonBase + 1 : TB(2).Style = %TbStyle_Button : TB(2).txt = "two"
TB(3).Id = %IDT_ButtonBase + 3 : TB(3).Style = %TbStyle_Button : TB(3).txt = "three"
TB(4).Id = %IDT_ButtonBase + 3 : TB(4).Style = %TbStyle_Button : TB(4).txt = "four"
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_00820
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm