Display Icons in ressources on TOOLBAR

[spartacus13012]

Hello from france

I created a "toolbar" by the following code

Code: Select all

        hToolBar = CreateWindowEx(WS_EX_TOOLWINDOW OR WS_EX_CLIENTEDGE, _
                                    TOOLBARCLASSNAME, "", _
                                    WS_CHILD OR WS_VISIBLE, _
                                    0, 0, 0, 0, SYSTEM_HWnd_Window_Main, _
                                    null, null, null)
      ...........


I used the standard icons

Code: Select all

        STD_FILEOPEN, STD_FILENEW, STD_FILESAVE, STD_CUT
        STD_COPY, STD_PASTE, STD_DELETE, STD_FIND
        STD_REPLACE, STD_UNDO, STD_REDOW, STD_PRINT, STD_PROPERTIES


Now I would like to use directly icons in resources of this kind

Code: Select all

   #define icon_applic 100
   #define toolbar_openproject 101
   #define toolbar_saveproject 104
   #define toolbar_savefile 110

   icon_applic ICON DISCARDABLE "T:/PROJET/interface/darius.ico"
   toolbar_openproject ICON DISCARDABLE "T:/PROJET/interface/toolbar_openproject.ico"
   toolbar_saveproject ICON DISCARDABLE "T:/PROJET/interface/toolbar_saveproject.ico"
   toolbar_savefile ICON DISCARDABLE "T:/PROJET/interface/toolbar_savefile.ico"      


I looked in the microsoft doc and apparently it is possible but I did not get there with

Code: Select all

   TB_ADDBITMAP and TBBUTTON


Either I have looked for it or there is no such example.

One of you has experienced it.

thank you in advance

[Pierre Bellisle]

Salut Spartacus,

You may try the following...
Just set the LoadImage() function to reflect what is in your resource...

Pierre

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
'_____________________________________________________________________________
'

[spartacus13012]

Thank you very much I'll see how it works

Salut Spartacus,

You may try the following...
Just set the LoadImage() function to reflect what is in your resource...

Pierre

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
'_____________________________________________________________________________
'