Charles
Do you can compile this example with 043
'skeleton VB way...
$ filename "Menu.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 sys
hIcon as sys
hCursor as sys
hbrBackground as sys
lpszMenuName as sys
lpszClassName as sys
hIconSm AS sys
End Type
Type POINTAPI
x as long
y as long
End Type
Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type
Type MSG
hwnd as sys
message as int
wParam as sys
lParam as sys
time as dword
pt as POINTAPI
End Type
'constants
% IDI_WINLOGO = 32517
% IDI_APPLICATION = 32512
% IDC_ARROW = 32512
% CS_OWNDC = 32
% CS_DBLCLKS = &H8
% 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
% WS_OVERLAPPEDWINDOW = 0x00CF0000
% WS_SYSMENU = 0x80000
% WS_OVERLAPPED = WS_SYSMENU
% WS_POPUP = 0x80000000
% WS_DLGFRAME = 0x400000
% WS_CHILD = 0x40000000
% WS_VISIBLE = 0x10000000
'defines...
INT WHITE_BRUSH = 8
'bm bitmaps
% BM_SETIMAGE = 247
% IMAGE_BITMAP = 0
% COLOR_BTNFACE = 15
% ILC_MASK = 1
% ILC_COLOR8 = 8
% ILC_COLOR16 = 16
% PS_SOLID = 0
% SRCCOPY = 0xCC0020
'tooltips constants .................................................
% TB_SETTOOLTIPS = 1060
% EBTOOLTIPS = 256
% TBSTYLE_TOOLTIPS = &H100
% TBSETTIP = 9
% TTS_ALWAYSTIP = &H1
% TTS_NOPREFIX = &H2
% TTS_BALLOON = &H40 ' 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 = &H1
% TTF_CENTERTIP = &H2
% TTF_SUBCLASS = &H10
% CCS_ADJUSTABLE = 32
% CCS_NODIVIDER = 64
% TBSTYLE_FLAT = &H800
% 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 sys
End Type
'toolbar button UDT
TYPE TBBUTTON
iBitmap as long
idCommand as long
fsState as byte
fsStyle as byte
bReserved[0] as byte
bReserved[1] as byte
dwData as long
iString as sys
END TYPE
TYPE TBADDBITMAP
sys hInst
sys nID
END TYPE
Type NMHDR
hwndFrom as sys
idFrom as sys
code as sys
End Type
'typdef structure for intit_common_controlsEx
Type INITCOMMONCONTROLSEX_TYPE
dwSize As dword
dwICC As dword
End Type
'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 sys,byval green as sys,byval blue as sys) as sys
Declare Function SetToolTip (byval _tthwnd as INT) As INT
Declare SUB AddTButton(byval twnd as int,byval id as int,byval iNum as int,byval tip as string)
'declarations...
! LoadImage Lib "user32.dll" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwType As Long, ByVal dwWidth As Long, ByVal dwHeight As Long, ByVal dwFlags As Long) As Long
Declare Function LoadIcon Lib "user32.dll" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Any) As Long
Declare Function LoadCursor Lib "user32.dll" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Declare Function GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" (sys lpModuleName) as Long
Declare Function RegisterClassEx Lib "user32.dll" Alias "RegisterClassExA" (byref lpwcx as WNDCLASSEX) as Long
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 Long
Declare Function TranslateMessage Lib "user32.dll" (byref lpMsg as MSG) as Long
Declare Function DispatchMessage Lib "user32.dll" Alias "DispatchMessageA" (byref lpMsg as MSG) as Long
Declare Function GetMessage Lib "user32.dll" Alias "GetMessageA" (lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Declare Function UpdateWindow Lib "user32.dll" (ByVal lhwnd As Long) As Long
Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub PostQuitMessage Lib "user32.dll" (ByVal nExitCode As Long)
Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
! SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal dwMsg As Long,byVal wParam As Long,byRef lParam As Long) As Long
Declare Function CreatePopupMenu Lib "user32.dll" () As Long
Declare Function CreateMenu Lib "user32.dll" () As Long
Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function SetMenu Lib "user32.dll" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As Long) As Long
Declare Function DeleteMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DestroyMenu Lib "user32.dll" (ByVal hMenu As Long) As Long
Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
'/// COMCTL32.DLL ///////////
'Declare InitCommonControlsEx Lib "comctl32.dll" (INITCOMMONCONTROLSEX_TYPE *ic) as sys
Declare Function InitCommonControlsEx Lib "comctl32.dll" ( lpInitCtrls As INITCOMMONCONTROLSEX_TYPE) As Long
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 sys
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 sys
Declare Function ImageList_AddMasked Lib "comctl32.dll" (byval hImageList as sys,byval hBitmap as sys,byval crMask as sys) as sys
Dim wcx as WNDCLASSEX
Dim wm as MSG
Dim win,style, Wx, Wy, Ww, Wh, wparent as Long
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
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 = "MyWindowEx"
'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
mainMenu = CreateMenu()
'...............................................
submenu1 = CreatePopupMenu ()
'addsub menu items with ID
AppendMenu (submenu1,0,100,strptr "New")
AppendMenu (submenu1,0,101,strptr "Open")
AppendMenu (submenu1,0,102,strptr "Save")
AppendMenu (submenu1,0,103,strptr "Quit")
'set submwnu on main menu
AppendMenu (mainMenu,16,submenu1,strptr "File")
'...............................................
'SetMenu win ,mainMenu
'-----------------------------------------------
'TOOLBAR-------------------------------------------------------------
Dim tbb as TBBUTTON
Dim AddBmp as TBADDBITMAP
' setting common control mode
Dim ice as INITCOMMONCONTROLSEX_TYPE
ice.dwSize = sizeOf(ice )
ice.dwICC = 4
' initialize common controls 32
InitCommonControlsEx(ice )
with Addbmp
.hinst = -1
.nID = 0
end with
INT htbar
INT toolID = 99
'add handlers
INT hImageList,hImage,iNum,id
'create toolbar -----------------------------------------------------
'htbar = SetToolbar (win, 0 , 0, toolID)
htbar = SetToolBar (win, 0,0, toolID)
Dim pHdr as NMHDR
MoveWindow(htbar, 0, 0, 440, 32,0)
' Set the imagelist used with default images
int hImageList = ImageList_Create(24, 24, ILC_MASK OR ILC_COLOR8, 1, 0)
int hImage = LoadImage(0, "rCodetb24.bmp", 0, 336, 24, 24)
ImageList_AddMasked hImageList, hImage, RGB(231,223,231)
DeleteObject hImage
'set image list
SendMessage htbar,TB_SETIMAGELIST,0, hImageList
'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")
'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
'never put default return inside 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_CHILD | WS_VISIBLE
If _tbflag = 0
_tbflag = 1342179328 | TBSTYLES |4 | &H100
'ELSE
'_tbflag=1342179328 | TBSTYLES |4 | _tbflag
End If
hTBControl = CreateWindowEx(_ex,"TOOLBARWINDOW32","",_tbflag,0,0,0,0,_tbhwnd, cID,0,0)
' _hfont = GetStockObject(17)
'SendMessage hTBControl,WM_SETFONT,_hfont,0
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)
'add button
tbb.iBitmap = iNum
tbb.idCommand = id
tbb.fsState = 4
tbb.fsStyle = 0
tbb.dwData = 0
SendMessage htbar , 1044, 1, tbb
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(sys red,green,blue) as sys
sys color
color = red
color = color + green*256
color = color + blue*65536
Return color
End Function
