You may try the following...
Just set the LoadImage() function to reflect what is in your resource...
Code: Select all
#Define JumpCompiler "<D:\Free\64\fbc.exe>"
#Define JumpCompilerCmd "<-s gui -w pedantic "D:\Free\bas\~~Default.rc">"
#define unicode
#Include Once "windows.bi"
#Include Once "win\commctrl.bi"
#Include Once "win\shellapi.bi"
#Define AppName "Toolbar"
#Define Toolbar 101
#Define ButtonExit 201
Const ButtonCommand01 = 301
Const ButtonCommand02 = 302
Const ButtonCommand03 = 303
Const ButtonCommand04 = 304
Const ButtonCommand05 = 305
Const ButtonCommand06 = 306
Const ButtonCommand07 = 307
Const ButtonCommand08 = 308
Const ButtonCommand09 = 309
Dim Shared As HINSTANCE hInstance : hInstance = GetModuleHandle(NULL)
'_____________________________________________________________________________
Function WndProc(ByVal hWnd As HWND, ByVal uMsg As UINT, ByVal wParam As WPARAM, ByVal lParam As LPARAM) As Integer
Static hImageList AS HIMAGELIST
Static hToolbar As HWND
Static hFont As HFONT
Dim hButtonExit As HWND
Select Case uMsg
Case WM_CREATE
Function = 0
'Get Windows default font - - - - - - - - - - - - - - - - - - - - - - - -
Dim As NONCLIENTMETRICS NotClientMetrics : NotClientMetrics.cbSize = SizeOf(NONCLIENTMETRICS)
SystemParametersInfo(SPI_GETNONCLIENTMETRICS, NotClientMetrics.cbSize, @NotClientMetrics, 0)
hFont = CreateFontIndirect(@NotClientMetrics.lfMessageFont)
'Create the exit button - - - - - - - - - - - - - - - - - - - - - - - - -
hButtonExit = CreateWindowEx(0, "Button", "E&xit", _
WS_CHILD Or WS_VISIBLE Or BS_CENTER Or WS_TABSTOP Or _
BS_NOTIFY Or BS_TEXT Or BS_VCENTER, _
223, 85, 80, 30, _
hWnd, Cast(HMENU, ButtonExit), _
hInstance, NULL)
SendMessage(hButtonExit, WM_SETFONT, Cast(WPARAM, hFont), TRUE)
'Create the toolbar - - - - - - - - - - - - - - - - - - - - - - - - - - -
hToolbar = CreateWindowEx(0, "ToolbarWindow32", "", _
WS_CHILD OR WS_VISIBLE OR TBSTYLE_FLAT OR TBSTYLE_TRANSPARENT OR TBSTYLE_TOOLTIPS OR _
TBSTYLE_WRAPABLE OR CCS_NODIVIDER OR CCS_NORESIZE OR CCS_ADJUSTABLE, _
0, 0, 600, 42 + 22, _
hWnd, Cast(HMENU, Toolbar), _
hInstance, NULL)
SendMessage(hToolbar, WM_SETFONT, Cast(WPARAM, hFont), TRUE)
SendMessage(hToolbar, TB_BUTTONSTRUCTSIZE, SIZEOF(TBBUTTON), 0) 'For system to determine common control version.
SendMessage(hToolbar, TB_SETBITMAPSIZE, 0, MakeLong(32, 32)) 'Set the size of the bitmap.
'Create the toolbar text button string - - - - - - - - - - - - - - - - -
Dim sButtonString As String
sButtonString = "Button 0" & Chr(0) & "Button 1" & Chr(0) & _
"Button 2" & Chr(0) & "Button 3" & Chr(0) & "Button 4" & Chr(0) & "Button 5" & Chr(0) & _
"Button 6" & Chr(0) & "Button 7" & Chr(0) & "Button 8" & Chr(0) & "Button 9" & Chr(0) & Chr(0)
SendMessageA(hToolbar, TB_ADDSTRINGA, 0, Cast(lParam, StrPtr(sButtonString)))
'Add the toolbar buttons icons - - - - - - - - - - - - - - - - - - - - -
Dim Looper As Long
Dim ToolbarButton(0 to 9) As TBBUTTON
For Looper = 0 To 9
ToolbarButton(Looper).iBitmap = Looper
ToolbarButton(Looper).idCommand = ButtonCommand01 + Looper
ToolbarButton(Looper).fsState = TBSTATE_ENABLED
ToolbarButton(Looper).fsStyle = BTNS_BUTTON
ToolbarButton(Looper).dwData = 0
ToolbarButton(Looper).iString = Looper
Next
SendMessage(hToolbar, TB_ADDBUTTONS, 10, Cast(lParam, @ToolbarButton(0)))
SendMessage(hToolbar, TB_AUTOSIZE, 0, 0)
DIM hIco AS HICON
hImageList = ImageList_Create(32, 32, ILC_COLOR32 Or ILC_MASK, 10, 0)
ImageList_SetBkColor(hImageList, CLR_NONE)
For Looper = 0 To 9
hIco = ExtractIcon(hInstance, "Shell32.dll", 191 + Looper)
'hIco = LoadImage(hInstance, "ResourceName", IMAGE_ICON, 32, 32, LR_DEFAULTCOLOR) 'Icon via resource name
'hIco = LoadImage(hInstance, Cast(LPCTSTR, 101), IMAGE_ICON, 0, 0, LR_DEFAULTCOLOR) 'Icon via resource id number
ImageList_ReplaceIcon(hImageList, -1, hIco)
DestroyIcon(hIco)
Next
SendMessage(hToolbar, TB_SETIMAGELIST, 0, Cast(lParam, hImageList))
Case WM_COMMAND
Select Case LoWord(wParam)
Case ButtonCommand01 To ButtonCommand01 + 9
If HiWord(wParam) = BN_CLICKED Then
SetWindowText(hWnd, "Button id " & STR$(LoWord(wParam)))
EndIf
Case ButtonExit
If HiWord(wParam) = BN_CLICKED Then
PostMessage(hWnd, WM_CLOSE, 0, 0)
Exit Function
EndIf
End Select
Case WM_DESTROY
DeleteObject(hFont)
ImageList_Destroy(hImageList)
PostQuitMessage(0)
Exit Function
End Select
Function = DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
'_____________________________________________________________________________
Function WinMain(ByVal hInstance As HINSTANCE, ByVal hPrevInst As HINSTANCE, _
ByVal CmdLine As WString Ptr, ByVal CmdShow As Integer) As UINT
Dim WinClass As WNDCLASS
Dim wMsg As MSG
Dim hWnd As HWND
Dim hIco As HICON
Dim WindowSize As SIZEL
Dim wsAppName As WString * 64
wsAppName = AppName & " - " & SizeOf(UInteger) * 8
WindowSize.cx = 526
WindowSize.cy = 150
hIco = ExtractIcon(hInstance, "%SystemRoot%\System32\PowrPrOf.dll", 1)
WinClass.style = CS_HREDRAW Or CS_VREDRAW
WinClass.lpfnWndProc = ProcPtr(WndProc)
WinClass.cbClsExtra = 0
WinClass.cbWndExtra = 0
WinClass.hInstance = hInstance
WinClass.hIcon = hIco
WinClass.hCursor = LoadCursor(NULL, IDC_ARROW)
WinClass.hbrBackground = Cast(HGDIOBJ, COLOR_BTNFACE + 1) 'Default color
WinClass.lpszMenuName = NULL
WinClass.lpszClassName = @wsAppName
If (RegisterClass(@WinClass)) Then
hWnd = CreateWindowEx(WS_EX_WINDOWEDGE, _
wsAppName, wsAppName, _
WS_OVERLAPPED OR WS_CLIPCHILDREN Or WS_DLGFRAME Or WS_BORDER Or _
WS_VISIBLE Or WS_CAPTION Or WS_MINIMIZEBOX Or WS_SYSMENU , _
(GetSystemMetrics(SM_CXSCREEN) - WindowSize.cx) / 2, _ 'PosH
(GetSystemMetrics(SM_CYSCREEN) - WindowSize.cy) / 2, _ 'PosV
WindowSize.cx, WindowSize.cy, _ 'Width, height
NULL, NULL, hInstance, NULL)
ShowWindow(hWnd, SW_SHOW)
UpdateWindow(hWnd)
While GetMessage(@wMsg, ByVal NULL, 0, 0) > 0
If IsDialogMessage(hWnd, @wMsg) = 0 Then
TranslateMessage(@wMsg)
DispatchMessage(@wMsg)
End If
Wend
End If
DestroyIcon(hIco)
Function = wMsg.message
End Function
'_____________________________________________________________________________
End WinMain(hInstance, NULL, Command(), SW_NORMAL) 'Call main() and return the error code to the OS
'_____________________________________________________________________________
'