You might like this little better.
Code: Select all
;-
;- Constants - PRIVATE
#_Menu_None = 0
#_Menu_Item = 1
#_Menu_Drop = 2
#_Menu_Dropping = $010000
;-
;- Constants - PUBLIC
Enumeration Windows
#Win1
EndEnumeration
Enumeration Gadgets
#ListIcon_1
#ListIcon_2
#ListIcon_3
EndEnumeration
Enumeration MenuItems
#MenuItem1
#MenuItem2
#MenuItem3
#MenuItem4
#MenuItem5
#MenuItem6
#MenuItem7
#MenuItem8
#MenuItem9
#MenuItem10
#MenuItem11
#MenuItem12
EndEnumeration
;-
;- Structures - PRIVATE
Structure _Custom_Menu_Item
Text.s
MenuID.l
ImageID.i
EndStructure
Structure _Custom_Menu
Title.s
Flags.l
Canvas.i
Window.i
Popup.i
Width.l
Height.l
FontID.l
ColorFont.l
ColorIdleBorder.l
ColorIdleTop.l
ColorIdleBottom.l
ColorHoverBorder.l
ColorHoverTop.l
ColorHoverBottom.l
ColorPressBorder.l
ColorPressTop.l
ColorPressBottom.l
HoverItem.l
PressItem.l
List Item._Custom_Menu_Item()
EndStructure
;-
;- Globals - PRIVATE
Global _MenuLastPopup.i = #Null
;-
;- Macros - PUBLIC
Macro AddMenuGadgetBar(Mg)
AddMenuGadgetItem((Mg), "-")
EndMacro
;-
;- Procedures - PRIVATE
Procedure _MenuGadgetRedraw(*_Mg._Custom_Menu)
If (*_Mg And *_Mg\Canvas And IsGadget(*_Mg\Canvas))
With *_Mg
If (Not (*_Mg\Flags & #_Menu_Dropping))
Protected DrawingID.i = StartDrawing(CanvasOutput(\Canvas))
If (DrawingID)
Protected TopColor.i, BottomColor.i, BorderColor.i
If ((\PressItem = \HoverItem) And (\PressItem = #_Menu_Item))
TopColor = \ColorPressTop
BottomColor = \ColorPressBottom
BorderColor = \ColorPressBorder
ElseIf (\HoverItem)
TopColor = \ColorHoverTop
BottomColor = \ColorHoverBottom
BorderColor = \ColorHoverBorder
Else
TopColor = \ColorIdleTop
BottomColor = \ColorIdleBottom
BorderColor = \ColorIdleBorder
EndIf
DrawingMode(#PB_2DDrawing_Gradient)
BackColor(TopColor)
FrontColor(BottomColor)
LinearGradient(0, 0, 0, \Height)
Box(0, 0, \Width, \Height)
DrawingMode(#PB_2DDrawing_Default)
Box(0, 0, 1, \Height, BorderColor)
Box(0, 0, \Width, 1, BorderColor)
Box(0, \Height - 1, \Width, 1, BorderColor)
Box(\Width - 1, 0, 1, \Height, BorderColor)
If ((\PressItem = \HoverItem) And (\PressItem))
TopColor = \ColorPressTop
BottomColor = \ColorPressBottom
BorderColor = \ColorPressBorder
ElseIf (\HoverItem)
TopColor = \ColorHoverTop
BottomColor = \ColorHoverBottom
BorderColor = \ColorHoverBorder
Else
TopColor = \ColorIdleTop
BottomColor = \ColorIdleBottom
BorderColor = \ColorIdleBorder
EndIf
DrawingFont(\FontID)
DrawingMode(#PB_2DDrawing_Transparent)
ClipOutput(1, 1, \Width - 2, \Height - 2)
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
SelectObject_(DrawingID, \FontID)
SetTextColor_(DrawingID, \ColorFont)
SetBkMode_(DrawingID, #TRANSPARENT)
Protected Rect.RECT
Rect\left = 1
Rect\top = 1
Rect\right = \Width ;- \DropWidthReal - 1
Rect\bottom = \Height - 1
DrawText_(DrawingID, @\Title, -1, @Rect,
#DT_SINGLELINE | #DT_NOPREFIX | #DT_CENTER | #DT_VCENTER)
CompilerElse
DrawText((\Width/2 + 1) - TextWidth(\Title)/2, \Height/2 - TextHeight(\Title)/2, \Title, \ColorFont)
CompilerEndIf
UnclipOutput()
StopDrawing()
EndIf
EndIf
EndWith
EndIf
EndProcedure
Procedure _MenuGadgetUpdate(*_Mg._Custom_Menu, Redraw.i = #False)
If (*_Mg And *_Mg\Canvas And IsGadget(*_Mg\Canvas))
With *_Mg
\Width = GadgetWidth(\Canvas)
\Height = GadgetHeight(\Canvas)
If (Redraw)
_MenuGadgetRedraw(*_Mg)
EndIf
EndWith
EndIf
EndProcedure
Procedure _MenuCallback()
Protected *_Mg._Custom_Menu
*_Mg = GetGadgetData(EventGadget())
If (*_Mg And *_Mg\Canvas And IsGadget(*_Mg\Canvas))
With *_Mg
Protected PreHover.i = \HoverItem
Protected PrePress.i = \PressItem
Select EventType()
Case #PB_EventType_MouseEnter, #PB_EventType_MouseMove, #PB_EventType_LeftButtonDown
Protected x.i = GetGadgetAttribute(\Canvas, #PB_Canvas_MouseX)
Protected y.i = GetGadgetAttribute(\Canvas, #PB_Canvas_MouseY)
If ((x >= 0) And (x < \Width) And (y >= 0) And (y < \Height))
\HoverItem = #_Menu_Drop
Else
\HoverItem = #_Menu_None
EndIf
If (EventType() = #PB_EventType_LeftButtonDown)
\PressItem = \HoverItem
EndIf
Case #PB_EventType_MouseLeave
\HoverItem = #_Menu_None
Case #PB_EventType_LeftButtonUp
If (\PressItem = \HoverItem)
Select (\PressItem)
Case #_Menu_Item
If (ListSize(\Item()))
_MenuLastPopup = *_Mg
FirstElement(\Item())
PostEvent(#PB_Event_Menu, \Window, \Item()\MenuID)
EndIf
\PressItem = #_Menu_None
Case #_Menu_Drop
If (ListSize(\Item()))
If (Not \Popup)
\Popup = CreatePopupMenu(#PB_Any)
If (\Popup)
ForEach (\Item())
If (\Item()\Text = "-")
MenuBar()
Else
MenuItem(\Item()\MenuID, \Item()\Text, \Item()\ImageID)
EndIf
Next
EndIf
EndIf
If (\Popup)
\PressItem = #_Menu_None
_MenuGadgetRedraw(*_Mg)
*_Mg\Flags | #_Menu_Dropping
; "Pre-Drop"
_MenuLastPopup = *_Mg
DisplayPopupMenu(\Popup, WindowID(\Window), GadgetX(\Canvas, #PB_Gadget_ScreenCoordinate), GadgetY(\Canvas, #PB_Gadget_ScreenCoordinate) + \Height)
; "Post-Drop"
*_Mg\Flags & ~#_Menu_Dropping
Else
_MenuLastPopup = #Null
EndIf
EndIf
EndSelect
Else
\PressItem = #_Menu_None
EndIf
EndSelect
If ((\HoverItem <> PreHover) Or (\PressItem <> PrePress))
_MenuGadgetRedraw(*_Mg)
EndIf
EndWith
EndIf
EndProcedure
;-
;- Procedures - PUBLIC
Procedure.i EventMenuButton()
ProcedureReturn (_MenuLastPopup)
EndProcedure
Procedure.i FreeMenuGadget(*_Mg._Custom_Menu)
If (*_Mg)
If (*_Mg\Canvas And IsGadget(*_Mg\Canvas))
SetGadgetData(*_Mg\Canvas, #Null)
UnbindGadgetEvent(*_Mg\Canvas, @_MenuCallback())
FreeGadget(*_Mg\Canvas)
EndIf
If (*_Mg\Popup)
FreeMenu(*_Mg\Popup)
EndIf
ClearList(*_Mg\Item())
ClearStructure(*_Mg, _Custom_Menu)
FreeMemory(*_Mg)
EndIf
ProcedureReturn (#Null)
EndProcedure
Procedure.i AddMenuGadget(x.l, y.l, Width.l = 85, Height.l = 25, Title.s = "", Window.l = 0)
Protected *_Mg._Custom_Menu = #Null
If (IsWindow(Window))
Protected Canvas.i = CanvasGadget(#PB_Any, x, y, Width, Height)
If (Canvas)
*_Mg = AllocateMemory(SizeOf(_Custom_Menu))
If (*_Mg)
InitializeStructure(*_Mg, _Custom_Menu)
With *_Mg
\Title = Title
\Canvas = Canvas
\ColorFont = RGB(0, 0, 0)
\Window = Window
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
\FontID = GetGadgetFont(#PB_Default)
CompilerCase #PB_OS_MacOS
Protected Temp.i = TextGadget(#PB_Any, 0, 0, 25, 25, " ")
If Temp
\FontID = GetGadgetFont(Temp)
FreeGadget(Temp)
EndIf
CompilerEndSelect
\ColorIdleBorder = RGB(239, 239, 239) ; RGB(172, 172, 172)
\ColorIdleTop = RGB(240, 240, 240)
\ColorIdleBottom = RGB(229, 229, 229)
\ColorHoverBorder = RGB(126, 180, 234)
\ColorHoverTop = RGB(236, 244, 252)
\ColorHoverBottom = RGB(220, 236, 252)
\ColorPressBorder = RGB(86, 157, 229)
\ColorPressTop = RGB(218, 236, 252)
\ColorPressBottom = RGB(196, 224, 252)
EndWith
SetGadgetData(Canvas, *_Mg)
_MenuGadgetUpdate(*_Mg, #True)
BindGadgetEvent(Canvas, @_MenuCallback())
Else
FreeGadget(Canvas)
EndIf
EndIf
EndIf
ProcedureReturn (*_Mg)
EndProcedure
Procedure.i AddMenuGadgetItem(*_Mg._Custom_Menu, Text.s, ID.i = 0, ImageID.i = #Null)
Protected Result.i = -1
If (*_Mg And *_Mg\Canvas And IsGadget(*_Mg\Canvas))
With *_Mg
LastElement(\Item())
AddElement(\Item())
\Item()\MenuID = ID
\Item()\Text = Text
\Item()\ImageID = ImageID
_MenuGadgetUpdate(*_Mg, #True)
Result = ListSize(\Item()) - 1
EndWith
EndIf
ProcedureReturn (Result)
EndProcedure
Procedure.i ClearMenuGadgetItems(*_Mg._Custom_Menu)
Protected Result.i = -1
If (*_Mg And *_Mg\Canvas And IsGadget(*_Mg\Canvas))
With *_Mg
ClearList(\Item())
_MenuGadgetUpdate(*_Mg, #True)
Result = 0
EndWith
EndIf
ProcedureReturn (Result)
EndProcedure
OpenWindow(#Win1, 0, 0, 460,330, "Window Multiple Canvas Menus", #PB_Window_SystemMenu | #PB_Window_ScreenCentered); | #PB_Window_Minimize)
SetWindowColor(#Win1, $EFEFEF)
;- Menu
Dim _Mg.i(3)
*_Mg = AddMenuGadget(10, 0, 35, 20, "File")
AddMenuGadgetItem(*_Mg, "New", 1)
AddMenuGadgetItem(*_Mg, "Open...", 2)
AddMenuGadgetItem(*_Mg, "Save As..", 3)
AddMenuGadgetBar(*_Mg)
AddMenuGadgetItem(*_Mg, "Exit", 4)
_Mg(0) = *_Mg
*_Mg = AddMenuGadget(160, 0, 85, 20, "File")
AddMenuGadgetItem(*_Mg, "New", 6)
AddMenuGadgetItem(*_Mg, "Import File", 7)
AddMenuGadgetBar(*_Mg)
AddMenuGadgetItem(*_Mg, "Clear", 8)
_Mg(1) = *_Mg
*_Mg = AddMenuGadget(245, 0, 85, 20, "Tools")
AddMenuGadgetItem(*_Mg, "Archiver", 9)
AddMenuGadgetItem(*_Mg, "Notepad", 10)
AddMenuGadgetItem(*_Mg, "Phone E.T.", 11)
_Mg(2) = *_Mg
; ...moving on
ListIconGadget(#ListIcon_1, 10, 20, 140, 290,"List1",85)
AddGadgetColumn(#ListIcon_1, 1, "A", 50)
ListIconGadget(#ListIcon_2, 160, 20, 280, 290, "List2",85)
AddGadgetColumn(#ListIcon_2, 1, "B", 50)
Repeat
Select WaitWindowEvent()
Case #PB_Event_Menu
Select EventMenu()
Case 1
Debug "Yes 1"
Case 2
Debug "Yes 2"
Case 3
Debug "Yes 3"
Case 4
Debug "Application Closing"
appQuit = 1
Default
Debug "Not programmed yet.."
EndSelect
Case #PB_Event_CloseWindow
appQuit = 1
FreeMenuGadget(_Mg(0))
FreeMenuGadget(_Mg(1))
FreeMenuGadget(_Mg(2))
EndSelect
Until appQuit