Donc j'ai péché ce code ultra bien fait.
(Inutile de dire que je vais mettre un mois à le comprendre) Il y a l'inclusion et l'exemple:
Code : Tout sélectionner
;By Trond
Procedure MenuItemEx(MenuItemID, Text.s, Icon.l)
MenuItem(MenuItemID, Text)
If Icon
Icon = Icon ;CatchImage(#PB_Any, Icon)
EndIf
ModifyMenu_(MenuID(0), MenuItemID, #MF_OWNERDRAW, MenuItemID, Icon)
EndProcedure
Procedure MenuItemFix(MenuItemID)
ModifyMenu_(MenuID(0), MenuItemID, #MF_OWNERDRAW, MenuItemID, 0)
EndProcedure
Procedure MeasureMenuItem(WindowID, Message, wParam, lParam)
Protected ItemHeight.l = 20
Protected *MeasureItem.MEASUREITEMSTRUCT = lParam
Protected Text.s
Protected Img.l
Protected hDC.l
Protected Rect.RECT
Protected TextWidth.l
Protected Metrics.NONCLIENTMETRICS
Protected MenuFont.l
If *MeasureItem\CtlType = #ODT_MENU
Text = Space(8192)
GetMenuString_(MenuID(0), *MeasureItem\itemID, @Text, 8192, 0)
Img = CreateImage(-1, 1, 1)
hDC = StartDrawing(ImageOutput(Img))
Metrics\cbSize = SizeOf(NONCLIENTMETRICS)
SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @Metrics, 0)
MenuFont = CreateFontIndirect_(@Metrics\lfMenuFont)
SelectObject_(hDC, MenuFont)
SetTextAlign_(hDC,#TA_LEFT|#TA_TOP|#TA_NOUPDATECP)
Rect.RECT\Right = 0
Rect\Bottom = 0
DrawText_(hDC, Text, Len(Text), @Rect, #DT_CALCRECT | #DT_EXPANDTABS | #DT_NOCLIP | #DT_SINGLELINE)
*MeasureItem\itemWidth = ItemHeight + Rect\Right ;TextWidth(ReplaceString(Text, #TAB$, Space(8)))
StopDrawing()
With *MeasureItem
If \itemWidth < 100
\itemWidth = 100
EndIf
EndWith
FreeImage(Img)
DeleteObject_(MenuFont)
*MeasureItem\itemHeight = ItemHeight
EndIf
EndProcedure
Procedure DrawMenuItem(WindowID, Message, wParam, lParam)
Protected ItemHeight.l = 20
Protected ItemWidth.l = 24
Protected *DrawItem.DRAWITEMSTRUCT = lParam
Protected Item.MENUITEMINFO
Protected Glyph.l = *DrawItem\itemData
Protected Text.s = Space(8192)
Protected hDC
Protected Left, Top, Right, Bottom
Protected Brush1, Pen1
Protected DrawFlag
GetMenuString_(MenuID(0), *DrawItem\itemID, @Text.s, 8192, 0)
If *DrawItem\CtlType = #ODT_MENU
hDC = *DrawItem\hDC
Left = *DrawItem\rcItem\left
Top = *DrawItem\rcItem\top
Right = *DrawItem\rcItem\right
Bottom = *DrawItem\rcItem\bottom
If (#ODS_SELECTED & *DrawItem\itemState)
If (#ODS_GRAYED & *DrawItem\itemState)
Brush1 = CreateSolidBrush_(GetSysColor_(#COLOR_MENU))
SetTextColor_(hDC, GetSysColor_(#COLOR_GRAYTEXT))
Pen1 = CreateSolidBrush_(GetSysColor_(#COLOR_MENU))
Else
Brush1 = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
SetTextColor_(hDC, GetSysColor_(#COLOR_HIGHLIGHTTEXT))
Pen1 = CreatePen_(#PS_SOLID, 1, GetSysColor_(#COLOR_HIGHLIGHT))
EndIf
ElseIf (#ODS_GRAYED & *DrawItem\itemState)
Brush1 = CreateSolidBrush_(GetSysColor_(#COLOR_MENU))
SetTextColor_(hDC, GetSysColor_(#COLOR_GRAYTEXT))
Pen1 = CreatePen_(#PS_SOLID, 1, GetSysColor_(#COLOR_MENU))
Else
Brush1 = CreateSolidBrush_(GetSysColor_(#COLOR_MENU))
SetTextColor_(hDC, GetSysColor_(#COLOR_MENUTEXT))
Pen1 = CreatePen_(#PS_SOLID, 1, GetSysColor_(#COLOR_MENU))
EndIf
SelectObject_(hDC, Brush1)
SelectObject_(hDC, Pen1)
Rectangle_(hDC, Left, Top, Right, Bottom)
SetBkMode_(hDC, #TRANSPARENT)
*DrawItem\rcItem\left + ItemWidth + 3
SystemParametersInfo_(#SPI_GETKEYBOARDCUES, 0, @DrawFlag, 0)
If (Not DrawFlag) And ((*DrawItem\itemState | #ODS_NOACCEL) = *DrawItem\itemState)
DrawFlag = #DT_HIDEPREFIX
Else
DrawFlag = 0
EndIf
DrawFlag = DrawFlag | #DT_SINGLELINE | #DT_VCENTER | #DT_EXPANDTABS
DrawText_(hDC, Text, Len(Text), *DrawItem\rcItem, DrawFlag)
*DrawItem\rcItem\left - ItemHeight
If Glyph
;hDCGlyph = StartDrawing(ImageOutput(Glyph))
;BitBlt_(hDC, (ItemHeight-ImageHeight(Glyph))/2, (ItemHeight-ImageHeight(Glyph))/2 + Top, ImageWidth(Glyph), ImageHeight(Glyph), hDCGlyph, 0, 0, #SRCCOPY)
;StopDrawing()
DrawIconEx_(hDC, (ItemWidth-ImageWidth(Glyph))/2, (ItemHeight-ImageHeight(Glyph))/2 + Top, ImageID(Glyph), ImageWidth(Glyph), ImageHeight(Glyph), 0, 0, #DI_NORMAL | #DI_COMPAT)
EndIf
DeleteObject_(Pen1)
DeleteObject_(Brush1)
EndIf
EndProcedure
Code : Tout sélectionner
XIncludeFile "super_menu_system.pbi"
Procedure MainWindowCallback(WindowID, Message, wParam, lParam)
Protected Result = #PB_ProcessPureBasicEvents
Select Message
Case #WM_MEASUREITEM
MeasureMenuItem(WindowID, Message, wParam, lParam)
Case #WM_DRAWITEM
DrawMenuItem(WindowID, Message, wParam, lParam)
EndSelect
ProcedureReturn Result
EndProcedure
OpenWindow(0, 0, 0, 512, 384, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
CreateGadgetList(WindowID(0))
SetWindowCallback(@MainWindowCallback(), 0)
CreateMenu(0, WindowID(MainWindow))
MenuTitle("&File")
n = LoadImage(-1, "tonicone.ico")
MenuItemEx(00, "&Open", n)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
EndSelect
ForEver