PureBasic Forums - English

Posted: **Fri May 25, 2007 1:00 pm**

Hello, I'm a fairly new PB user. One of the first things I noticed with the language was that there weren't any Office-style menus natively supported, and searching the forums revealed that no one had really done them before. So I decided to port some old code over to PB which allows this, the whole flat menu borders and all. Please note that since I'm new with PB, the code is probably riddled with silliness, so if you have a better way of doing Office-style menus, please let me know! No guarantee it will work on Win98 or even Win2K. If you can test, please do so.

Note that I haven't owner-drawn the top menubar-items, since I'm planning on implementing a rebar and slapping my menu on that, so I can have the same kind of menu MS Office-products have. Shouldn't be too hard. Some other things the code doesn't include yet are check marks and icons. Shouldn't be too hard to implement those either. One additional problem is that the system menu doesn't seem to be sending #WM_MEASUREITEM, but there are a few possible ways around that.

Okay, on to the code.

Code: Select all

;****************************************************************
;*
;-   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 )

	*OfficeMenuItem . OFFICEMENUITEM = *Item \ ItemData
	
	SetTextColor_ ( DC , #Black )
	
	If *OfficeMenuItem \ MenuType = #Office_Menu_Title

		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

		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
	                 
					Office_Menu_Draw_Entry_Selected ( DC , *Item )
	         
				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 )
     
   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 )
     
   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 )

	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

   ProcedureReturn CallWindowProc_ ( GetProp_ ( Handle , "WindowProc" ) , Handle , Message , wParam , lParam )

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 )

	If Not Office_Menu_Check_Window ( Handle )

		ProcedureReturn CallWindowProc_ ( GetProp_ ( Handle , "WindowProc" ) , Handle , Message , wParam , lParam )

	EndIf

   Select Message
              
       	Case #WM_PAINT

			Office_Menu_Draw_Background ( Handle , #Null )
               
         	InvalidateRect_ ( Handle , #Null , #Null )
     
    EndSelect

   ProcedureReturn CallWindowProc_ ( GetProp_ ( Handle , "WindowProc" ) , Handle , Message , wParam , lParam )

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

That's it, feel free to do what you wish with it. Hopefully it'll be useful to someone. If you can make it better somehow, please post the code here so everyone can benefit.

Also, I have to add that these last few weeks that I've been using PureBasic, it has proved to be a really sexy and sleek language. Most definitely a keeper. It integrates beautifully with the api, and compiles really small and fast executables! And, it has a great community

Posted: **Fri May 25, 2007 1:35 pm**

it has proved to be a really sexy and sleek language

I agree. It's the sexiest programming language.

Posted: **Fri May 25, 2007 1:39 pm**

damm cool, congrats !
I like that , very easy to use

what about pics ?

Posted: **Fri May 25, 2007 2:03 pm**

Nice bit of code, looks really good.

Posted: **Fri May 25, 2007 2:08 pm**

Rings wrote:damm cool, congrats !
I like that , very easy to use

what about pics ?

I'll implement menu icons as soon as I have the time, it won't be too hard. If you wish to try it yourself, just store the icon / image handle information into MenuItemInfo \ dwItemData and then draw the icon when responding to #WM_DRAWITEM.

Posted: **Fri May 25, 2007 2:48 pm**

Very very nice!!! Can't wait for the icons!

Posted: **Fri May 25, 2007 3:09 pm**

The code breaks the system menu.

Posted: **Fri May 25, 2007 6:09 pm**

Trond wrote:The code breaks the system menu.

Aye, it does make it a little wonky at the moment. I'll fix that (too) as soon as I can.

Posted: **Fri May 25, 2007 10:19 pm**

Great stuff, awesome work.

Can I suggest, however, using SetWindowLong_(hWnd, #GWL_WNDPROC,...) instead of SetWindowCallback() because, as it stands, applications using this code will not be able to set their own callbacks - at least not without removing yours.

You will of course have to use CallWindowProc_() in place of #PB_ProcessPureBasicEvents etc.

This way we can stuff your code into a nicely separated include file or even a user library.

Thanks for this.

Posted: **Sat May 26, 2007 12:30 am**

Really nice work there eesau

Here is a screen of the menu in action:

Here you can download a compiled example:

And the source file:

Posted: **Sat May 26, 2007 7:42 am**

eesau wrote:I'm new with PB, the code is probably riddled with silliness, so if you have a better way of doing Office-style menus, please let me know! No guarantee it will work on Win98 or even Win2K. If you can test, please do so.

Awesome.
I tested in under Win98SE : it almost works... Until you select a menu item with submenu ('External Help >' for example), and then windows crashes / freezes.

Posted: **Sat May 26, 2007 12:21 pm**

Fixed: Code now uses SetWindowLong_(hWnd, #GWL_WNDPROC,...) instead of SetWindowCallback() (thanks srod!)

Fixed: Code now leaves the system menu alone (thanks Trond!) It's a bit of a hack, but should work. Maybe I'll think of a better way later.

Edit: Found a bug already, fixed.

Edit: Moved code to first post.

Posted: **Sat May 26, 2007 1:04 pm**

Better edit your 1st post for the updated code and reply for changes. etc

BTW, nice code.

Posted: **Sat May 26, 2007 4:27 pm**

JCV wrote:Better edit your 1st post for the updated code and reply for changes. etc
BTW, nice code.

Oops, you're right. Moved code to first post.

Posted: **Sat May 26, 2007 7:14 pm**

Excellent work.

Thanks for this.

PureBasic Forums - English

Office-style menus

Office-style menus

Re: Office-style menus