Office-style menus

ABBKlaus · Post by **ABBKlaus** » Tue May 29, 2007 9:54 pm

Excellent work

ts-soft · Post by **ts-soft** » Tue May 29, 2007 9:59 pm

Nice code

but the systemmenu loses the color

Flype · Post by **Flype** » Tue May 29, 2007 10:17 pm

ts-soft wrote:Nice code

but the systemmenu loses the color

yes i also noticed that.

eesau · Post by **eesau** » Wed May 30, 2007 12:30 pm

ts-soft wrote:Nice code

but the systemmenu loses the color

True, in the window callback, while processing #WM_INITPOPUPMENU I check if the menu is the system menu by doing so:

Code: Select all

If Not HiWord ( lParam )
         
    OfficeMenuSetItems ( wParam ) ; sets menu items to owner-drawn
            
EndIf

If the HiWord of lParam is set to #True, the menu about to be shown is the system menu. I avoid doing anything to the system menu for two reasons: 1) Office doesn't owner-draw the system menu either and 2) there are a few annoying 'features' related to owner-drawing the system menu, one of which is that it doesn't seem to send #WM_MEASUREITEM messages for every item, so the items in the system menu are of different heights, and it doesn't look so good. Also, custom system menu items might mess things up a bit.

If you really need to owner-draw the system menu, you can probably work around the annoyances by creating a copy of the system menu (GetSystemMenu_ function) and processing the menu whose handle is returned by the function, or by playing around with the undocumented Windows message 787 ($313), which displays the system menu at coordinates given in lParam (not sure if it receives the system menu handle in wParam or somehow else, but I doubt it).

electrochrisso · Post by **electrochrisso** » Sat Jun 02, 2007 3:38 am

Sorry I did not get back quickly I have been away for a few days.
Anyway I tried your latest update on my clunky old laptop on 98se and it seems to look good now, icons and all. The main problem at moment is it freezes after about ten seconds. I will try on XP later and see if I get the same problem. I like the menu style.

Brice Manuel · Post by **Brice Manuel** » Sat Jun 02, 2007 3:40 am

Flype wrote:
ts-soft wrote:Nice code

but the systemmenu loses the color
yes i also noticed that.

I saw that too, but figured I was doing something wrong.

Amnesty · Post by **Amnesty** » Wed Jul 04, 2007 4:38 pm

Hello,

first of all: GREAT!!!

