Here is example in 02progress(043) - Toolbar with imageList and menu with small 16x16 bitmaps
on each menu item.
bitmaps are in attachment - so just add them into same folder.
'toolbar & menu example - o2 /26.3.2018
$ filename "Menu3.exe"
Include "rtl32.inc"
'#lookahead
'structures.......................
Type WNDCLASSEX
cbSize as int
Style as int
lpfnwndproc as sys
cbClsextra as int
cbWndExtra as int
hInstance as int
hIcon as int
hCursor as int
hbrBackground as int
lpszMenuName as int
lpszClassName as int
hIconSm AS int
End Type
Type POINTAPI
x as INT
y as INT
End Type
Type RECT
Left as INT
Top as INT
Right as INT
Bottom as INT
End Type
Type MSG
hwnd as int
message as int
wParam as int
lParam as int
time as dword
pt as POINTAPI
End Type
type NMHDR
int hwndFrom
int idFrom
dword code
End type
'.............................
'constants
% IDI_WINLOGO = 32517
% IDI_APPLICATION = 32512
% IDC_ARROW = 32512
% CS_OWNDC = 32
% CS_DBLCLKS = 0x0008
% SW_NORMAL = 1
% SW_SHOW = 5
% WM_CREATE = 1
% WM_DESTROY = 2
% WM_PAINT = 15
% WM_QUIT = 18
% WM_SIZE = 5
% WM_MOVE = 3
% WM_CHAR = 258
% WM_KEYDOWN = 256
% WM_KEYUP = 257
% WM_MOUSEMOVE = 512
% WM_MBUTTONDOWN = 519
% WM_LBUTTONDOWN = 513
% WM_RBUTTONDOWN = 516
% WM_LBUTTONUP = 514
% WM_RBUTTONUP = 517
% WM_MBUTTONUP = 520
% WM_USER = 0x0400
% WS_OVERLAPPEDWINDOW = 0x00CF0000
% WS_intMENU = 0x80000
% WS_OVERLAPPED = 0x00000000
% WS_POPUP = 0x80000000
% WS_DLGFRAME = 0x400000
% WS_CHILD = 0x40000000
% WS_VISIBLE = 0x10000000
'defines...
INT WHITE_BRUSH = 8
' bitmaps
% BM_SETIMAGE = 247
% MF_BYPOSITION = &H400
% IMAGE_BITMAP = 0
% COLOR_BTNFACE = 15
% ILC_MASK = 1
% ILC_COLOR8 = 8
% ILC_COLOR16 = 16
% PS_SOLID = 0
% SRCCOPY = 0xCC0020
'toolbar & tooltips constants ................................
% TOOLBARCLASSNAME = "ToolbarWindow32"
% TB_SETTOOLTIPS = 1060
% TB_BUTTONSTRUCTSIZE = 1054
% TB_SETBUTTONSIZE = (WM_USER + 31)
% TB_SETBUTTONWIDTH = (WM_USER + 59)
% TB_ADDBITMAP = 1043
% TB_ADDBUTTONS = 1044
% TBSTATE_ENABLED = 4
% TBSTYLE_BUTTON = 0
% TBTOOLTIPS = 256
% TBSTYLE_TOOLTIPS = 0x0100
% TBSETTIP = 9
% TTS_ALWAYSTIP = 0x01
% TTS_NOPREFIX = 0x02
% TTS_BALLOON = 0x040 ' comctl32.dll v5.8 require
% TTM_ACTIVATE = WM_USER+1
% TTM_ADDTOOL = (WM_USER + 4)
% TTM_DELTOOL = (WM_USER + 5)
% TTM_NEWTOOLRECT = (WM_USER + 6)
% TTM_GETTOOLINFO = (WM_USER + 8)
% TTM_SETTIPBKCOLOR = (WM_USER + 19)
% TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
% TTM_SETMAXTIPWIDTH = (WM_USER + 24)
% TTM_UPDATETIPTEXT = 1036
% TTDT_AUTOPOP = 2
% TTDT_INITIAL = 3
% TTF_IDISHWND = 1
% TTF_CENTERTIP = 2
% TTF_SUBCLASS = 0x0010
% CCS_ADJUSTABLE = 32
% CCS_NODIVIDER = 64
% TBSTYLE_FLAT = 2048
% TBSTYLE_LIST = 0x01000
% TB_ADDBUTTONS = WM_USER+21
% TB_SETIMAGELIST = 1072
% TB_ADDBITMAP = 1043
% TB_AUTOSIZE = 1057
'..........................
Type TOOLINFO
cbSize As int
uFlags As int
hWnd As int
uId As int
cRect As Rect
hinst As int
lpszText As int
End Type
'toolbar button UDT
TYPE TBBUTTON
iBitmap as int
idCommand as int
fsState as byte
fsStyle as byte
bReserved[1] as byte
bReserved[1] as byte
dwData as dword
iString as int
End TYPE
TYPE TBADDBITMAP
int hInst
int nID
End TYPE
Type NMHDR
hwndFrom as int
idFrom as int
code as int
End Type
'typdef structure for intit_common_controlsEx
Type INITCOMMONCONTROLSEX_TYPE
dword dwSize
dword dwICC
End Type
'dim user32 = LoadLibrary "user32.dll"
'bind user32
'(
'Sendmessage SendMessageA
')
'declare toolbar function/ ret = SETTOOLBAR()
Declare Function SetToolbar (byval hwnd as INT,byval flag as INT,byval ex as INT,byval id as INT) As INT
Declare Function RGB(byval red as int,byval green as int,byval blue as int) as int
Declare Function SetToolTip (byval _tthwnd as INT) As INT
Declare SUB AddTButton(byval hwnd as int,byval cid as int,byval iNumber as int,byval tips as string)
'declarations...
Declare Function LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As INT, ByVal lpsz As String, ByVal dwType As INT, ByVal dwWidth As INT, ByVal dwHeight As INT, ByVal dwFlags As INT) As int
Declare Function LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As INT, ByVal lpIconName As Any) As INT
Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As INT, ByVal lpCursorName As Any) As INT
Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (int lpModuleName) as INT
Declare Function RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (byref lpwcx as WNDCLASSEX) as INT
Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (byval dwExStyle AS INT,byval lpClassName AS STRING,byval lpWindowName AS STRING,byval dwStyle AS INT,byval x AS INT,byval y AS INT,byval nWidth AS INT,byval nHeight AS INT,byval hWndParent AS INT,byval hMenu AS INT,byval hInstance AS INT,byval lpParam AS INT) as INT
Declare Function TranslateMessage Lib "user32.dll" (byref lpMsg as MSG) as INT
Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (byref lpMsg as MSG) as INT
Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" (lpMsg As MSG, ByVal hWnd As INT, ByVal wMsgFilterMin As INT, ByVal wMsgFilterMax As INT) As INT
Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As INT, ByVal nCmdShow As INT) As INT
Declare Function UpdateWindow Lib "user32.dll" (ByVal lhwnd As INT) As INT
Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As INT, ByVal wMsg As INT, ByVal wParam As INT, ByVal lParam As INT) As INT
Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As INT)
Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As INT) As INT
Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As INT) As INT
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As INT) As INT
' COMMENT NEXT LINE & UNcomment bind user32 () -------------------------------------------------------------------------------------------
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As INT, ByVal dwMsg As INT, ByVal wParam As INT, lParam As Any) As INT
'! SendMessage Lib "user32.dll" Alias "SendMessageA" (byval hWnd As int,byval dwMsg As int,byval wParam As int, lParam As int) As int
! MoveWindow Lib "user32.dll" (ByVal hwnd As INT, ByVal x As INT, ByVal y As INT, ByVal nWidth As INT, ByVal nHeight As INT, ByVal bRepaint As INT) As INT
Declare Function SetFocus Lib "user32.dll" Alias "SetFocus" (ByVal hWnd As INT) As INT
Declare Function CreatePopupMenu Lib "user32.dll" () As INT
Declare Function CreateMenu Lib "user32.dll" () As INT
Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As INT) As INT
Declare Function SetMenu Lib "user32.dll" (ByVal hwnd As INT, ByVal hMenu As INT) As INT
Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As INT, ByVal wFlags As INT, ByVal wIDNewItem As INT, ByVal lpNewItem As Any) As INT
Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As INT) As INT
Declare Function DeleteMenu Lib "user32.dll" (ByVal hMenu As INT, ByVal nPosition As INT, ByVal wFlags As INT) As INT
Declare Function DestroyMenu Lib "user32.dll" (ByVal hMenu As INT) As INT
Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As INT, ByVal wFlags As INT, ByVal x As INT, ByVal y As INT, ByVal nReserved As INT, ByVal hwnd As INT, lprc As RECT) As INT
! SetMenuItemBitmaps Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
'/// COMCTL32.DLL ///////////
'Declare InitCommonControlsEx Lib "comctl32.dll" (INITCOMMONCONTROLSEX_TYPE *ic) as int
Declare Function InitCommonControlsEx Lib "comctl32.dll" (icc As INITCOMMONCONTROLSEX_TYPE) As int
Declare Function ImageList_Create Lib "comctl32.dll" (byval cx as int,byval cy as int,byval flags as int,byval cInitial as int,byval cGrow as int) as int
Declare Function ImageList_Add Lib "comctl32.dll" (ByVal cx As Int, ByVal cy As Int ByVal flags As uint, ByVal cInitial as Int, ByVal cGrow as Int) As int
Declare Function ImageList_AddMasked Lib "comctl32.dll" (byval hImageList as int,byval hBitmap as int,byval crMask as int) as int
Dim wcx as WNDCLASSEX
Dim wm as MSG
Dim win,style, Wx, Wy, Ww, Wh, wparent as INT
Dim wcaption,ClassName as String
'wcaption = "MyWindow"
classname = "Oxygen"
style = WS_OVERLAPPEDWINDOW
Wx=100 : Wy=100 : Ww=640 : Wh=480
wparent = 0 'HWND_DESKTOP
'-------------------------------
'FILL WNDCLASSEX structure
inst = GetModuleHandle 0
wcx.cbSize = SizeOf(WNDCLASSEX)
wcx.style = CS_DBLCLKS | CS_OWNDC
wcx.lpfnWndProc = &WndProc
wcx.cbClsExtra = 0
wcx.cbWndExtra = 0
wcx.hInstance = inst
wcx.hIcon = LoadIcon 0,IDI_APPLICATION
wcx.hCursor = LoadCursor 0,IDC_ARROW
wcx.hbrBackground = CreateSolidBrush(GetSysColor(15))
wcx.lpszMenuName = strptr ""
wcx.lpszClassName = strptr Classname
wcx.hIconSm = 0
RegisterClassEx wcx
wcaption = "My Menu"
'create window -------------------------------
win = CreateWindowEx 0,ClassName , wcaption, style, Wx, Wy, Ww, Wh, wparent, 0, inst,0
ShowWindow win,SW_SHOW
'create Menu ---------------------------------------------------------
'Appendmenu hMenu , wFlags, wIDNewItem, lpNewItem
INT mainMenu,submenu1,submenu2
INT mImg1 = LoadImage(0, "iNew.bmp", 0, 16, 16, 24)
INT mImg2 = LoadImage(0, "iOpen.bmp", 0, 16, 16, 24)
INT mImg3 = LoadImage(0, "iSave.bmp", 0, 16, 16, 24)
INT mImg4 = LoadImage(0, "iQuit.bmp", 0, 16, 16, 24)
mainMenu = CreateMenu()
'...............................................
submenu1 = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (submenu1, 0,120,strptr "New")
SetMenuItemBitmaps(submenu1, 0,MF_BYPOSITION , mImg1, 0) 'add menu item bitmap
AppendMenu (submenu1,0,121,strptr "Open")
SetMenuItemBitmaps(submenu1, 1,MF_BYPOSITION , mImg2, 0)
AppendMenu (submenu1,0,122,strptr "Save")
SetMenuItemBitmaps(submenu1, 2,MF_BYPOSITION , mImg3, 0)
AppendMenu (submenu1,0,123,strptr "Quit")
SetMenuItemBitmaps(submenu1, 3,MF_BYPOSITION , mImg4, 0)
'set submwnu1 on main menu
AppendMenu (mainMenu,16,submenu1,strptr "File")
'...............................................
submenu2 = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (submenu2,0,124,strptr "Undo")
AppendMenu (submenu2,0,125,strptr "Cut")
AppendMenu (submenu2,0,126,strptr "Copy")
AppendMenu (submenu2,0,127,strptr "Paste")
'set submwnu1 on main menu
AppendMenu (mainMenu,16,submenu2,strptr "Edit")
'...............................................
SetMenu win ,mainMenu
'-----------------------------------------------
'TOOLBAR-------------------------------------------------------------
TBBUTTON tbb
TOOLINFO tti
Dim AddBmp as TBADDBITMAP
' setting common control mode
Dim ic as INITCOMMONCONTROLSEX_TYPE
ic.dwSize = SizeOf(ic)
ic.dwICC = 4
' initialize common controls 32
InitCommonControlsEx(ic)
with Addbmp
.hinst = -1
.nID = 0
End with
int htbar
INT toolID = 99
'add handlers
INT hImageList,hImage,maskRet,
'create toolbar -----------------------------------------------------
'htbar = SetToolbar ( hwnd, style, index, toolID)
htbar = SetToolBar (win, 0, 0, toolID)
'Properly resize toolbar to fit each image 24x24 image segment,h=32
MoveWindow(htbar, 0, 0, 434, 32, 0)
indexbase 0
' Set the imagelist used with default images
hImageList = ImageList_Create(24, 24, ILC_MASK | ILC_COLOR8, 1, 0)
hImage = LoadImage(0, "rCodetb24.bmp", 0, 336, 24, 24)
'print "IMAGE " + str(hImage)
maskRet = ImageList_AddMasked hImageList,byval hImage, RGB(231,223,231)
'print "MASK " + str(maskRet)
DeleteObject hImage
'set image list
SendMessage htbar, 1072, 0,byval hImageList 'use byval for imageList handler
'set button structure size
SendMessage htbar , 1054, sizeof(tbb), null
'TBUTTONS & TOOLTIPS -------------------------------------------------
INT tooltip
tooltip = SetToolTip(htbar)
AddTButton(htbar, 100, 0, "New File")
AddTButton(htbar, 101, 1, "Open File")
AddTButton(htbar, 102, 2, "Save As...")
AddTButton(htbar, 103, 3, "Save File")
AddTButton(htbar, 104, 4, "Close File")
AddTButton(htbar, 105, 5, "ASCI Table")
AddTButton(htbar, 106, 6, "Parser")
AddTButton(htbar, 107, 7, "Compile::")
AddTButton(htbar, 108, 8, "Run")
AddTButton(htbar, 109, 9, "Web Site")
AddTButton(htbar, 110, 10, "Info")
AddTButton(htbar, 111, 11, "Find")
AddTButton(htbar, 112, 12, "Options")
AddTButton(htbar, 113, 13, "Help")
SetFocus win
'message loop
While GetMessage(wm,0,0,0)
TranslateMessage wm
DispatchMessage wm
Wend
'main callback procedure ---------------------------------------
Function WndProc (sys hwnd,wMsg,wParam,lParam) as sys callback
Select wMsg
Case WM_DESTROY
PostQuitMessage 0
End Select
Return DefWindowProc(Hwnd,wMsg,wParam,lParam)
End Function
'------------------------------------------
Function SetToolbar (byval _tbhwnd as int ,byval _tbflag as INT,byval _ex as INT,byval cID as INT) As INT
INT _hfont
INT TBSTYLES = TBSTYLE_FLAT | WS_VISIBLE | WS_CHILD
If _tbflag = 0
'_tbflag = TBSTYLES
'ELSE
_tbflag = 1342179328 | TBSTYLES | 4 | &H100
End If
hTBControl = CreateWindowEx(_ex, TOOLBARCLASSNAME,null,_tbflag,0,0,0,0,_tbhwnd, cID,0,0)
'SendMessage hTBControl, TB_SETBUTTONSIZE, 0, 32
' _hfont = GetStockObject(17)
'SendMessage hTBControl,WM_SETFONT,_hfont,0ž
Showwindow htbcontrol,1
UpdateWindow _tbhwnd
Function = hTBControl
'End Function
End Function
'---------------------------------------------------
SUB AddTButton(byval twnd as int,byval id as int,byval iNum as int,byval tip as string)
'TOOLINFO tti
tti.cbSize = SizeOf(tti)
tti.uFlags = 0 'TTF_SUBCLASS | TTF_IDISHWND
tti.hwnd = twnd
tti.uId = id
tti.hinst = 0
tti.lpszText = strPtr tip
SendMessage(SendMessage( htbar, 1059,0,0),1028, 0, tti)
string number = str(inum)
'add button
tbb.iBitmap = iNum
tbb.idCommand = id
tbb.fsState = 4
tbb.fsStyle = 0
tbb.dwData = 0
'tbb.iString = strptr number
SendMessage htbar , tb_addbuttons, iNum, tbb
'SendMessage htbar, TB_SETBUTTONWIDTH, 0, 0
'SendMessage htbar, 1052, 0, 0
End SUB
'=====================================================================================
'set tooltip control
Function SetToolTip (byval _tthwnd as INT) As INT
INT _hfont
hTTControl = CreateWindowEx(0,"tooltips_class32","", -805306368,0,0,0,0,_tthwnd,0,0,0)
SendMessage( _tthwnd, 1060, hTTControl,0)
Function = hTTControl
End Function
'----------------------------------------------------
Function RGB(byval red as INT,byval green as INT,byval blue as int) as int
int color
color = red
color = color + green*256
color = color + blue*65536
Return color
End Function
