Office-style menus

CherokeeStalker · Post by **CherokeeStalker** » Tue Sep 04, 2007 6:48 am

AWESOME !
Works perfectly here - WinXP Professional fully patched.
Sony VAIO laptop.

DoubleDutch · Post by **DoubleDutch** » Tue Sep 04, 2007 8:45 am

It was nothing really. I just put in a few bits my my own ownerdraw menus, just to tidy up the chr(9) stuff. I like the key to be a different colour than the text too. If you don't like that bit just take out the like that selects the new colour.

breeze4me · Post by **breeze4me** » Sat Sep 08, 2007 6:55 pm

Thank you for sharing the code.

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.

On XP, there is GDI object's leak somewhere. (I checked it with Task Manager)
while play around on a window with the menus, "GDI objects" is continuously increasing.

Especially, when other window is moving around on the window with Office-style menus, "GDI objects" is increased very fast.

Sparkie · Post by **Sparkie** » Sat Sep 08, 2007 7:39 pm

breeze4me wrote:On XP, there is GDI object's leak somewhere.

Caused by many CreateSolidBrush_() and CreatePen_() without any using DeleteObject() when finished

DoubleDutch · Post by **DoubleDutch** » Sat Sep 08, 2007 8:44 pm

Sparkie: I think thats it, or somewhere around it.

Sparkie · Post by **Sparkie** » Sat Sep 08, 2007 9:20 pm

I went through your latest code DoubleDutch, making the above mentioned fix, and no more GDI leak here.

breeze4me · Post by **breeze4me** » Sun Sep 09, 2007 11:30 am

Here fixed DoubleDutch's code.
Now no GDI Object leak on XP.

And fixed the problem that a string after Chr(9) is displayed incorrectly in unicode compile mode.

Code: Select all

EnableExplicit

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)
  CompilerIf Defined(DC#TempBrush, #PB_Variable) = 0
    Protected DC#TempBrush
  CompilerEndIf
  CompilerIf Defined(DC#TempPen, #PB_Variable) = 0
    Protected DC#TempPen
  CompilerEndIf
  DC#TempBrush = SelectObject_(DC, Brush)
  DC#TempPen   = SelectObject_(DC, Pen)
EndMacro

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

Macro DrawItemsSwap(DC, Brush, Pen)
  CompilerIf Defined(DC#TempBrush, #PB_Variable) = 0
    Protected DC#TempBrush
  CompilerEndIf
  CompilerIf Defined(DC#TempPen, #PB_Variable) = 0
    Protected DC#TempPen
  CompilerEndIf
  DC#TempBrush = SelectObject_(DC, Brush)
  DC#TempPen   = SelectObject_(DC, Pen)
EndMacro

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

Macro DrawBrushPick(DC, Brush)
  CompilerIf Defined(DC#TempBrush, #PB_Variable) = 0
    Protected DC#TempBrush
  CompilerEndIf
  DC#TempBrush = SelectObject_(DC, Brush)
EndMacro

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

Macro DrawBrushSwap(DC, Brush)
  CompilerIf Defined(DC#TempBrush, #PB_Variable) = 0
    Protected DC#TempBrush
  CompilerEndIf
  DC#TempBrush = SelectObject_(DC, Brush)
EndMacro

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

Macro DrawPenPick(DC, Pen)
  CompilerIf Defined(DC#TempPen, #PB_Variable) = 0
    Protected DC#TempPen
  CompilerEndIf
  DC#TempPen = SelectObject_(DC, Pen)
EndMacro

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

Macro DrawPenSwap(DC, Pen)
  CompilerIf Defined(DC#TempPen, #PB_Variable) = 0
    Protected DC#TempPen
  CompilerEndIf
  DC#TempPen = SelectObject_(DC, Pen)
EndMacro

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

Macro DrawFontPick(DC, Font)
  CompilerIf Defined(DC#TempFont, #PB_Variable) = 0
    Protected DC#TempFont
  CompilerEndIf
  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)
  CompilerIf Defined(pos, #PB_Variable) = 0
    Protected pos
  CompilerEndIf
  CompilerIf Defined(llen, #PB_Variable) = 0
    Protected llen
  CompilerEndIf
  CompilerIf Defined(rlen, #PB_Variable) = 0
    Protected rlen
  CompilerEndIf
  *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)*SizeOf(Character), 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)
  CompilerIf Defined(String, #PB_Variable) = 0
    Protected String
  CompilerEndIf
  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()
  Protected 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)
  Protected *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData
  Protected DC, String.s, Size.SIZE
  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)
        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)
  Protected MemoryDC = CreateCompatibleDC_(DC)
  Protected hbitmap, TempBitmap, Rectangle.RECT
  If MemoryDC
    DrawItemsSwap(DC, CreateSolidBrush_(Office_Color(#Office_Color_Selected)), CreatePen_(#PS_SOLID, 1, Office_Color(#Office_Color_Selected_Outline)))
    hbitmap = CreateBitmap_(GetSystemMetrics_(#SM_CXMENUCHECK), GetSystemMetrics_(#SM_CYMENUCHECK), 1, 1, #Null)
    TempBitmap = SelectObject_(MemoryDC, hbitmap)
    If TempBitmap
      
      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))
    DeleteObject_(hbitmap)
    DrawItemsSwapDrop(DC)
    DeleteDC_(MemoryDC)
  EndIf
  
EndProcedure

Procedure Office_Menu_Draw_Icon(DC, *Item.DRAWITEMSTRUCT)
  Protected *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)
  DrawItemsDrop(DC)
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)
  DrawItemsDrop(DC) 
  DrawPenSwap(DC, GetStockObject_(#NULL_PEN))
  Rectangle_(DC, *Item\rcItem\left + 1, *Item\rcItem\bottom - 1, *Item\rcItem\right, *Item\rcItem\bottom + 1)
  DrawPenSwapDrop(DC)
  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)
  DrawItemsDrop(DC)
EndProcedure

Procedure Office_Menu_Draw_Title_Text(DC, String$, *Item.DRAWITEMSTRUCT)
  Protected Size.SIZE
  GetTextExtentPoint32_(DC, String$, Len(String$), @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)
  DrawBrushSwapDrop(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)
  DrawItemsSwapDrop(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)
  DrawBrushSwapDrop(DC)
EndProcedure

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

Define FirstTimeDisplayCounter

Procedure Office_Menu_Draw_Item(DC, String$, *Item.DRAWITEMSTRUCT, *Size.SIZE)
  Shared FirstTimeDisplayCounter
  Protected *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)
  Protected *OfficeMenuItem.OFFICEMENUITEM = *Item\itemData
  Protected DC, Size.SIZE
  If *Item\CtlType = #ODT_MENU
    DC = *Item\hdc
    If DC
      SetBkMode_(DC, #TRANSPARENT)
      APIGetMenuString(String$)
      GetTextExtentPoint32_(DC, String$, Len(String$), @Size)
      Office_Menu_Draw_Item(DC, String$, *Item, @Size)
    EndIf
  EndIf
EndProcedure

Procedure Office_Menu_Draw_Background(Handle, DC)
  Protected MemoryDC, hbitmap, Rectangle.RECT, TempBitmap
  If Not DC
    DC = GetWindowDC_(Handle)
  EndIf
  If DC
    MemoryDC = CreateCompatibleDC_(DC)
    If MemoryDC
      GetWindowRect_(Handle, Rectangle)
      hbitmap = CreateCompatibleBitmap_(DC, Rectangle\right - Rectangle\left, Rectangle\bottom - Rectangle\top)
      TempBitmap = SelectObject_(MemoryDC, hbitmap)
      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)
        DrawItemsDrop(MemoryDC)
        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)
          DrawBrushSwapDrop(MemoryDC)
        EndIf
        DrawItemsSwapDrop(MemoryDC)
        BitBlt_(DC, 0, 0, Rectangle\right - Rectangle\left, Rectangle\bottom - Rectangle\top, MemoryDC, 0, 0, #SRCCOPY)
      EndIf
      DeleteObject_(SelectObject_(MemoryDC, TempBitmap))
      DeleteObject_(hbitmap)
      DeleteDC_(MemoryDC)
    EndIf
    ReleaseDC_(Handle, DC)
  EndIf
EndProcedure

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

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

Procedure Office_Menu_Set_Items(MenuID)
  Protected Counter, MenuInfo.MENUITEMINFO, *OfficeMenuItem.OFFICEMENUITEM
  Shared FirstTimeDisplayCounter
  FirstTimeDisplayCounter = 0
  For Counter = 0 To GetMenuItemCount_(MenuID)- 1
    MenuInfo\cbSize     = SizeOf(MENUITEMINFO)
    MenuInfo\fMask      = #MIIM_DATA
    GetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo)
    *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)
  Protected Counter, MenuInfo.MENUITEMINFO, *OfficeMenuItem.OFFICEMENUITEM
  Shared FirstTimeDisplayCounter
  FirstTimeDisplayCounter = 0
  For Counter = 0 To GetMenuItemCount_(MenuID)- 1
    MenuInfo\cbSize     = SizeOf(MENUITEMINFO)
    MenuInfo\fMask      = #MIIM_DATA
    GetMenuItemInfo_(MenuID, Counter, #True, @MenuInfo)
    *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)
  Protected MousePoint.POINT, MenuRectangle.RECT, ParentRectangle.RECT, TrayRectangle.RECT
  GetWindowRect_(Handle, MenuRectangle)
  GetWindowRect_(GetActiveWindow_(), ParentRectangle)
  GetCursorPos_(MousePoint)
  GetWindowRect_(FindWindow_("Shell_TrayWnd", ""), @TrayRectangle)
  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)
  Protected *Temporary.CWPSTRUCT = lParam
  Protected *CreateParams.CREATESTRUCT, MenuFade, MenuAnim
  Select code
    Case #HC_ACTION
      Select *Temporary\message
        Case #WM_CREATE
          *CreateParams = *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)
  Protected MenuID, Counter, String$, *OfficeMenuTitle.OFFICEMENUITEM
  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 = 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)

Define Event

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

DoubleDutch · Post by **DoubleDutch** » Sun Sep 09, 2007 12:34 pm

Oops, forgot about Unicode.

I don't actually use this system, I just transferred a couple of bits of code from the one that's kinda integrated into by stuff.

akee · Post by **akee** » Sat Sep 15, 2007 8:08 pm

How do you add in your own icon?

Code: Select all

OfficeMenuSetIcon(MenuID(#Menu), 21, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 46))
OfficeMenuSetIcon(MenuID(#Menu), 22, ?myownicon) ; <--  does not work


myownicon: IncludeBinary "default.ico"

srod · Post by **srod** » Sat Sep 15, 2007 8:13 pm

Use CatchImage() first :

Code: Select all

OfficeMenuSetIcon(MenuID(#Menu), 21, ExtractIcon_(GetModuleHandle_(#Null), "Shell32.dll", 46)) 
CathImage(1, ?myownicon)
OfficeMenuSetIcon(MenuID(#Menu), 22, ImageID(1))


myownicon: IncludeBinary "default.ico"

akee · Post by **akee** » Sun Sep 16, 2007 7:50 am

Oh cool! Thanks srod...

Leonhard · Post by **Leonhard** » Wed Oct 03, 2007 3:29 pm

There lot of Bugs with using keyborad:
- Painting
- the MenuBar must be ignore

Try to use the Menu with the Keybord (ALT and arrow keys).

DoubleDutch · Post by **DoubleDutch** » Wed Oct 03, 2007 4:15 pm

The source was posted so people can contribute. If you know about the bugs, fix them and post the modified source.

PureBasic Forums - English

Office-style menus

Office Style Menus