I ve tested it with MDIGadget and it doesnt work properly with popupmenu on MDIWindow. If I would like to initialise it with initoffice(#mdiwindow) it crashes with stack overflow.
So, I can only initoffice() one time. Right ?

Has anybody experienced the same problem ? Maybe solution ?

eesau · Post by **eesau** » Wed Jul 04, 2007 6:15 pm

Added: Menu titles are ownerdrawn now too. (See first post for updated code.)

@Amnesty, I'll take a look, but it will take a while as I don't have much time these days. Shouldn't be too hard to fix. I'm planning on rewriting the whole thing anyway, as right now it is nothing but silly hacks upon even sillier hacks.

Leonhard · Post by **Leonhard** » Fri Jul 06, 2007 9:10 pm

When I use the arrow-keys (left, right, up, down), the menu-items are disabled and the menu-bars should not use with the keys.

Test it if you open the programm and press the keys Alt and down.

NoahPhense · Post by **NoahPhense** » Tue Jul 10, 2007 1:31 am

bad as$ bro .. nice chunk

- np

gnozal · Post by **gnozal** » Wed Jul 11, 2007 7:55 am

I have tested your last version :
- WinNT4 : doesn't work [no menu strings] and crashes at exit
- Win98 : seems to work at first but crashes after a short time
- WinXP : works _but_ after you played around some time with the menus, all menus become white with no text and no selection highlighting. Tested on 2 different PCs with WinXP.

Here is a quick fix for Win9x (the WinXP issue remains, now also seen on Win9x as it no longer crashes) :

Code: Select all

;
; Office Style Menus
;
;**************************************************************** 
;* 
;-   Data 
;* 
;**************************************************************** 

Enumeration 
  
  #Office_Menu_Normal 
  #Office_Menu_Title 
  
EndEnumeration 

Structure OFFICEMENUITEM 
  
  MenuID.l 
  IconID.l 
  
  MenuType.b 
  MenuString.s 
  
EndStructure 

;**************************************************************** 
;* 
;-   Office Colors 
;* 
;**************************************************************** 

Enumeration 
  
  #Office_Color_Face_Bright 
  #Office_Color_Face_Dim 
  #Office_Color_Disabled 
  #Office_Color_Outline 
  #Office_Color_Selected 
  #Office_Color_Selected_Outline 
  
EndEnumeration 

Macro AlphaBlend(LColor, RColor, Alpha)
  
  RGB(((Red(RColor)* Alpha + Red(LColor)*(256 - Alpha)) / 256),(( Green(RColor)* Alpha + Green(LColor)*(256 - Alpha)) / 256),(( Blue(RColor)* Alpha + Blue(LColor)*(256 - Alpha)) / 256)) 
  
EndMacro 

Procedure Office_Color(Type)
  
  Select Type 
    
    Case #Office_Color_Face_Bright 
      
      ProcedureReturn GetSysColor_(#COLOR_3DHIGHLIGHT)
      
    Case #Office_Color_Face_Dim 
      
      ProcedureReturn AlphaBlend(GetSysColor_(#COLOR_3DFACE), GetSysColor_(#COLOR_3DHILIGHT), 55)
      
    Case #Office_Color_Disabled 
      
      ProcedureReturn AlphaBlend(GetSysColor_(#COLOR_GRAYTEXT), GetSysColor_(#COLOR_3DHILIGHT), 77)
      
    Case #Office_Color_Outline    
      
      ProcedureReturn AlphaBlend(GetSysColor_(#COLOR_3DDKSHADOW), GetSysColor_(#COLOR_3DFACE), 96)
      
    Case #Office_Color_Selected 
      
      ProcedureReturn AlphaBlend(GetSysColor_(#COLOR_ACTIVECAPTION), GetSysColor_(#COLOR_3DHIGHLIGHT), 189)
      
    Case #Office_Color_Selected_Outline 
      
      ProcedureReturn AlphaBlend(AlphaBlend(GetSysColor_(#COLOR_ACTIVECAPTION), GetSysColor_(#COLOR_3DFACE), 32), GetSysColor_(#COLOR_3DHIGHLIGHT), 64)
      
  EndSelect 
  
EndProcedure 

;**************************************************************** 
;* 
;-   Office Dimensions 
;* 
;**************************************************************** 

Enumeration 
  
  #Office_Dim_Menu_Offset_X = 1 
  #Office_Dim_Menu_Offset_Y = 2 
  #Office_Dim_Menu_Bar      = 24 
  
EndEnumeration 

;**************************************************************** 
;* 
;-   Macros 
;* 
;**************************************************************** 

Macro HiWord(Value)
  
 (( Value >> 16)& $FFFF)
  
EndMacro 

Macro LoWord(Value)
  
 (Value & $FFFF)
  
EndMacro 

Macro DrawItemsPick(DC, Brush, Pen)
  
  TempBrush = SelectObject_(DC, Brush)
  TempPen   = SelectObject_(DC, Pen)
  
EndMacro 

Macro DrawItemsDrop(DC)
  
  DeleteObject_(SelectObject_(DC, DC#TempBrush)) 
  DeleteObject_(SelectObject_(DC, DC#TempPen)) 
  
EndMacro 

Macro DrawItemsSwap(DC, Brush, Pen)
  
  DeleteObject_(SelectObject_(DC, DC#TempBrush)) 
  DeleteObject_(SelectObject_(DC, DC#TempPen)) 
  
  DC#TempBrush = SelectObject_(DC, Brush)
  DC#TempPen   = SelectObject_(DC, Pen)
  
EndMacro 

Macro DrawBrushPick(DC, Brush)
  
  DC#TempBrush = SelectObject_(DC, Brush)
  
EndMacro 

Macro DrawBrushDrop(DC)
  
  DeleteObject_(SelectObject_(DC, DC#TempBrush)) 
  
EndMacro 

Macro DrawBrushSwap(DC, Brush)
  
  DeleteObject_(SelectObject_(DC, DC#TempBrush)) 
  DC#TempBrush = SelectObject_(DC, Brush)
  
EndMacro 

Macro DrawPenPick(DC, Pen)
  
  DC#TempPen = SelectObject_(DC, Pen)
  
EndMacro 

Macro DrawPenDrop(DC)
  
  DeleteObject_(SelectObject_(DC, DC#TempPen)) 
  
EndMacro 

Macro DrawPenSwap(DC, Pen)
  
  DeleteObject_(SelectObject_(DC, DC#TempPen)) 
  DC#TempPen = SelectObject_(DC, Pen)
  
EndMacro 

Macro DrawFontPick(DC, Font)
  
  DC#TempFont = SelectObject_(DC, Font)
  
EndMacro 

Macro DrawFontDrop(DC)
  
  DeleteObject_(SelectObject_(DC, DC#TempFont)) 
  
EndMacro 

Macro DrawRectWhole(DC)
  
  Rectangle_(DC, *Item\rcItem\left, *Item\rcItem\top, *Item\rcItem\right, *Item\rcItem\bottom)
  
EndMacro 

Macro DrawRectWholeEx(DC)
  
  Rectangle_(DC, *Item\rcItem\left, *Item\rcItem\top, *Item\rcItem\right + 1, *Item\rcItem\bottom + 1)
  
EndMacro 

Macro DrawRectBar(DC)
  
  Rectangle_(DC, *Item\rcItem\left, *Item\rcItem\top, #Office_Dim_Menu_Bar - 3, *Item\rcItem\bottom + 1)
  
EndMacro 

Macro DrawTextPrep(DC)
  
  *Item\rcItem\top = (*Item\rcItem\top + *Item\rcItem\bottom - *Size\cy)/ 2 
  *Item\rcItem\left = #Office_Dim_Menu_Bar + 4 
  
  DrawText_(DC, @String$, -1, *Item\rcItem, #DT_END_ELLIPSIS | #DT_EXPANDTABS)
  
EndMacro 

Macro DrawBarPrep() 
  
  *Item\rcItem\top    = (*Item\rcItem\top + *Item\rcItem\bottom)/ 2 
  *Item\rcItem\left   = #Office_Dim_Menu_Bar + 4 
  *Item\rcItem\right  + #Office_Dim_Menu_Bar 
  *Item\rcItem\bottom = *Item\rcItem\top + 1 
  
EndMacro 

Macro APIGetMenuString(String)
  
  If *OfficeMenuItem\MenuType = #Office_Menu_Title 
    
    String = *OfficeMenuItem\MenuString 
    
  Else 
    
    String = Space(255)
    
    GetMenuString_(*OfficeMenuItem\MenuID, *Item\itemID, @String, Len(String), #MF_BYCOMMAND)
    
  EndIf 
  
EndMacro 

;**************************************************************** 
;* 
;-   Drawing and Measuring 
;* 
;**************************************************************** 

Procedure Office_Menu_Get_Font() 
  
  Metrics.NONCLIENTMETRICS 
  Metrics\cbSize = SizeOf(NONCLIENTMETRICS)
  
  SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @Metrics, #Null)
  
  ProcedureReturn CreateFontIndirect_(@Metrics\lfMenuFont)
  
EndProcedure 

Procedure Office_Menu_Measure_Title(*Item.MEASUREITEMSTRUCT, *Size.SIZE)
  
  *Item\itemWidth  = *Size\cx + 4 
  *Item\itemHeight = MenuHeight() 
  
EndProcedure 

Procedure Office_Menu_Measure_Entry(String$, *Item.MEASUREITEMSTRUCT, *Size.SIZE)
  
  *Item\itemWidth  = #Office_Dim_Menu_Bar + *Size\cx + 16 + 10 * CountString(String$, Chr(9)) 
  *Item\itemHeight = 22 
  
EndProcedure 

Procedure Office_Menu_Measure_Bar(*Item.MEASUREITEMSTRUCT)
  
  *Item\itemWidth  = #Office_Dim_Menu_Bar 
  *Item\itemHeight = #Office_Dim_Menu_Offset_Y + 3 
  
EndProcedure 

Procedure Office_Menu_Measure_All(Handle, *Item.MEASUREITEMSTRUCT)
  
  *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData 
  
  If *Item\CtlType = #ODT_MENU 
    
    DC = GetWindowDC_(Handle)
    
    If DC 
      
      APIGetMenuString(String$)
      
      If String$ 
        
        DrawFontPick(DC, Office_Menu_Get_Font())
        
        GetTextExtentPoint32_(DC, String$, Len(String$), @Size.SIZE)
        
        If *OfficeMenuItem\MenuType = #Office_Menu_Title 
          
          Office_Menu_Measure_Title(*Item, @Size)
          
        Else 
          
          Office_Menu_Measure_Entry(String$, *Item, @Size)
          
        EndIf             
        
        DrawFontDrop(DC)
        
      Else 
        
        Office_Menu_Measure_Bar(*Item)
        
      EndIf 
      
      ReleaseDC_(Handle, DC)
      
    EndIf 
    
  EndIf 
  
EndProcedure 

Procedure Office_Menu_Draw_Check(DC, *Item.DRAWITEMSTRUCT)
  
  MemoryDC = CreateCompatibleDC_(DC)
  
  If MemoryDC 
    
    DrawItemsSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Selected)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Selected_Outline)))
    
    TempBitmap = SelectObject_(MemoryDC, CreateBitmap_(GetSystemMetrics_(#SM_CXMENUCHECK), GetSystemMetrics_(#SM_CYMENUCHECK), 1, 1, #Null)) 
    
    If TempBitmap 
      
      Rectangle.RECT 
      Rectangle\right  = Rectangle\left + GetSystemMetrics_(#SM_CXMENUCHECK)
      Rectangle\bottom = Rectangle\top + GetSystemMetrics_(#SM_CYMENUCHECK)
      
      DrawFrameControl_(MemoryDC, @Rectangle, #DFC_MENU, #DFCS_MENUCHECK)
      
      If *Item\itemState & #ODS_DISABLED 
        
        SetBkColor_(DC, Office_Color(#Office_Color_Face_Dim)) 
        
      ElseIf *Item\itemState & #ODS_SELECTED 
        
        SetBkColor_(DC, Office_Color(#Office_Color_Selected)) 
        
      Else 
        
        SetBkColor_(DC, Office_Color(#Office_Color_Face_Dim)) 
        
      EndIf 
      
      BitBlt_(DC, *Item\rcItem\left + 4, *Item\rcItem\top + GetSystemMetrics_(#SM_CYMENUCHECK)/ 2 - 2, GetSystemMetrics_(#SM_CXMENUCHECK), GetSystemMetrics_(#SM_CYMENUCHECK), MemoryDC, 0, 0, #SRCCOPY)
      
    EndIf 
    
    DeleteObject_(SelectObject_(MemoryDC, TempBitmap)) 
    
    DeleteDC_(MemoryDC)
    
  EndIf 
  
EndProcedure 

Procedure Office_Menu_Draw_Icon(DC, *Item.DRAWITEMSTRUCT)
  
  *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData 
  
  DrawIconEx_(DC, *Item\rcItem\left + 2, *Item\rcItem\top + 3, *OfficeMenuItem\IconID, 16, 16, #Null, #Null, #DI_NORMAL)
  
EndProcedure 

Procedure Office_Menu_Draw_Title_Normal(DC, *Item.DRAWITEMSTRUCT)
  
  DrawItemsPick(DC, CreateSolidBrush_(GetSysColor_(#COLOR_3DFACE)), GetStockObject_(#NULL_PEN)) 
  
  Rectangle_(DC, *Item\rcItem\left, *Item\rcItem\top, *Item\rcItem\right + 1, *Item\rcItem\bottom + 1)
  
EndProcedure 

Procedure Office_Menu_Draw_Title_Selected(DC, *Item.DRAWITEMSTRUCT)
  
  DrawItemsPick(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Outline)))
  
  DrawRectWhole(DC)
  
  DrawPenSwap(DC, GetStockObject_(#NULL_PEN)) 
  
  Rectangle_(DC, *Item\rcItem\left + 1, *Item\rcItem\bottom - 1, *Item\rcItem\right, *Item\rcItem\bottom + 1)
  
  SetProp_(GetActiveWindow_(), "FlagWidth", *Item\rcItem\right - *Item\rcItem\left)
  
EndProcedure 

Procedure Office_Menu_Draw_Title_Hover(DC, *Item.DRAWITEMSTRUCT)
  
  DrawItemsPick(DC, CreateSolidBrush_(Office_Color(#Office_Color_Selected)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Selected_Outline)))
  
  DrawRectWhole(DC)
  
EndProcedure 

Procedure Office_Menu_Draw_Title_Text(DC, String$, *Item.DRAWITEMSTRUCT)
  
  GetTextExtentPoint32_(DC, String$, Len(String$), @Size.SIZE)
  
  *Item\rcItem\top = *Item\rcItem\top +(( *Item\rcItem\bottom - *Item\rcItem\top)/ 2 - Size\cy / 2)- 1 
  
  DrawTextEx_(DC, @String$, -1, *Item\rcItem, #DT_CENTER | #DT_VCENTER | #DT_END_ELLIPSIS, #Null)
  
EndProcedure 

Procedure Office_Menu_Draw_Entry_Normal(DC, *Item.DRAWITEMSTRUCT)
  
  DrawRectWholeEx(DC)
  
  DrawBrushSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim)))
  
  DrawRectBar(DC)
  
EndProcedure 

Procedure Office_Menu_Draw_Entry_Selected(DC, *Item.DRAWITEMSTRUCT)
  
  DrawItemsSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Selected)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Selected_Outline)))
  
  DrawRectWhole(DC)
  
EndProcedure 

Procedure Office_Menu_Draw_Entry_Disabled(DC, *Item.DRAWITEMSTRUCT)
  
  SetTextColor_(DC, Office_Color(#Office_Color_Disabled)) 
  
  DrawRectWholeEx(DC)
  
  DrawBrushSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim)))
  
  DrawRectBar(DC)
  
EndProcedure 

Procedure Office_Menu_Draw_Bar(DC, *Item.DRAWITEMSTRUCT)
  
  DrawRectWholeEx(DC)
  
  DrawBrushSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim)))
  
  DrawRectBar(DC)
  
  DrawItemsSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Disabled)), CreatePen_(#PS_SOLID  , 1, Office_Color(#Office_Color_Disabled)))
  
  DrawBarPrep() 
  
  DrawRectWhole(DC)
  
EndProcedure 

Procedure Office_Menu_Draw_Item(DC, String$, *Item.DRAWITEMSTRUCT, *Size.SIZE)
  
  Shared FirstTimeDisplayCounter
  
  *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData 
  
  SetTextColor_(DC, #Black)
  
  If *OfficeMenuItem\MenuType = #Office_Menu_Title 
    
    FirstTimeDisplayCounter = 0
    
    If *Item\itemState & #ODS_SELECTED 
      
      Office_Menu_Draw_Title_Selected(DC, *Item)
      
    ElseIf *Item\itemState & #ODS_HOTLIGHT 
      
      Office_Menu_Draw_Title_Hover(DC, *Item)
      
    Else 
      
      Office_Menu_Draw_Title_Normal(DC, *Item)
      
    EndIf 
    
    Office_Menu_Draw_Title_Text(DC, String$, *Item)
    
  Else 
    
    FirstTimeDisplayCounter + 1
    
    Debug FirstTimeDisplayCounter
    
    DrawItemsPick(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Bright)), GetStockObject_(#NULL_PEN)) 
    
    If String$ 
      
      If *Item\itemState & #ODS_GRAYED 
        
        Office_Menu_Draw_Entry_Disabled(DC, *Item)
        
      Else 
        
        SetTextColor_(DC, #Black)
        
        If *Item\itemState & #ODS_SELECTED
          
          If FirstTimeDisplayCounter > GetMenuItemCount_(*OfficeMenuItem\MenuID) 
            
            Office_Menu_Draw_Entry_Selected(DC, *Item)
            
          EndIf
          
        Else 
          
          Office_Menu_Draw_Entry_Normal(DC, *Item)
          
        EndIf 
        
      EndIf 
      
      If *Item\itemState & #ODS_CHECKED 
        
        Office_Menu_Draw_Check(DC, *Item)
        
      EndIf 
      
      If *OfficeMenuItem\IconID 
        
        Office_Menu_Draw_Icon(DC, *Item)
        
      EndIf 
      
      DrawTextPrep(DC)
      
    Else 
      
      Office_Menu_Draw_Bar(DC, *Item)
      
    EndIf 
    
  EndIf 
  
  DrawItemsDrop(DC)
  
  
EndProcedure 

Procedure Office_Menu_Draw_All(Handle, *Item.DRAWITEMSTRUCT)
  
  *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData 
  
  If *Item\CtlType = #ODT_MENU 
    
    DC = *Item\hdc 
    
    If DC 
      
      SetBkMode_(DC, #TRANSPARENT)
      
      APIGetMenuString(String$)
      
      GetTextExtentPoint32_(DC, String$, Len(String$), @Size.SIZE)
      
      Office_Menu_Draw_Item(DC, String$, *Item, @Size)
      
    EndIf 
    
  EndIf 
  
EndProcedure 

Procedure Office_Menu_Draw_Background(Handle, DC)
  
  If Not DC 
    
    DC = GetWindowDC_(Handle)
    
  EndIf 
  
  If DC 
    
    MemoryDC = CreateCompatibleDC_(DC)
    
    If MemoryDC 
      
      GetWindowRect_(Handle, Rectangle.RECT)
      
      TempBitmap = SelectObject_(MemoryDC, CreateCompatibleBitmap_(DC, Rectangle\right - Rectangle\left, Rectangle\bottom - Rectangle\top)) 
      
      If TempBitmap 
        
        DrawItemsPick(MemoryDC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Bright)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Outline)))
        
        Rectangle_(MemoryDC, 0, 0, Rectangle\right - Rectangle\left, Rectangle\bottom - Rectangle\top)   
        
        DrawItemsSwap(MemoryDC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim)), GetStockObject_(#NULL_PEN)) 
        
        Rectangle_(MemoryDC, 1, 2, #Office_Dim_Menu_Bar, Rectangle\bottom - Rectangle\top - 1)
        
        If GetProp_(GetActiveWindow_(), "FlagOpen")= #True 
          
          DrawBrushSwap(MemoryDC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim)))
          
          Rectangle_(MemoryDC, 1, 0, GetProp_(GetActiveWindow_(), "FlagWidth"), 2)
          
        EndIf 
        
        BitBlt_(DC, 0, 0, Rectangle\right - Rectangle\left, Rectangle\bottom - Rectangle\top, MemoryDC, 0, 0, #SRCCOPY)
        
      EndIf 
      
      DeleteObject_(SelectObject_(MemoryDC, TempBitmap)) 
      
      DeleteDC_(MemoryDC)
      
    EndIf 
    
    ReleaseDC_(Handle, DC)
    
  EndIf 
  
EndProcedure 

;**************************************************************** 
;* 
;-   Callbacks etc. 
;* 
;**************************************************************** 

Procedure OfficeMenuSetIcon(MenuID, itemID, IconID)
  
  If IsMenu_(MenuID)
    
    MenuInfo.MENUITEMINFO 
    MenuInfo\cbSize     = SizeOf(MENUITEMINFO)
    MenuInfo\fMask      = #MIIM_DATA 
    MenuInfo\dwItemData = IconID 
    
    SetMenuItemInfo_(MenuID, itemID, #False, @MenuInfo)
    
  EndIf 
  
EndProcedure 

Procedure Office_Menu_Set_Items(MenuID)
  
  Shared FirstTimeDisplayCounter
  
  FirstTimeDisplayCounter = 0
  
  For Counter = 0 To GetMenuItemCount_(MenuID)- 1 
    
    MenuInfo.MENUITEMINFO 
    MenuInfo\cbSize     = SizeOf(MENUITEMINFO)
    MenuInfo\fMask      = #MIIM_DATA 
    
    GetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo)
    
    *OfficeMenuItem.OFFICEMENUITEM = AllocateMemory(SizeOf(OFFICEMENUITEM)) 
    
    *OfficeMenuItem\MenuID = MenuID 
    *OfficeMenuItem\IconID = MenuInfo\dwItemData 
    
    MenuInfo\fMask      = #MIIM_TYPE | #MIIM_DATA
    MenuInfo\fType      = #MFT_OWNERDRAW 
    MenuInfo\dwItemData = *OfficeMenuItem 
    
    SetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo)
    
  Next 
  
EndProcedure 

Procedure Office_Menu_Reset_Items(MenuID)
  
  Shared FirstTimeDisplayCounter
  
  FirstTimeDisplayCounter = 0
  
  For Counter = 0 To GetMenuItemCount_(MenuID)- 1 
    
    MenuInfo.MENUITEMINFO 
    MenuInfo\cbSize     = SizeOf(MENUITEMINFO)
    MenuInfo\fMask      = #MIIM_DATA 
    
    GetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo)
    
    *OfficeMenuItem.OFFICEMENUITEM = MenuInfo\dwItemData 
    
    MenuInfo\fMask      = #MIIM_DATA
    MenuInfo\dwItemData = *OfficeMenuItem\IconID 
    
    FreeMemory(*OfficeMenuItem)
    
    SetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo)      
    
  Next 
  
EndProcedure 

Procedure Office_Window_Callback(Handle, message, wParam, lParam)
  
  Protected WindowProc.l, ReturnValue.l
  
  Select message 
    
    Case #WM_INITMENUPOPUP 
      
      If Not HiWord(lParam)
        
        Office_Menu_Set_Items(wParam)
        
        SetProp_(Handle, "FlagOpen", GetProp_(Handle, "FlagOpen")+ 1)
        
      EndIf 
      
    Case #WM_UNINITMENUPOPUP 
      
      If Not HiWord(lParam)
        
        
        Office_Menu_Reset_Items(wParam)
        
        SetProp_(Handle, "FlagOpen", GetProp_(Handle, "FlagOpen")- 1)
        
        If Not GetProp_(Handle, "FlagOpen")
          
          SetProp_(Handle, "FlagWidth", #Null)
          
        EndIf 
        
      EndIf 
      
    Case #WM_MEASUREITEM 
      
      Office_Menu_Measure_All(Handle, lParam)
      
      ProcedureReturn #True 
      
    Case #WM_DRAWITEM 
      
      Office_Menu_Draw_All(Handle, lParam)
      
      ProcedureReturn #True 
      
    Case #WM_DESTROY 
      
      RemoveProp_(Handle, "WindowProc")
      RemoveProp_(Handle, "FlagWidth")
      RemoveProp_(Handle, "FlagOpen")
      
  EndSelect 
  
  WindowProc = GetProp_(Handle, "WindowProc")
  If WindowProc
    ReturnValue = CallWindowProc_ (WindowProc, Handle, message, wParam, lParam)
  EndIf
  
  ProcedureReturn ReturnValue
  
EndProcedure 

Procedure Office_Menu_Check_Window(Handle)
  
  GetWindowRect_(Handle, MenuRectangle.RECT)
  GetWindowRect_(GetActiveWindow_(), ParentRectangle.RECT)
  
  GetCursorPos_(MousePoint.POINT)
  GetWindowRect_(FindWindow_("Shell_TrayWnd", ""), @TrayRectangle.RECT)
  
  If PtInRect_(@TrayRectangle, MousePoint\X, MousePoint\Y)
    
    ProcedureReturn #False 
    
  EndIf 
  
  If MenuRectangle\top - ParentRectangle\top = GetSystemMetrics_(#SM_CYBORDER)* 2 + GetSystemMetrics_(#SM_CYCAPTION)
    
    ProcedureReturn #False 
    
  EndIf 
  
  If MenuRectangle\bottom => ParentRectangle\top And MenuRectangle\bottom <= ParentRectangle\top + GetSystemMetrics_(#SM_CYCAPTION)+ GetSystemMetrics_(#SM_CYBORDER)
    
    ProcedureReturn #False 
    
  EndIf 
  
  If MenuRectangle\top => ParentRectangle\top And MenuRectangle\top <= ParentRectangle\top + GetSystemMetrics_(#SM_CYCAPTION)+ GetSystemMetrics_(#SM_CYBORDER)
    
    ProcedureReturn #False 
    
  EndIf 
  
  If MenuRectangle\top <= ParentRectangle\top And MenuRectangle\bottom <= ParentRectangle\top + GetSystemMetrics_(#SM_CYCAPTION)+ GetSystemMetrics_(#SM_CYBORDER)
    
    ProcedureReturn #False 
    
  EndIf 
  
  ProcedureReturn #True 
  
EndProcedure 

Procedure Office_Menu_Callback(Handle, message, wParam, lParam)
  
  Protected WindowProc.l, ReturnValue.l
  
  If Office_Menu_Check_Window(Handle)
    
    Select message
      
      Case #WM_PAINT
        
        Office_Menu_Draw_Background(Handle, #Null)
        
        InvalidateRect_(Handle, #Null, #Null)
        
    EndSelect 
  EndIf
  
  WindowProc = GetProp_(Handle, "WindowProc")
  If WindowProc
    ReturnValue = CallWindowProc_ (WindowProc, Handle, message, wParam, lParam)
  EndIf
  
  ProcedureReturn ReturnValue
  
EndProcedure 

Procedure Office_Hook(code, wParam, lParam)
  
  *Temporary.CWPSTRUCT = lParam 
  
  Select code 
    
    Case #HC_ACTION 
      
      Select *Temporary\message 
        
        Case #WM_CREATE 
          
          *CreateParams.CREATESTRUCT = *Temporary\lParam 
          
          If *CreateParams\lpszClass = 32768 
            
            SetProp_(*Temporary\hwnd, "FlagMenu", #True)
            SetProp_(*Temporary\hwnd, "WindowProc", SetWindowLong_(*Temporary\hwnd, #GWL_WNDPROC, @Office_Menu_Callback())) 
            
            SystemParametersInfo_(#SPI_GETMENUFADE, #Null, @MenuFade, #Null)
            SystemParametersInfo_(#SPI_GETMENUANIMATION, #Null, @MenuAnim, #Null)
            
            SetProp_(*Temporary\hwnd, "MenuFade", MenuFade)
            SetProp_(*Temporary\hwnd, "MenuAnim", MenuAnim)
            
            If MenuFade : SystemParametersInfo_(#SPI_SETMENUFADE, #Null, #False, #Null): EndIf 
            If MenuAnim : SystemParametersInfo_(#SPI_SETMENUANIMATION, #Null, #False, #Null): EndIf 
            
          EndIf 
          
        Case #WM_DESTROY 
          
          If GetProp_(*Temporary\hwnd, "FlagMenu")
            
            RemoveProp_(*Temporary\hwnd, "FlagMenu")
            RemoveProp_(*Temporary\hwnd, "WindowProc")
            
            SystemParametersInfo_(#SPI_SETMENUFADE, #Null, GetProp_(*Temporary\hwnd, "MenuFade"), #Null)
            SystemParametersInfo_(#SPI_SETMENUANIMATION, #Null, GetProp_(*Temporary\hwnd, "MenuAnim"), #Null)
            
            RemoveProp_(*Temporary\hwnd, "MenuFade")
            RemoveProp_(*Temporary\hwnd, "MenuAnim")
            
          EndIf 
          
      EndSelect 
      
  EndSelect 
  
  ProcedureReturn CallNextHookEx_(@Office_Hook(), code, wParam, lParam)
  
EndProcedure 

Procedure InitOffice(Window)
  
  If Not GetProp_(WindowID(Window), "OfficeMenuHook")
    
    SetProp_(WindowID(Window), "WindowProc", SetWindowLong_(WindowID(Window), #GWL_WNDPROC, @Office_Window_Callback())) 
    SetProp_(WindowID(Window), "WindowHook", SetWindowsHookEx_(#WH_CALLWNDPROC, @Office_Hook(), #Null, GetWindowThreadProcessId_(WindowID(Window), #Null)))
    
    MenuID = GetMenu_(WindowID(Window)) 
    
    If MenuID 
      
      For Counter = 0 To GetMenuItemCount_(MenuID)- 1 
        
        String$ = Space(256)
        GetMenuString_(MenuID, Counter, @String$, Len(String$), #MF_BYPOSITION)
        
        *OfficeMenuTitle.OFFICEMENUITEM = AllocateMemory(SizeOf(OFFICEMENUITEM)) 
        *OfficeMenuTitle\MenuID     = MenuID 
        *OfficeMenuTitle\MenuType   = #Office_Menu_Title 
        *OfficeMenuTitle\MenuString = String$ 
        
        ModifyMenu_(MenuID, Counter, #MF_BYPOSITION | #MF_OWNERDRAW, -1, *OfficeMenuTitle)
        
      Next 
      
      DrawMenuBar_(WindowID(Window)) 
      
    EndIf 
    
    ProcedureReturn #True 
    
  EndIf 
  
  ProcedureReturn #Null 
  
EndProcedure 

;**************************************************************** 
;* 
;-   Let the testing begin! 
;* 
;**************************************************************** 

#Window = 1 
#Menu   = 2 
#Popup  = 3 

If OpenWindow(#Window, 0, 0, 500, 400, "Menu Test", #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered | #PB_Window_Invisible)
  
  If CreateGadgetList(WindowID(#Window)) 
    
  EndIf 
  
  If CreateMenu(#Menu, WindowID(#Window)) 
    
    MenuTitle("&File")
    
    MenuItem(0, "New" + Chr(9 )+ Chr(9 )+ "Ctrl+N")
    MenuItem(1, "Open..." + Chr(9 )+ Chr(9 )+ "Ctrl+O")
    MenuItem(2, "Save" + Chr(9 )+ Chr(9 )+ "Ctrl+S")
    MenuItem(3, "Save As...")
    MenuItem(4, "Save All")
    MenuItem(5, "Close" + Chr(9)+ Chr(9)+ "Ctrl+W")
    MenuItem(6, "Close All")
    MenuBar() 
    MenuItem(7, "Sort Sources...")
    MenuBar() 
    MenuItem(8, "Preferences...")
    MenuBar() 
    OpenSubMenu("Recent Files")
    MenuItem(9, "config.ini")
    MenuItem(10, "autoexec.bat")
    MenuItem(11, "kaboom.pb")
    MenuBar() 
    OpenSubMenu("More Files")
    MenuItem(200, "alpha.exe")   
    MenuItem(201, "beta.bat")
    MenuItem(202, "gamma.com")
    MenuItem(203, "delta.ini")
    MenuItem(204, "epsilon.jpg")
    MenuItem(205, "theta.bmp")
    MenuItem(206, "omicron.mpg")
    MenuItem(207, "omega.ogg")
    MenuItem(208, "pi.tmp")
    MenuItem(209, "tau.bak")
    MenuItem(210, "mhy.txt")
    CloseSubMenu() 
    CloseSubMenu()          
    MenuBar() 
    MenuItem(12, "Quit")
    
    DisableMenuItem(#Menu, 1, #True)
    DisableMenuItem(#Menu, 2, #True)
    DisableMenuItem(#Menu, 3, #True)
    DisableMenuItem(#Menu, 4, #True)
    
    SetMenuItemState(#Menu, 0, #True)
    SetMenuItemState(#Menu, 1, #True)
    
    MenuTitle("&Tools")
    
    MenuItem(20, "Visual Designer" + Chr(9)+ Chr(9)+ "Alt+V")
    MenuItem(21, "File Viewer")
    MenuItem(22, "Structure Viewer" + Chr(9)+ "Alt+S")
    MenuItem(23, "Variable Viewer")
    MenuItem(24, "Procedure Browser")
    MenuItem(25, "Templates" + Chr(9)+ Chr(9)+ "Alt+X")
    MenuItem(26, "Color Picker" + Chr(9)+ Chr(9)+ "Alt+P")
    MenuItem(27, "Ascii Table" + Chr(9)+ Chr(9)+ "Alt+A")
    MenuItem(28, "Smart Update")
    MenuBar() 
    MenuItem(29, "Configure Tools...")
    
    OfficeMenuSetIcon(MenuID(#Menu), 21, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 46)) 
    OfficeMenuSetIcon(MenuID(#Menu), 22, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 23)) 
    OfficeMenuSetIcon(MenuID(#Menu), 23, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 3)) 
    OfficeMenuSetIcon(MenuID(#Menu), 26, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 12)) 
    
    DisableMenuItem(#Menu, 22, #True)
    
    MenuTitle("&Help")
    
    MenuItem(30, "Help..." + Chr(9)) 
    MenuBar() 
    OpenSubMenu("External Help")
    MenuItem(31 ,"Call Fred!")
    MenuItem(32 ,"Cry Wolf!")
    MenuItem(33 ,"Dial 911!")
    CloseSubMenu() 
    MenuBar() 
    MenuItem(34, "About")
    
  EndIf 
  
  If CreatePopupMenu(#Popup)
    
    MenuItem(100, "Simple")
    MenuItem(101, "Popup")
    MenuItem(102, "Menu")
    MenuBar() 
    OpenSubMenu("--->")
    MenuItem(103, "Boo!")
    MenuBar() 
    OpenSubMenu("--->")
    MenuItem(104, "Yikes!")         
    CloseSubMenu() 
    CloseSubMenu() 
    
    OfficeMenuSetIcon(MenuID(#Popup), 100, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 22)) 
    
  EndIf 
  
EndIf 

InitOffice(#Window)

HideWindow(#Window, #False)

Repeat 
  
  Event = WaitWindowEvent() 
  
  If Event = #WM_RBUTTONDOWN 
    
    DisplayPopupMenu(#Popup, WindowID(#Window)) 
    
  EndIf 
  
Until Event = #PB_Event_CloseWindow

Nico · Post by **Nico** » Wed Jul 11, 2007 7:11 pm

- WinXP : works _but_ after you played around some time with the menus, no selection highlighting.

It's always true!

eesau · Post by **eesau** » Thu Jul 12, 2007 8:31 am

gnozal wrote:- WinXP : works _but_ after you played around some time with the menus, all menus become white with no text and no selection highlighting. Tested on 2 different PCs with WinXP.

That's strange, for some reason I can't reproduce this at all -- which just proves how flaky Windows-menus really are... I'll have a look though.

Leonhard · Post by **Leonhard** » Sun Jul 15, 2007 8:27 pm

How can I use Hot- and Disabled-Icon?
Can you programming this?

DoubleDutch · Post by **DoubleDutch** » Mon Sep 03, 2007 12:11 am

I've done some slight changes to make it nicer to use with keys...

Code: Select all

Enumeration 
  #Office_Menu_Normal 
  #Office_Menu_Title 
EndEnumeration 

Structure OFFICEMENUITEM 
  MenuID.l 
  IconID.l 
  MenuType.b 
  MenuString.s 
EndStructure 

Enumeration 
  #Office_Color_Face_Bright 
  #Office_Color_Face_Dim 
  #Office_Color_Disabled 
  #Office_Color_Outline 
  #Office_Color_Selected 
  #Office_Color_Selected_Outline 
EndEnumeration 

Macro AlphaBlend(LColor, RColor, Alpha) 
  RGB(((Red(RColor)* Alpha + Red(LColor)*(256 - Alpha)) / 256),(( Green(RColor)* Alpha + Green(LColor)*(256 - Alpha)) / 256),(( Blue(RColor)* Alpha + Blue(LColor)*(256 - Alpha)) / 256)) 
EndMacro 

Procedure Office_Color(Type) 
  Select Type 
    Case #Office_Color_Face_Bright 
      ProcedureReturn GetSysColor_(#COLOR_3DHIGHLIGHT) 
    Case #Office_Color_Face_Dim 
      ProcedureReturn AlphaBlend(GetSysColor_(#COLOR_3DFACE), GetSysColor_(#COLOR_3DHILIGHT), 55) 
    Case #Office_Color_Disabled 
      ProcedureReturn AlphaBlend(GetSysColor_(#COLOR_GRAYTEXT), GetSysColor_(#COLOR_3DHILIGHT), 77) 
    Case #Office_Color_Outline    
      ProcedureReturn AlphaBlend(GetSysColor_(#COLOR_3DDKSHADOW), GetSysColor_(#COLOR_3DFACE), 96) 
    Case #Office_Color_Selected 
      ProcedureReturn AlphaBlend(GetSysColor_(#COLOR_ACTIVECAPTION), GetSysColor_(#COLOR_3DHIGHLIGHT), 189) 
    Case #Office_Color_Selected_Outline 
      ProcedureReturn AlphaBlend(AlphaBlend(GetSysColor_(#COLOR_ACTIVECAPTION), GetSysColor_(#COLOR_3DFACE), 32), GetSysColor_(#COLOR_3DHIGHLIGHT), 64) 
  EndSelect 
EndProcedure 

;**************************************************************** 
;* 
;-   Office Dimensions 
;* 
;**************************************************************** 

Enumeration 
  #Office_Dim_Menu_Offset_X = 1 
  #Office_Dim_Menu_Offset_Y = 2 
  #Office_Dim_Menu_Bar      = 24 
EndEnumeration 

;**************************************************************** 
;* 
;-   Macros 
;* 
;**************************************************************** 

Macro HiWord(Value) 
 (( Value >> 16)& $FFFF) 
EndMacro 

Macro LoWord(Value) 
 (Value & $FFFF) 
EndMacro 

Macro DrawItemsPick(DC, Brush, Pen) 
  TempBrush = SelectObject_(DC, Brush) 
  TempPen   = SelectObject_(DC, Pen) 
EndMacro 

Macro DrawItemsDrop(DC) 
  DeleteObject_(SelectObject_(DC, DC#TempBrush)) 
  DeleteObject_(SelectObject_(DC, DC#TempPen)) 
EndMacro 

Macro DrawItemsSwap(DC, Brush, Pen) 
  DeleteObject_(SelectObject_(DC, DC#TempBrush)) 
  DeleteObject_(SelectObject_(DC, DC#TempPen)) 
  DC#TempBrush = SelectObject_(DC, Brush) 
  DC#TempPen   = SelectObject_(DC, Pen) 
EndMacro 

Macro DrawBrushPick(DC, Brush) 
  DC#TempBrush = SelectObject_(DC, Brush) 
EndMacro 

Macro DrawBrushDrop(DC) 
  DeleteObject_(SelectObject_(DC, DC#TempBrush)) 
EndMacro 

Macro DrawBrushSwap(DC, Brush) 
  DeleteObject_(SelectObject_(DC, DC#TempBrush)) 
  DC#TempBrush = SelectObject_(DC, Brush) 
EndMacro 

Macro DrawPenPick(DC, Pen) 
  DC#TempPen = SelectObject_(DC, Pen) 
EndMacro 

Macro DrawPenDrop(DC) 
  DeleteObject_(SelectObject_(DC, DC#TempPen)) 
EndMacro 

Macro DrawPenSwap(DC, Pen) 
  DeleteObject_(SelectObject_(DC, DC#TempPen)) 
  DC#TempPen = SelectObject_(DC, Pen) 
EndMacro 

Macro DrawFontPick(DC, Font) 
  DC#TempFont = SelectObject_(DC, Font) 
EndMacro 

Macro DrawFontDrop(DC) 
  DeleteObject_(SelectObject_(DC, DC#TempFont)) 
EndMacro 

Macro DrawRectWhole(DC) 
  Rectangle_(DC, *Item\rcItem\left, *Item\rcItem\top, *Item\rcItem\right, *Item\rcItem\bottom) 
EndMacro 

Macro DrawRectWholeEx(DC) 
  Rectangle_(DC, *Item\rcItem\left, *Item\rcItem\top, *Item\rcItem\right + 1, *Item\rcItem\bottom + 1) 
EndMacro 

Macro DrawRectBar(DC) 
  Rectangle_(DC, *Item\rcItem\left, *Item\rcItem\top, #Office_Dim_Menu_Bar - 3, *Item\rcItem\bottom + 1) 
EndMacro 

Macro DrawTextPrep(DC) 
  *Item\rcItem\top = (*Item\rcItem\top + *Item\rcItem\bottom - *Size\cy)/ 2 
  *Item\rcItem\left = #Office_Dim_Menu_Bar + 4 
  *Item\rcItem\right - 2
  pos=FindString(String$,Chr(9),1)
	If pos
  	llen=pos-1
  	rlen=Len(String$)-pos
  Else
		llen=Len(String$)
	  rlen=0
	EndIf
  DrawText_(DC, @String$,llen, *Item\rcItem,#DT_END_ELLIPSIS|#ES_LEFT) 
  If rlen
  	SetTextColor_(DC,RGB(80,20,128))
  	DrawText_(DC,@String$+llen+1,rlen,*Item\rcItem,#DT_END_ELLIPSIS|#ES_RIGHT) 
  EndIf
EndMacro 

Macro DrawBarPrep() 
  *Item\rcItem\top    = (*Item\rcItem\top + *Item\rcItem\bottom)/ 2 
  *Item\rcItem\left   = #Office_Dim_Menu_Bar + 4 
  *Item\rcItem\right  + #Office_Dim_Menu_Bar
  *Item\rcItem\bottom = *Item\rcItem\top + 1 
EndMacro 

Macro APIGetMenuString(String) 
  If *OfficeMenuItem\MenuType = #Office_Menu_Title 
    String = *OfficeMenuItem\MenuString 
  Else 
    String = Space(255) 
    GetMenuString_(*OfficeMenuItem\MenuID, *Item\itemID, @String, Len(String), #MF_BYCOMMAND) 
  EndIf 
EndMacro 

Procedure Office_Menu_Get_Font() 
  Metrics.NONCLIENTMETRICS 
  Metrics\cbSize = SizeOf(NONCLIENTMETRICS) 
  SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @Metrics, #Null) 
  ProcedureReturn CreateFontIndirect_(@Metrics\lfMenuFont) 
EndProcedure 

Procedure Office_Menu_Measure_Title(*Item.MEASUREITEMSTRUCT, *Size.SIZE) 
  *Item\itemWidth  = *Size\cx + 4 
  *Item\itemHeight = MenuHeight() 
EndProcedure 

Procedure Office_Menu_Measure_Entry(String$, *Item.MEASUREITEMSTRUCT, *Size.SIZE) 
  *Item\itemWidth  = #Office_Dim_Menu_Bar + *Size\cx + 20
  *Item\itemHeight = 22 
EndProcedure 

Procedure Office_Menu_Measure_Bar(*Item.MEASUREITEMSTRUCT) 
  *Item\itemWidth  = #Office_Dim_Menu_Bar 
  *Item\itemHeight = #Office_Dim_Menu_Offset_Y + 3 
EndProcedure 

Procedure Office_Menu_Measure_All(Handle, *Item.MEASUREITEMSTRUCT) 
  *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData 
  If *Item\CtlType = #ODT_MENU 
    DC = GetWindowDC_(Handle) 
    If DC 
      APIGetMenuString(String$) 
      If String$ 
        DrawFontPick(DC, Office_Menu_Get_Font()) 
        GetTextExtentPoint32_(DC, String$, Len(String$), @Size.SIZE) 
        If *OfficeMenuItem\MenuType = #Office_Menu_Title 
          Office_Menu_Measure_Title(*Item, @Size) 
        Else 
          Office_Menu_Measure_Entry(String$, *Item, @Size) 
        EndIf              
        DrawFontDrop(DC) 
      Else 
        Office_Menu_Measure_Bar(*Item) 
      EndIf 
      ReleaseDC_(Handle, DC) 
    EndIf 
  EndIf
EndProcedure 

Procedure Office_Menu_Draw_Check(DC, *Item.DRAWITEMSTRUCT) 
  MemoryDC = CreateCompatibleDC_(DC) 
  If MemoryDC 
    DrawItemsSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Selected)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Selected_Outline))) 
    TempBitmap = SelectObject_(MemoryDC, CreateBitmap_(GetSystemMetrics_(#SM_CXMENUCHECK), GetSystemMetrics_(#SM_CYMENUCHECK), 1, 1, #Null)) 
    If TempBitmap 
      Rectangle.RECT 
      Rectangle\right  = Rectangle\left + GetSystemMetrics_(#SM_CXMENUCHECK) 
      Rectangle\bottom = Rectangle\top + GetSystemMetrics_(#SM_CYMENUCHECK) 
      DrawFrameControl_(MemoryDC, @Rectangle, #DFC_MENU, #DFCS_MENUCHECK) 
      If *Item\itemState & #ODS_DISABLED 
        SetBkColor_(DC, Office_Color(#Office_Color_Face_Dim)) 
      ElseIf *Item\itemState & #ODS_SELECTED 
        SetBkColor_(DC, Office_Color(#Office_Color_Selected)) 
      Else 
        SetBkColor_(DC, Office_Color(#Office_Color_Face_Dim)) 
      EndIf 
      BitBlt_(DC, *Item\rcItem\left + 4, *Item\rcItem\top + GetSystemMetrics_(#SM_CYMENUCHECK)/ 2 - 2, GetSystemMetrics_(#SM_CXMENUCHECK), GetSystemMetrics_(#SM_CYMENUCHECK), MemoryDC, 0, 0, #SRCCOPY) 
    EndIf 
    DeleteObject_(SelectObject_(MemoryDC, TempBitmap)) 
    DeleteDC_(MemoryDC) 
  EndIf 
  
EndProcedure 

Procedure Office_Menu_Draw_Icon(DC, *Item.DRAWITEMSTRUCT) 
  *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData 
  DrawIconEx_(DC, *Item\rcItem\left + 2, *Item\rcItem\top + 3, *OfficeMenuItem\IconID, 16, 16, #Null, #Null, #DI_NORMAL) 
EndProcedure 

Procedure Office_Menu_Draw_Title_Normal(DC, *Item.DRAWITEMSTRUCT) 
  DrawItemsPick(DC, CreateSolidBrush_(GetSysColor_(#COLOR_3DFACE)), GetStockObject_(#NULL_PEN)) 
  Rectangle_(DC, *Item\rcItem\left, *Item\rcItem\top, *Item\rcItem\right + 1, *Item\rcItem\bottom + 1) 
EndProcedure 

Procedure Office_Menu_Draw_Title_Selected(DC, *Item.DRAWITEMSTRUCT) 
  DrawItemsPick(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Outline))) 
  DrawRectWhole(DC) 
  DrawPenSwap(DC, GetStockObject_(#NULL_PEN)) 
  Rectangle_(DC, *Item\rcItem\left + 1, *Item\rcItem\bottom - 1, *Item\rcItem\right, *Item\rcItem\bottom + 1) 
  SetProp_(GetActiveWindow_(), "FlagWidth", *Item\rcItem\right - *Item\rcItem\left) 
EndProcedure 

Procedure Office_Menu_Draw_Title_Hover(DC, *Item.DRAWITEMSTRUCT) 
  DrawItemsPick(DC, CreateSolidBrush_(Office_Color(#Office_Color_Selected)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Selected_Outline))) 
  DrawRectWhole(DC) 
EndProcedure 

Procedure Office_Menu_Draw_Title_Text(DC, String$, *Item.DRAWITEMSTRUCT) 
  GetTextExtentPoint32_(DC, String$, Len(String$), @Size.SIZE) 
  *Item\rcItem\top = *Item\rcItem\top +(( *Item\rcItem\bottom - *Item\rcItem\top)/ 2 - Size\cy / 2)- 1 
  DrawTextEx_(DC, @String$, -1, *Item\rcItem, #DT_CENTER | #DT_VCENTER | #DT_END_ELLIPSIS, #Null) 
EndProcedure 

Procedure Office_Menu_Draw_Entry_Normal(DC, *Item.DRAWITEMSTRUCT) 
  DrawRectWholeEx(DC) 
  DrawBrushSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim))) 
  DrawRectBar(DC) 
EndProcedure 

Procedure Office_Menu_Draw_Entry_Selected(DC, *Item.DRAWITEMSTRUCT) 
  DrawItemsSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Selected)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Selected_Outline))) 
  DrawRectWhole(DC) 
EndProcedure 

Procedure Office_Menu_Draw_Entry_Disabled(DC, *Item.DRAWITEMSTRUCT) 
  SetTextColor_(DC, Office_Color(#Office_Color_Disabled)) 
  DrawRectWholeEx(DC) 
  DrawBrushSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim))) 
  DrawRectBar(DC) 
EndProcedure 

Procedure Office_Menu_Draw_Bar(DC, *Item.DRAWITEMSTRUCT) 
  DrawRectWholeEx(DC) 
  DrawBrushSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim))) 
  DrawRectBar(DC) 
  DrawItemsSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Disabled)), CreatePen_(#PS_SOLID  , 1, Office_Color(#Office_Color_Disabled))) 
  DrawBarPrep() 
  DrawRectWhole(DC) 
EndProcedure 

Procedure Office_Menu_Draw_Item(DC, String$, *Item.DRAWITEMSTRUCT, *Size.SIZE) 
  Shared FirstTimeDisplayCounter 
  *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData 
  SetTextColor_(DC, #Black) 
  If *OfficeMenuItem\MenuType = #Office_Menu_Title 
    FirstTimeDisplayCounter = 0 
    If *Item\itemState & #ODS_SELECTED 
      Office_Menu_Draw_Title_Selected(DC, *Item) 
    ElseIf *Item\itemState & #ODS_HOTLIGHT 
      Office_Menu_Draw_Title_Hover(DC, *Item) 
    Else 
      Office_Menu_Draw_Title_Normal(DC, *Item) 
    EndIf 
    Office_Menu_Draw_Title_Text(DC, String$, *Item) 
  Else 
    FirstTimeDisplayCounter + 1 
    Debug FirstTimeDisplayCounter 
    DrawItemsPick(DC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Bright)), GetStockObject_(#NULL_PEN)) 
    If String$ 
      If *Item\itemState & #ODS_GRAYED 
        Office_Menu_Draw_Entry_Disabled(DC, *Item) 
      Else 
        SetTextColor_(DC, #Black) 
        If *Item\itemState & #ODS_SELECTED
          If FirstTimeDisplayCounter > GetMenuItemCount_(*OfficeMenuItem\MenuID) 
            Office_Menu_Draw_Entry_Selected(DC, *Item) 
          EndIf 
        Else  
          Office_Menu_Draw_Entry_Normal(DC, *Item) 
        EndIf 
      EndIf 
      If *Item\itemState & #ODS_CHECKED 
        Office_Menu_Draw_Check(DC, *Item) 
      EndIf 
      If *OfficeMenuItem\IconID 
        Office_Menu_Draw_Icon(DC, *Item) 
      EndIf 
      DrawTextPrep(DC) 
    Else 
      Office_Menu_Draw_Bar(DC, *Item) 
    EndIf 
  EndIf 
  DrawItemsDrop(DC) 
EndProcedure 

Procedure Office_Menu_Draw_All(Handle, *Item.DRAWITEMSTRUCT) 
  *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData 
  If *Item\CtlType = #ODT_MENU 
    DC = *Item\hdc 
    If DC 
      SetBkMode_(DC, #TRANSPARENT) 
      APIGetMenuString(String$) 
      GetTextExtentPoint32_(DC, String$, Len(String$), @Size.SIZE) 
      Office_Menu_Draw_Item(DC, String$, *Item, @Size) 
    EndIf 
  EndIf 
EndProcedure 

Procedure Office_Menu_Draw_Background(Handle, DC) 
  If Not DC 
    DC = GetWindowDC_(Handle) 
  EndIf 
  If DC 
    MemoryDC = CreateCompatibleDC_(DC) 
    If MemoryDC 
      GetWindowRect_(Handle, Rectangle.RECT) 
      TempBitmap = SelectObject_(MemoryDC, CreateCompatibleBitmap_(DC, Rectangle\right - Rectangle\left, Rectangle\bottom - Rectangle\top)) 
      If TempBitmap 
        DrawItemsPick(MemoryDC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Bright)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Outline))) 
        Rectangle_(MemoryDC, 0, 0, Rectangle\right - Rectangle\left, Rectangle\bottom - Rectangle\top)    
        DrawItemsSwap(MemoryDC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim)), GetStockObject_(#NULL_PEN)) 
        Rectangle_(MemoryDC, 1, 2, #Office_Dim_Menu_Bar, Rectangle\bottom - Rectangle\top - 1) 
        If GetProp_(GetActiveWindow_(), "FlagOpen")= #True 
          DrawBrushSwap(MemoryDC, CreateSolidBrush_(Office_Color(#Office_Color_Face_Dim))) 
          Rectangle_(MemoryDC, 1, 0, GetProp_(GetActiveWindow_(), "FlagWidth"), 2) 
        EndIf 
        BitBlt_(DC, 0, 0, Rectangle\right - Rectangle\left, Rectangle\bottom - Rectangle\top, MemoryDC, 0, 0, #SRCCOPY) 
      EndIf 
      DeleteObject_(SelectObject_(MemoryDC, TempBitmap)) 
      DeleteDC_(MemoryDC) 
    EndIf 
    ReleaseDC_(Handle, DC) 
  EndIf 
EndProcedure 

;**************************************************************** 
;* 
;-   Callbacks etc. 
;* 
;**************************************************************** 

Procedure OfficeMenuSetIcon(MenuID, itemID, IconID) 
  If IsMenu_(MenuID) 
    MenuInfo.MENUITEMINFO 
    MenuInfo\cbSize     = SizeOf(MENUITEMINFO) 
    MenuInfo\fMask      = #MIIM_DATA 
    MenuInfo\dwItemData = IconID 
    SetMenuItemInfo_(MenuID, itemID, #False, @MenuInfo) 
  EndIf 
EndProcedure 

Procedure Office_Menu_Set_Items(MenuID) 
  Shared FirstTimeDisplayCounter 
  FirstTimeDisplayCounter = 0 
  For Counter = 0 To GetMenuItemCount_(MenuID)- 1 
    MenuInfo.MENUITEMINFO 
    MenuInfo\cbSize     = SizeOf(MENUITEMINFO) 
    MenuInfo\fMask      = #MIIM_DATA 
    GetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo) 
    *OfficeMenuItem.OFFICEMENUITEM = AllocateMemory(SizeOf(OFFICEMENUITEM)) 
    *OfficeMenuItem\MenuID = MenuID 
    *OfficeMenuItem\IconID = MenuInfo\dwItemData 
    MenuInfo\fMask      = #MIIM_TYPE | #MIIM_DATA 
    MenuInfo\fType      = #MFT_OWNERDRAW 
    MenuInfo\dwItemData = *OfficeMenuItem 
    SetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo) 
  Next 
EndProcedure 

Procedure Office_Menu_Reset_Items(MenuID) 
  Shared FirstTimeDisplayCounter 
  FirstTimeDisplayCounter = 0 
  For Counter = 0 To GetMenuItemCount_(MenuID)- 1 
    MenuInfo.MENUITEMINFO 
    MenuInfo\cbSize     = SizeOf(MENUITEMINFO) 
    MenuInfo\fMask      = #MIIM_DATA 
    GetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo) 
    *OfficeMenuItem.OFFICEMENUITEM = MenuInfo\dwItemData 
    MenuInfo\fMask      = #MIIM_DATA 
    MenuInfo\dwItemData = *OfficeMenuItem\IconID 
    FreeMemory(*OfficeMenuItem) 
    SetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo)      
  Next 
EndProcedure 

Procedure Office_Window_Callback(Handle, message, wParam, lParam) 
  Protected WindowProc.l, ReturnValue.l 
  Select message 
    Case #WM_INITMENUPOPUP 
      If Not HiWord(lParam) 
        Office_Menu_Set_Items(wParam) 
        SetProp_(Handle, "FlagOpen", GetProp_(Handle, "FlagOpen")+ 1) 
      EndIf 
    Case #WM_UNINITMENUPOPUP 
      If Not HiWord(lParam) 
        Office_Menu_Reset_Items(wParam) 
        SetProp_(Handle, "FlagOpen", GetProp_(Handle, "FlagOpen")- 1) 
        If Not GetProp_(Handle, "FlagOpen") 
          SetProp_(Handle, "FlagWidth", #Null) 
        EndIf 
      EndIf 
    Case #WM_MEASUREITEM 
      Office_Menu_Measure_All(Handle, lParam) 
      ProcedureReturn #True 
    Case #WM_DRAWITEM 
      Office_Menu_Draw_All(Handle, lParam) 
      ProcedureReturn #True 
    Case #WM_DESTROY 
      RemoveProp_(Handle, "WindowProc") 
      RemoveProp_(Handle, "FlagWidth") 
      RemoveProp_(Handle, "FlagOpen") 
  EndSelect 
  WindowProc = GetProp_(Handle, "WindowProc") 
  If WindowProc 
    ReturnValue = CallWindowProc_ (WindowProc, Handle, message, wParam, lParam) 
  EndIf 
  ProcedureReturn ReturnValue 
EndProcedure 

Procedure Office_Menu_Check_Window(Handle) 
  GetWindowRect_(Handle, MenuRectangle.RECT) 
  GetWindowRect_(GetActiveWindow_(), ParentRectangle.RECT) 
  GetCursorPos_(MousePoint.POINT) 
  GetWindowRect_(FindWindow_("Shell_TrayWnd", ""), @TrayRectangle.RECT) 
  If PtInRect_(@TrayRectangle, MousePoint\X, MousePoint\Y) 
    ProcedureReturn #False 
  EndIf 
  If MenuRectangle\top - ParentRectangle\top = GetSystemMetrics_(#SM_CYBORDER)* 2 + GetSystemMetrics_(#SM_CYCAPTION) 
    ProcedureReturn #False 
  EndIf 
  If MenuRectangle\bottom => ParentRectangle\top And MenuRectangle\bottom <= ParentRectangle\top + GetSystemMetrics_(#SM_CYCAPTION)+ GetSystemMetrics_(#SM_CYBORDER) 
    ProcedureReturn #False 
  EndIf 
  If MenuRectangle\top => ParentRectangle\top And MenuRectangle\top <= ParentRectangle\top + GetSystemMetrics_(#SM_CYCAPTION)+ GetSystemMetrics_(#SM_CYBORDER) 
    ProcedureReturn #False 
  EndIf 
  If MenuRectangle\top <= ParentRectangle\top And MenuRectangle\bottom <= ParentRectangle\top + GetSystemMetrics_(#SM_CYCAPTION)+ GetSystemMetrics_(#SM_CYBORDER) 
    ProcedureReturn #False 
  EndIf 
  ProcedureReturn #True 
EndProcedure 

Procedure Office_Menu_Callback(Handle, message, wParam, lParam) 
  Protected WindowProc.l, ReturnValue.l 
  If Office_Menu_Check_Window(Handle) 
    Select message 
      Case #WM_PAINT 
        Office_Menu_Draw_Background(Handle, #Null) 
        InvalidateRect_(Handle, #Null, #Null) 
    EndSelect 
  EndIf 
  WindowProc = GetProp_(Handle, "WindowProc") 
  If WindowProc 
    ReturnValue = CallWindowProc_ (WindowProc, Handle, message, wParam, lParam) 
  EndIf 
  ProcedureReturn ReturnValue 
EndProcedure 

Procedure Office_Hook(code, wParam, lParam) 
  *Temporary.CWPSTRUCT = lParam 
  Select code 
    Case #HC_ACTION 
      Select *Temporary\message 
        Case #WM_CREATE 
          *CreateParams.CREATESTRUCT = *Temporary\lParam 
          If *CreateParams\lpszClass = 32768 
            SetProp_(*Temporary\hwnd, "FlagMenu", #True) 
            SetProp_(*Temporary\hwnd, "WindowProc", SetWindowLong_(*Temporary\hwnd, #GWL_WNDPROC, @Office_Menu_Callback())) 
            SystemParametersInfo_(#SPI_GETMENUFADE, #Null, @MenuFade, #Null) 
            SystemParametersInfo_(#SPI_GETMENUANIMATION, #Null, @MenuAnim, #Null) 
            SetProp_(*Temporary\hwnd, "MenuFade", MenuFade) 
            SetProp_(*Temporary\hwnd, "MenuAnim", MenuAnim) 
            If MenuFade : SystemParametersInfo_(#SPI_SETMENUFADE, #Null, #False, #Null): EndIf 
            If MenuAnim : SystemParametersInfo_(#SPI_SETMENUANIMATION, #Null, #False, #Null): EndIf 
          EndIf 
        Case #WM_DESTROY 
          If GetProp_(*Temporary\hwnd, "FlagMenu") 
            RemoveProp_(*Temporary\hwnd, "FlagMenu") 
            RemoveProp_(*Temporary\hwnd, "WindowProc") 
            SystemParametersInfo_(#SPI_SETMENUFADE, #Null, GetProp_(*Temporary\hwnd, "MenuFade"), #Null) 
            SystemParametersInfo_(#SPI_SETMENUANIMATION, #Null, GetProp_(*Temporary\hwnd, "MenuAnim"), #Null) 
            RemoveProp_(*Temporary\hwnd, "MenuFade") 
            RemoveProp_(*Temporary\hwnd, "MenuAnim") 
          EndIf 
      EndSelect 
  EndSelect 
  ProcedureReturn CallNextHookEx_(@Office_Hook(), code, wParam, lParam) 
EndProcedure 

Procedure InitOffice(Window) 
  If Not GetProp_(WindowID(Window), "OfficeMenuHook")
    SetProp_(WindowID(Window), "WindowProc", SetWindowLong_(WindowID(Window), #GWL_WNDPROC, @Office_Window_Callback())) 
    SetProp_(WindowID(Window), "WindowHook", SetWindowsHookEx_(#WH_CALLWNDPROC, @Office_Hook(), #Null, GetWindowThreadProcessId_(WindowID(Window), #Null))) 
    MenuID = GetMenu_(WindowID(Window)) 
    If MenuID 
      For Counter = 0 To GetMenuItemCount_(MenuID)- 1 
        String$ = Space(256) 
        GetMenuString_(MenuID, Counter, @String$, Len(String$), #MF_BYPOSITION) 
        *OfficeMenuTitle.OFFICEMENUITEM = AllocateMemory(SizeOf(OFFICEMENUITEM)) 
        *OfficeMenuTitle\MenuID     = MenuID 
        *OfficeMenuTitle\MenuType   = #Office_Menu_Title 
        *OfficeMenuTitle\MenuString = String$ 
        ModifyMenu_(MenuID, Counter, #MF_BYPOSITION | #MF_OWNERDRAW, -1, *OfficeMenuTitle) 
      Next 
      DrawMenuBar_(WindowID(Window)) 
    EndIf 
    ProcedureReturn #True 
  EndIf 
  ProcedureReturn #Null 
EndProcedure 

;**************************************************************** 
;* 
;-   Let the testing begin! 
;* 
;**************************************************************** 

#Window = 1 
#Menu   = 2 
#Popup  = 3 

If OpenWindow(#Window, 0, 0, 500, 400, "Menu Test", #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered | #PB_Window_Invisible) 
  
  If CreateGadgetList(WindowID(#Window)) 
    
  EndIf 
  
  If CreateMenu(#Menu, WindowID(#Window)) 
    
    MenuTitle("&File") 
    
    MenuItem(0, "New" + Chr(9 )+ "Ctrl N") 
    MenuItem(1, "Open..." + Chr(9 )+ "Ctrl O") 
    MenuItem(2, "Save" + Chr(9 )+ "Ctrl S") 
    MenuItem(3, "Save As...") 
    MenuItem(4, "Save All") 
    MenuItem(5, "Close" + Chr(9)+ "Ctrl W") 
    MenuItem(6, "Close All") 
    MenuBar() 
    MenuItem(7, "Sort Sources...") 
    MenuBar() 
    MenuItem(8, "Preferences...") 
    MenuBar() 
    OpenSubMenu("Recent Files") 
    MenuItem(9, "config.ini") 
    MenuItem(10, "autoexec.bat") 
    MenuItem(11, "kaboom.pb") 
    MenuBar() 
    OpenSubMenu("More Files") 
    MenuItem(200, "alpha.exe")    
    MenuItem(201, "beta.bat") 
    MenuItem(202, "gamma.com") 
    MenuItem(203, "delta.ini") 
    MenuItem(204, "epsilon.jpg") 
    MenuItem(205, "theta.bmp") 
    MenuItem(206, "omicron.mpg") 
    MenuItem(207, "omega.ogg") 
    MenuItem(208, "pi.tmp") 
    MenuItem(209, "tau.bak") 
    MenuItem(210, "mhy.txt") 
    CloseSubMenu() 
    CloseSubMenu()          
    MenuBar() 
    MenuItem(12, "Quit") 
    
    DisableMenuItem(#Menu, 1, #True) 
    DisableMenuItem(#Menu, 2, #True) 
    DisableMenuItem(#Menu, 3, #True) 
    DisableMenuItem(#Menu, 4, #True) 
    
    SetMenuItemState(#Menu, 0, #True) 
    SetMenuItemState(#Menu, 1, #True) 
    
    MenuTitle("&Tools") 
    
    MenuItem(20, "Visual Designer" + Chr(9)+ "Alt V") 
    MenuItem(21, "File Viewer") 
    MenuItem(22, "Structure Viewer" + Chr(9)+ "Alt S") 
    MenuItem(23, "Variable Viewer") 
    MenuItem(24, "Procedure Browser") 
    MenuItem(25, "Templates" + Chr(9)+ "Alt X") 
    MenuItem(26, "Color Picker" + Chr(9)+ "Alt P") 
    MenuItem(27, "Ascii Table" + Chr(9)+ "Alt A") 
    MenuItem(28, "Smart Update") 
    MenuBar() 
    MenuItem(29, "Configure Tools...") 
    
    OfficeMenuSetIcon(MenuID(#Menu), 21, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 46)) 
    OfficeMenuSetIcon(MenuID(#Menu), 22, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 23)) 
    OfficeMenuSetIcon(MenuID(#Menu), 23, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 3)) 
    OfficeMenuSetIcon(MenuID(#Menu), 26, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 12)) 
    
    DisableMenuItem(#Menu, 22, #True) 
    
    MenuTitle("&Help") 
    
    MenuItem(30, "Help...") 
    MenuBar() 
    OpenSubMenu("External Help") 
    MenuItem(31 ,"Call Fred!") 
    MenuItem(32 ,"Cry Wolf!") 
    MenuItem(33 ,"Dial 911!") 
    CloseSubMenu() 
    MenuBar() 
    MenuItem(34, "About") 
    
  EndIf 
  
  If CreatePopupMenu(#Popup) 
    
    MenuItem(100, "Simple") 
    MenuItem(101, "Popup") 
    MenuItem(102, "Menu") 
    MenuBar() 
    OpenSubMenu("--->") 
    MenuItem(103, "Boo!") 
    MenuBar() 
    OpenSubMenu("--->") 
    MenuItem(104, "Yikes!")          
    CloseSubMenu() 
    CloseSubMenu() 
    
    OfficeMenuSetIcon(MenuID(#Popup), 100, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 22)) 
    
  EndIf 
  
EndIf 

InitOffice(#Window) 

HideWindow(#Window, #False) 

Repeat 
  
  Event = WaitWindowEvent() 
  
  If Event = #WM_RBUTTONDOWN 
    
    DisplayPopupMenu(#Popup, WindowID(#Window)) 
    
  EndIf 
  
Until Event = #PB_Event_CloseWindow

I haven't encountered the XP bug mentioned here by gnozal, anyone been able to track it down?

PureBasic Forums - English

Office-style menus

Re: Office-style menus