PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Office Style Menus in PureBasic

https://www.purebasic.fr/english/viewtopic.php?t=17938

Page 1 of 2

Office Style Menus in PureBasic

Posted: Fri Nov 25, 2005 6:59 am
by Straker
Code updated For 5.20+

CoolMenu.pb

Code: Select all

; ------------------------------------------------------------
; CoolMenu - example application
; requires coolmenu.pbi and coolmenu.dll
; ------------------------------------------------------------
;
; Platform: Windows 98, Windows 2000, Windows XP
; ===============================================================
; Modification History:
; Date     By      Description
; -------- ------- ----------------------------------------------
; 11/24/05 Straker Initial wrapper version.
; ---------------------------------------------------------------

;- include the CoolMenu.pbi...
XIncludeFile "coolmenu.pbi"

lWindowID = OpenWindow(#PB_Any, 100, 150, 395, 300, "PureBasic - Menu", #PB_Window_SystemMenu)
If (lWindowID <> 0)
  
  If CreateMenu(0,WindowID(lWindowID))
    
    ;- add the CoolMenu code
    CoolMenu = InitializeCoolMenu()
    If (CoolMenu > 0)
      If (LoadCoolMenu(CoolMenu,lWindowID)>0)
        SetCoolMenuBar(CoolMenu,1)
        SetCoolMenuStyle(CoolMenu,#CM_MenuStyleOffice2K3)
        SetCoolMenuShadow(CoolMenu,1)
        SetCoolMenuFlat(CoolMenu,1)
      EndIf
    EndIf
    
    MenuTitle("File")
    
    CoolMenuItem(CoolMenu,1, "Load (ico)","i_open.ico")
    CoolMenuItem(CoolMenu,2, "Save (jpg)","bookmark.jpg")
    
    MenuItem( 3, "Save As... (disabled)")
    MenuBar()
    
    CoolMenuItem(CoolMenu,4, "Print (bmp)","aid.bmp")
    
    MenuBar()
    CoolMenuItem(CoolMenu,7, "&Quit (gif)","alarm16.gif")
    
    MenuTitle("Edition")
    MenuItem(11, "Cut")
    MenuItem(12, "Copy")
    MenuItem(13, "Paste")
    
    MenuTitle("CoolMenu")
    MenuItem(31, "Normal Style")
    MenuItem(32, "Office 2000 Style")
    MenuItem(33, "Office XP Style")
    MenuItem(34, "Office 2003 Style")
    MenuBar()
    MenuItem(35,"Set Menu Shadow On")
    MenuItem(36,"Set Menu Shadow Off")
    MenuBar()
    MenuItem(37,"Set Menu Bevel On")
    MenuItem(38,"Set Menu Bevel Off (flat)")
    MenuBar()
    MenuItem(39,"Set Office 2003 Color")
    MenuBar()
    MenuItem(40,"Restore CoolMenu Defaults")
    
    MenuTitle("?")
    MenuItem(51, "About")
    
  EndIf
  
  DisableMenuItem(0,3, 1)
  
  Repeat
    
    Select WaitWindowEvent()
        
      Case #PB_Event_Menu
        
        Select EventMenu()  ; To see which menu has been selected
            
          Case 51 ; About
            MessageRequester("About", "Cool Menu example", 0)
            
          Case 31
            SetCoolMenuStyle(CoolMenu,#CM_MenuStyleNormal)
            
          Case 32
            SetCoolMenuStyle(CoolMenu,#CM_MenuStyleOffice2K)
            
          Case 33
            SetCoolMenuStyle(CoolMenu,#CM_MenuStyleOfficeXP)
            
          Case 34
            SetCoolMenuStyle(CoolMenu,#CM_MenuStyleOffice2K3) 
            
          Case 35
            SetCoolMenuShadow(CoolMenu,1) 
            
          Case 36
            SetCoolMenuShadow(CoolMenu,0) 
            
          Case 37
            SetCoolMenuFlat(CoolMenu,0) 
            
          Case 38
            SetCoolMenuFlat(CoolMenu,1)
            
          Case 39
            
            aColor = ColorRequester()
            If (aColor > -1)
              SetCoolMenuColor(CoolMenu,#CM_MenubarColor,aColor)
              SetCoolMenuColor(CoolMenu,#CM_GradientStartColor,RGB(255,255,255))
              SetCoolMenuColor(CoolMenu,#CM_GradientEndColor,aColor)
            EndIf
            
          Case 40
            SetCoolMenuDefaults(CoolMenu)
            
          Default
            MessageRequester("Info", "MenuItem: "+Str(EventMenu()), 0)
            
        EndSelect
        
      Case #PB_Event_CloseWindow
        Quit = 1
        
    EndSelect
    
  Until Quit = 1
  
EndIf

If (CoolMenu > 0)
  UnInitializeCoolMenu(CoolMenu)
EndIf

End
coolmenu.pbi

Code: Select all

; ---------------------------------------------------------------
; coolmenu.dll wrapper for PureBasic.
; Adapted from PowerBuilder by Straker. 11/14/2005
; Original DLL development by Aart Onkenhout
; Site: http://www.onkenhout.speedlinq.nl/index.html
;
; Feel free to customize and enhance this wrapper for the 
; benefit of the PureBasic community.
;
; Platform: Windows 98, Windows 2000, Windows XP
; ===============================================================
; Modification History:
; Date     By      Description
; -------- ------- ----------------------------------------------
; 11/14/05 Straker Initial wrapper version.
; ---------------------------------------------------------------
;

Enumeration 0 Step 1
  #CM_SelectedColor
  #CM_MenuBckColor
  #CM_BitmapBckColor
  #CM_CheckedSelectedColor
  #CM_CheckedColor
  #CM_PenColor
  #CM_TextColor
  #CM_HighlightTextColor
  #CM_DisabledTextColor
  #CM_GradientStartColor
  #CM_GradientEndColor
  #CM_MenubarColor
EndEnumeration

Enumeration 0 Step 1
  #CM_MenuStyleNormal
  #CM_MenuStyleOffice2K
  #CM_MenuStyleOfficeXP
  #CM_MenuStyleOffice2K3
EndEnumeration

Procedure InitializeCoolMenu()
  ; Call this function first.  It loads and initializes the DLL
  ;
  ; Returns a non-zero number if the library is succesfully opened.
  ; Returns 0 if the library could not be opened/found.
  ;
  lLibraryHandle = OpenLibrary(#PB_Any, "coolmenu.dll")
  ProcedureReturn lLibraryHandle
EndProcedure

Procedure UnInitializeCoolMenu(pLibraryHandle)
  ; Call this function last, after the parent window has closed.
  ;
  ; pLibraryHandle (long) - The handle of the opened library as 
  ; returned by Initialize()
  ;
  ; Returns 1 if successful in calling DLL
  ; Returns -1 if Library Handle is not valid
  ;
  lRetVal = 1
  If (pLibraryHandle > 0)
    CallFunction(pLibraryHandle,"Uninstall")
    CloseLibrary(pLibraryHandle)
  Else 
    lRetVal = -1
  EndIf
  ProcedureReturn lRetVal
EndProcedure

Procedure LoadCoolMenu(pLibraryHandle,pWindowID)
  ; Call this function after the Window has been opened and immediately 
  ; after the PureBasic Menu is created.
  ;
  ; pLibraryHandle (long) - The handle of the opened library as 
  ; returned by Initialize()
  ;
  ; pWindowHandle (long) - The PureBasic Window identifier (#Window_0)  
  ; of the parent window of the menu (not the Windows handle).
  ;
  ; Returns 1 if successful in calling DLL.
  ; Returns -1 if Library Handle is not valid.
  ; Returns -2 if Window is not valid.
  ;
  lRetVal = 1
  
  If (pLibraryHandle > 0)
    If IsWindow(pWindowID)
      lWindowHandle = WindowID(pWindowID)
      CallFunction(pLibraryHandle,"InstallCoolMenu",lWindowHandle)
      ; the following hide/show is necessary to display menubar
      ; on first startup (maybe a painting bug).
      HideWindow(pWindowID,1)
      HideWindow(pWindowID,0)
    Else
      lRetVal = -2
    EndIf
  Else
    lRetVal = -1
  EndIf
  ProcedureReturn lRetVal
EndProcedure

Procedure SetCoolMenuStyle(pLibraryHandle,pMenuStyle)
  ; Call this function after "LoadCoolMenu()" to set the style of
  ; the menu (see enumerations).
  ;
  ; pLibraryHandle (long) - The handle of the opened library as 
  ; returned by Initialize()
  ;
  ; pMenuStyle (long) - The style of menu to set (see enumerations).
  ;
  ; Returns 1 if successful in calling DLL.
  ; Returns -1 if Library Handle is not valid.
  ;
  lRetVal = 1
  
  If (pLibraryHandle > 0)
    If (pMenuStyle < 0)
      pMenuStyle = 0
    EndIf
    If (pMenuStyle > 3)
      pMenuStyle = 3
    EndIf
    CallFunction(pLibraryHandle,"SetMenuStyle",pMenuStyle)
  Else
    lRetVal = -1
  EndIf
  ProcedureReturn lRetVal
EndProcedure

Procedure SetCoolMenuColor(pLibraryHandle,pColorType,pColor)
  ; Call this function after "LoadCoolMenu()" to set the color of
  ; the menu elements (see enumerations).
  ;
  ; Note: To set the gradients for Office 2003 Style, call this 
  ; function twice in a row, using #CM_GradientStartColor first, 
  ; then #CM_GradientEndColor second as pColorType arguments.
  ;
  ; pLibraryHandle (long) - The handle of the opened library as 
  ; returned by Initialize()
  ;
  ; pColorType (long) - The type/element of the menu to set 
  ; (see enumerations).
  ;
  ; pColor (long) - The color as a long (see RGB() for more info).
  ;
  ; Returns 1 if successful in calling DLL.
  ; Returns -1 if Library Handle is not valid.
  ;
  lRetVal = 1
  
  If (pLibraryHandle > 0)
    If (pColorType < 0)
      pColorType = 0
    EndIf
    If (pColorType > 11)
      pColorType = 11
    EndIf
    If (pColor < RGB(0,0,0))
      pColor = RGB(0,0,0)
    EndIf
    If (pColor > RGB(255,255,255))
      pColor = RGB(255,255,255)
    EndIf
    CallFunction(pLibraryHandle,"SetMenuColor",pColorType,pColor)
  Else
    lRetVal = -1
  EndIf
  ProcedureReturn lRetVal
EndProcedure

Procedure SetCoolMenuBar(pLibraryHandle,pShowCoolMenuBar)
  ; Call this function after "LoadCoolMenu()" to set the menu bar
  ; to reflect the menu style ( 1 = on, 0 = off ).
  ;
  ; pLibraryHandle (long) - The handle of the opened library as 
  ; returned by Initialize()
  ;
  ; pShowCoolMenuBar (long) - Turn on or off the menu bar stylization.
  ;
  ; Returns 1 if successful in calling DLL.
  ; Returns -1 if Library Handle is not valid.
  ;
  lRetVal = 1
  
  If (pLibraryHandle > 0)
    If (pShowCoolMenuBar < 0)
      pShowCoolMenuBar = 0
    ElseIf (pShowCoolMenuBar > 1)
      pShowCoolMenuBar = 1
    EndIf
    CallFunction(pLibraryHandle,"SetCoolMenubar",pShowCoolMenuBar)
  Else
    lRetVal = -1
  EndIf
  ProcedureReturn lRetVal
EndProcedure

Procedure SetCoolMenuShadow(pLibraryHandle,pShowCoolMenuShadow)
  ; Call this function after "LoadCoolMenu()" to set the menu shadow
  ; ( 1 = on, 0 = off ).
  ;
  ; pLibraryHandle (long) - The handle of the opened library as 
  ; returned by Initialize()
  ;
  ; pShowCoolMenuShadow (long) - Turn on or off the menu shadow.
  ;
  ; Returns 1 if successful in calling DLL.
  ; Returns -1 if Library Handle is not valid.
  ;
  lRetVal = 1
  
  If (pLibraryHandle > 0)
    If (pShowCoolMenuShadow < 0)
      pShowCoolMenuShadow = 0
    ElseIf (pShowCoolMenuShadow > 1)
      pShowCoolMenuShadow = 1
    EndIf
    CallFunction(pLibraryHandle,"SetShadowEnabled",pShowCoolMenuShadow)
  Else
    lRetVal = -1
  EndIf
  ProcedureReturn lRetVal
EndProcedure

Procedure SetCoolMenuFlat(pLibraryHandle,pShowCoolMenuFlat)
  ; Call this function after "LoadCoolMenu()" to set the menu bevel to 
  ; flat ( 1 = flat, 0 = bevel ).
  ;
  ; pLibraryHandle (long) - The handle of the opened library as 
  ; returned by Initialize()
  ;
  ; pShowCoolMenuFlat (long) - Turn on or off the menu shadow.
  ;
  ; Returns 1 if successful in calling DLL.
  ; Returns -1 if Library Handle is not valid.
  ;
  lRetVal = 1
  
  If (pLibraryHandle > 0)
    If (pShowCoolMenuFlat < 0)
      pShowCoolMenuFlat = 0
    ElseIf (pShowCoolMenuFlat > 1)
      pShowCoolMenuFlat = 1
    EndIf
    CallFunction(pLibraryHandle,"SetFlatMenu",pShowCoolMenuFlat)
  Else
    lRetVal = -1
  EndIf
  ProcedureReturn lRetVal
EndProcedure

Procedure SetCoolMenuDefaults(pLibraryHandle)
  ; Call this function after "LoadCoolMenu()" to restore the 
  ; coolmenu defaults.
  ;
  ; pLibraryHandle (long) - The handle of the opened library as 
  ; returned by Initialize()
  ;
  ; Returns 1 if successful in calling DLL.
  ; Returns -1 if Library Handle is not valid.
  ;
  lRetVal = 1
  
  If (pLibraryHandle > 0)
    CallFunction(pLibraryHandle,"SetDefaults")
  Else
    lRetVal = -1
  EndIf
  ProcedureReturn lRetVal
EndProcedure

Procedure CoolMenuItem(pLibraryHandle,pMenuItemID,pMenuItemText.s,pMenuItemImage.s)
  ; Call this function after "LoadCoolMenu()" to set the menu item text and
  ; icon.  Use in place of PureBasic's MenuItem() function.  To add a MenuItem
  ; without an image, simply use the standard PB MenuItem() function instead.
  ;
  ; pLibraryHandle (long) - The handle of the opened library as 
  ; returned by Initialize()
  ;
  ; pMenuItemID (long) - The PureBasic MenuItem to set the text and image.
  ;
  ; pMenuItemText.s (string) - The text for the MenuItem.
  ;
  ; pMenuItemImage.s (string) - The image filename for the MenuItem.
  ;
  ; Returns 1 if successful in calling DLL.
  ; Returns -1 if Library Handle is not valid.
  ; Returns -2 if call to AddImage fails.
  ; Returns -3 if call to SetImageNameId fails.
  ;
  lRetVal = 0
  MenuItem(pMenuItemID,pMenuItemText.s)
  If (pLibraryHandle > 0)
    lImageIndex.w = CallFunction(pLibraryHandle,"AddImage",@pMenuItemImage.s,0,0,0 )
    If (lImageIndex.w > -1)
      lRetVal = CallFunction(pLibraryHandle,"SetImageNameId",@pMenuItemText.s,lImageIndex.w)
      If (lRetVal < 0)
        lRetVal = -3
      Else
        lRetVal = 1
      EndIf
    Else
      lRetVal = -2
    EndIf
  Else
    lRetVal = -1
  EndIf
  ProcedureReturn lRetVal
EndProcedure
The DLL is called CoolMenu.DLL and I have used it extensively in my PowerBuilder development. It was originally written for PowerBuilder by Aart Onkenhout.

So, I decided to write a wrapper for it in PureBasic since I have seen some postings requesting Office style menus.

Screenie:
Image

It has several nice features including using ICO, GIF, BMP, or JPG files for MenuItem images.

It has 4 different styles:

- Normal
- Office 2000
- Office XP
- Office 2003

You can also set the colors for all elements of the menu.

In PowerBuilder, I have seen it work on Win98, W2K, and WinXP, so I assume it should also work the same in PureBasic on these platforms.

It is free to use and redistribute, but if you choose to use it, be sure to check Aart's site (link above) for occassional updates, and drop him a thank you or make a donation (I have).

This is not available as a lib, just this DLL and wrapper.

I have documented my wrapper functions in coolmenu.pbi.

Click here to download.

Cheers.

Posted: Fri Nov 25, 2005 11:21 am
by Trond
If I alter the bevel setting while the shadow is off I can't turn on shadow again, no matter what I set the bevel setting back to.

Posted: Fri Nov 25, 2005 12:41 pm
by Dare2
Nice Straker, thanks.

Posted: Fri Nov 25, 2005 8:25 pm
by Straker
Trond wrote:If I alter the bevel setting while the shadow is off I can't turn on shadow again, no matter what I set the bevel setting back to.
I don't seem to have that problem Trond. I just tested this on W2K Professional. What OS are you running?

Posted: Fri Nov 25, 2005 8:41 pm
by Trond
Straker wrote:
Trond wrote:If I alter the bevel setting while the shadow is off I can't turn on shadow again, no matter what I set the bevel setting back to.
I don't seem to have that problem Trond. I just tested this on W2K Professional. What OS are you running?
Windows XP Home with themes disabled and shadows under menus disabled.

Posted: Fri Nov 25, 2005 8:56 pm
by Straker
Trond wrote:Windows XP Home with themes disabled and shadows under menus disabled.
Have you tried enabling "shadows under menus" to see if that fixes the problem? Maybe XP is just preventing the DLL from displaying the shadows.

Posted: Fri Nov 25, 2005 9:48 pm
by Trond
Straker wrote:
Trond wrote:Windows XP Home with themes disabled and shadows under menus disabled.
Have you tried enabling "shadows under menus" to see if that fixes the problem? Maybe XP is just preventing the DLL from displaying the shadows.
That sort of fixes the problem, because then I can't turn the shadows off. :lol:

Posted: Fri Nov 25, 2005 10:01 pm
by rsts
this is very nice.

thanks for another one, Straker.

cheers

Posted: Fri Nov 25, 2005 11:40 pm
by Straker
Trond wrote:That sort of fixes the problem, because then I can't turn the shadows off. :lol:
I guess that means that XP is overriding the DLL when it comes to shadow preferences.

Posted: Sat Nov 26, 2005 12:47 am
by utopiomania
Very good. Thanks! :)

Re: Office Style Menus in PureBasic

Posted: Sat Nov 26, 2005 2:11 am
by NoahPhense
Very nice ..

- np

Posted: Sat Nov 26, 2005 6:45 am
by Sparkie
Very nice contribution Straker. :cool:

Posted: Sat Nov 26, 2005 9:08 am
by Droopy
very good 8)

Posted: Sat Nov 26, 2005 11:18 am
by Trond
Straker wrote:
Trond wrote:That sort of fixes the problem, because then I can't turn the shadows off. :lol:
I guess that means that XP is overriding the DLL when it comes to shadow preferences.
But there ARE on when I start the example with shadows turned OFF in XP, and I can turn it off and on, but if try to turn if off/on with the bevel turned off it won't work.

Posted: Sat Nov 26, 2005 3:55 pm
by Straker
Trond wrote:But there ARE on when I start the example with shadows turned OFF in XP, and I can turn it off and on, but if try to turn if off/on with the bevel turned off it won't work.
I believe you. It may be an bug or oversight in the DLL. Since it was written to accommodate Win98, W2K, and WinXP, it may be using its own shadowing technique which is intermittently conflicting with the WinXP menu shadow preference.

Just a thought for a workaround if you want to force it to obey XP's preferences: set the bevel on then immediately off when the menu is created, and then from that point, it should obey XP's menu shadow preference.
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited