Below there is some code, windows API and so on... This is a window with an owner drawn menu, however, this is just a "proof-of-concept"... (I'm going to use a completed version with icons etc for the GC FormEditor)
Would be really nice if someone could test this code, just copy/paste into IDE and compile&run.
(I'm running it on WinXP, works fine :-))
here is how it should at least look like:
Code: Select all
option explicit
#define WIN_INCLUDEALL
#include "windows.bi"
#ifndef ODS_HOTLIGHT
#define ODS_HOTLIGHT &h0040
#endif
#ifndef ODS_INACTIVE
#define ODS_INACTIVE &h0080
#endif
declare function WndProc ( byval hWnd as HWND, byval message as UINT, byval wParam as WPARAM, byval lParam as LPARAM ) as LRESULT
dim shared hInstance as HINSTANCE
dim shared as string prog_name
prog_name = "menu_test"
dim as MSG wMsg
hInstance = GetModuleHandle(null)
dim as WNDCLASS wcls
wcls.style = CS_HREDRAW or CS_VREDRAW
wcls.lpfnwndproc = @WndProc
wcls.cbClsExtra = 0
wcls.cbWndExtra = 0
wcls.hInstance = hInstance
wcls.hIcon = LoadIcon(hInstance, IDI_APPLICATION)
wcls.hCursor = LoadCursor(null, IDC_ARROW)
wcls.hbrBackground = cptr(HGDIOBJ,16)
wcls.lpszMenuName = 0
wcls.lpszClassName = strptr(prog_name)
if (RegisterClass(@wcls) = false) then end
dim shared hWnd as HWND
dim shared as HMENU hMenu
dim shared as HMENU hMenu_File, hMenu_Help
dim shared as HBRUSH hBr_MouseOver_Bckgrnd, hBr_MouseOver_Frame, hBr_MIIBckgrnd, hBr_MBckgrnd
hBr_MIIBckgrnd = CreateSolidBrush(rgb(255,255,255))
hBr_MBckgrnd = CreateSolidBrush(GetSysColor(COLOR_MENU))
hBr_MouseOver_Bckgrnd = CreateSolidBrush(rgb(255,200,200))
hBr_MouseOver_Frame = CreateSolidBrush(rgb(255,0,0))
enum
IDM_FILE_ = 1
IDM_FILE_NEW
IDM_FILE_OPEN
IDM_FILE_SAVE
IDM_FILE_EXIT
IDM_HELP_
IDM_HELP_ABOUT
end enum
'--------------------------------------------------------------------------------------------------------------------------------
'
' Create the window and show it
'
'
'
hWnd = CreateWindowEx( 0, prog_name, prog_name, _
WS_VISIBLE or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX, _
0 , 0 , 600, 500 , _
null, null, hInstance, null )
ShowWindow(hWnd, SW_NORMAL)
UpdateWindow(hWnd)
hMenu = CreateMenu()
hMenu_File = CreatePopupMenu()
hMenu_Help = CreatePopupMenu()
dim as MENUITEMINFO mii
dim as string text
with mii
.cbsize = len(mii)
.fMask = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
.fType = MFT_OWNERDRAW
.fState = MFS_ENABLED
.wID = IDM_FILE_
.hSubMenu = hMenu_File
end with
InsertMenuItem(hMenu, 1, TRUE, @mii)
with mii
.cbsize = len(mii)
.fMask = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
.fType = MFT_OWNERDRAW
.fState = MFS_ENABLED
.wID = IDM_HELP_
.hSubMenu = hMenu_Help
end with
InsertMenuItem(hMenu, 2, TRUE, @mii)
with mii
.cbsize = len(mii)
.fMask = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
.fType = MFT_OWNERDRAW
.fState = MFS_ENABLED
.wID = IDM_FILE_NEW
.hSubMenu = null
end with
InsertMenuItem(hMenu_File, 1, TRUE, @mii)
with mii
.cbsize = len(mii)
.fMask = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
.fType = MFT_OWNERDRAW
.fState = MFS_ENABLED
.wID = IDM_FILE_OPEN
.hSubMenu = null
end with
InsertMenuItem(hMenu_File, 2, TRUE, @mii)
with mii
.cbsize = len(mii)
.fMask = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
.fType = MFT_OWNERDRAW
.fState = MFS_ENABLED
.wID = IDM_FILE_SAVE
.hSubMenu = null
end with
InsertMenuItem(hMenu_File, 3, TRUE, @mii)
with mii
.cbsize = len(mii)
.fMask = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
.fType = MFT_OWNERDRAW
.fState = MFS_ENABLED
.wID = IDM_FILE_EXIT
.hSubMenu = null
end with
InsertMenuItem(hMenu_File, 4, TRUE, @mii)
with mii
.cbsize = len(mii)
.fMask = MIIM_ID or MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE
.fType = MFT_OWNERDRAW
.fState = MFS_ENABLED
.wID = IDM_HELP_ABOUT
.hSubMenu = null
end with
InsertMenuItem(hMenu_Help, 1, TRUE, @mii)
SetMenu(hWnd, hMenu)
DrawMenuBar(hWnd)
while ( GetMessage( @wMsg, null, 0, 0 ) <> false )
TranslateMessage @wMsg
DispatchMessage @wMsg
wend
DeleteObject(hBr_MIIBckgrnd)
DeleteObject(hBr_MBckgrnd)
DeleteObject(hBr_MouseOver_Bckgrnd)
DeleteObject(hBr_MouseOver_Frame)
end wMsg.wParam
function WndProc ( byval hWnd as HWND, byval message as UINT, byval wParam as WPARAM, byval lParam as LPARAM ) as LRESULT
dim rct as RECT
dim hDC as HDC
dim Id as integer, NotificationCode as integer, hwndFrom as HWND
WndProc = 0
select case ( message )
case WM_MEASUREITEM
dim as MEASUREITEMSTRUCT ptr pmis = cptr(MEASUREITEMSTRUCT ptr, lParam)
select case pmis->CtlType
case ODT_MENU
if pmis->itemID = IDM_FILE_ or _
pmis->itemID = IDM_HELP_ then
pmis->itemWidth = 30
pmis->itemHeight = 20
else
pmis->itemWidth = 100
pmis->itemHeight = 20
end if
end select
case WM_DRAWITEM
dim as DRAWITEMSTRUCT ptr pdis = cptr(DRAWITEMSTRUCT ptr, lParam)
select case pdis->CtlType
case ODT_MENU
hDC = pdis->hDC
rct = pdis->rcItem
dim as uinteger action= pdis->itemAction
dim as uinteger state = pdis->itemState
dim as uinteger miid = pdis->itemID
if (state and (ODS_SELECTED)) then
FillRect(hDC, @rct, hBr_MouseOver_Bckgrnd)
FrameRect(hDC, @rct, hBr_MouseOver_Frame)
elseif (state and (ODS_HOTLIGHT)) then
FillRect(hDC, @rct, hBr_MouseOver_Bckgrnd)
FrameRect(hDC, @rct, hBr_MouseOver_Frame)
else
select case miid
case IDM_FILE_, IDM_HELP_
FillRect(hDC, @rct, hBr_MBckgrnd)
case else
FillRect(hDC, @rct, hBr_MIIBckgrnd)
end select
end if
dim as DRAWTEXTPARAMS dtp
dim as string text
dim as RECT textrct
dim as uinteger options
with dtp
.cbSize = len(dtp)
.iTabLength = 4
.iLeftMargin = 4
.iRightMargin = 4
end with
textrct.Left = rct.Left + 2
textrct.Top = rct.Top + 2
textrct.Right = rct.Right - 2
textrct.Bottom = rct.Bottom - 2
select case miid
case IDM_FILE_
text = "&File"
options = DT_CENTER
case IDM_FILE_NEW
text = "&New"
options = DT_LEFT
case IDM_FILE_OPEN
text = "&Open"
options = DT_LEFT
case IDM_FILE_SAVE
text = "&Save"
options = DT_LEFT
case IDM_FILE_EXIT
text = "E&xit"
options = DT_LEFT
case IDM_HELP_
text = "&Help"
options = DT_CENTER
case IDM_HELP_ABOUT
text = "&About"
options = DT_LEFT
end select
SetBKMode(hDC, TRANSPARENT)
options or= DT_EXPANDTABS or DT_VCENTER
DrawTextEx(hDC, strptr(text), len(text), @textrct, options, @dtp)
end select
case WM_COMMAND
hwndFrom = cptr(HWND, lParam)
NotificationCode = HIWORD(wParam)
Id = LOWORD(wParam)
if hwndFrom <= 0 then
select case NotificationCode
case 0
select case Id
case IDM_FILE_EXIT
PostQuitMessage(0)
end select
end select
end if
case WM_DESTROY
PostQuitMessage 0
case else
WndProc = DefWindowProc( hWnd, message, wParam, lParam )
end select
end function
