PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Popup-Menü im Office XP Style

https://www.purebasic.fr/german/viewtopic.php?t=10516

Seite 1 von 2

Popup-Menü im Office XP Style

Verfasst: 25.10.2006 21:44
von legion
Hallo !
Habe die letzten Tage an einem Popup Menü im Office-XP-Style gebastelt.
Der Code funtioniert bei mir unter XP problemlos. Habe auch mehrere Fonts getestet, kein Problem.
Nur mit dem Seperator im Untermenü will es noch nicht funktionieren.
Habe bis jetzt noch keine Möglichkeit gefunden um auf das Submenü im
Ownerdraw (MEASUREITEM,DRAWITEM) zuzugreifen. Vielleicht habt ja ihr eine Idee ? Ansonst ist der Code sicher noch ausbaufähig (Gradient Sidebar, Gradient Selector usw.)

Lg.
Legion

Code: Alles auswählen

;-----------------------------------------------------------------------------------------------------------
; Popup-Menu im Office-Xp Style
; Code getestet under Windows XP
; Den Seperator im Untermenü konnte ich leider nicht verkleinern
; Sonstige Fehler: Bitte um Info !
;-----------------------------------------------------------------------------------------------------------
Structure TMenuItem
 HFont.l
 Text.s
 HIcon.l
EndStructure
;-----------------------------------------------------------------------------------------------------------
Global *MIS.MEASUREITEMSTRUCT
Global *DIS.DRAWITEMSTRUCT
Global MII.MENUITEMINFO
Global hMenu,MenuFont,FrameColor,SideBarWidth,HBmpWidth,HBmpHeight,TempDC,HBmp,MenuHigh
Global Rect.RECT
Global TextRect.SIZE
SideBarWidth = 30
;-----------------------------------------------------------------------------------------------------------
Procedure GetMenuHigh(hWnd,MyMenuHandle)
MEM = AllocateMemory(1024)
HDC = GetDC_(hWnd)
OrgFont = SelectObject_(HDC, MenuFont)
GetTextExtentPoint32_(HDC,"X",1,Size.SIZE)
size\cy + 2
SelectObject_(HDC,OrgFont)
ReleaseDC_(hWnd,HDC)

MII\cbSize      = SizeOf(MENUITEMINFO)
MII\fMask       = #MIIM_STRING
MII\dwTypeData  = MEM
MII\cch         = 1023

For i = 0 To GetMenuItemCount_(MyMenuHandle)-1
 MII\dwTypeData = mem
 MII\cch = 1023
 GetMenuItemInfo_(MyMenuHandle,i,#True,@MII)
 MII\dwTypeData
  If PeekS(mii\dwTypeData)= ""
   sizeX + 6
  Else
   sizeX + size\cy + 6
  EndIf
Next i
FreeMemory(mem)
ProcedureReturn sizeX
EndProcedure
;-----------------------------------------------------------------------------------------------------------
;Inhalt (Items) des Menü einlesen
Procedure$ GetMenuIDName(itemID)
  MII\cbSize        = SizeOf(MENUITEMINFO)
  MII\fMask         = #MIIM_STRING
  MII\fType         = #MFT_STRING
  MII\dwTypeData    = AllocateMemory(1024)
  MII\cch           = 1023
  If GetMenuItemInfo_(hMenu,itemID,0,MII)
   ItemName$        = PeekS(MII\dwTypeData)
  EndIf
  FreeMemory(MII\dwTypeData)
  ProcedureReturn ItemName$
EndProcedure
;-----------------------------------------------------------------------------------------------------------
;Menü in den OwnerDrawnModus schalten
Procedure SetMenuOwnerDrawn(MyMenuHandle)
  MII.MENUITEMINFO
  MII\cbSize = SizeOf(MENUITEMINFO)
  MII\fMask  = #MIIM_FTYPE
  MII\fType  = #MFT_OWNERDRAW
  For i = 0 To GetMenuItemCount_(MyMenuHandle)-1
   SetMenuItemInfo_(MyMenuHandle,i,#True,MII)
  Next i
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawSimpleSidebar(BarWidth)
  Height     = GetMenuHigh(WindowID(0),hMenu)
  HBmp       = CreateImage(0,BarWidth,Height)
  HBmpWidth  = BarWidth
  HBmpHeight = Height
  StartDrawing(ImageOutput(0))
  Box(0,0,BarWidth,Height,$00DEEDEF)
  StopDrawing()
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawSelected()
  ColFill    = $00EED2C1
  FrameColor = $00C56A31
  SetTextColor_(*DIS\HDC,$82121A)
  
If *DIS\itemState & #ODS_GRAYED
  SetTextColor_(*DIS\HDC,GetSysColor_(#COLOR_GRAYTEXT))
EndIf

 x = *DIS\rcItem\left + GetSystemMetrics_(#SM_CXMENUCHECK)+2
 y = *DIS\rcItem\top    

 ItemName$ = GetMenuIDName(*DIS\itemID)
 If ItemName$
  BitBlt_(*DIS\HDC,0,0,HBmpWidth,HBmpHeight,TempDC,0,0,#SRCAND)
  brush = CreateSolidBrush_(ColFill)
  FillRect_(*DIS\HDC,*DIS\rcItem,brush)
  FrameBrush  = CreateSolidBrush_(FrameColor)
  FrameRect_(*DIS\HDC,*DIS\rcItem,FrameBrush)
  DeleteObject_(brush)
  DeleteObject_(FrameBrush)
   SelectObject_(*DIS\HDC,MenuFont); Den Font umstellen
  
  *DIS\rcItem\left = *DIS\rcItem\left + SideBarWidth + 4
  DrawText_(*DIS\HDC,@ItemName$,Len(ItemName$),*DIS\rcItem,#DT_SINGLELINE|#DT_VCENTER|#DT_LEFT)  
;-----------------------------------------------------------------------------------------------------------
 Else ;Seperator zeichnen
  rect\top    = *DIS\rcItem\top+2
  rect\bottom = *DIS\rcItem\top+4
  rect\right  = *DIS\rcItem\right
  rect\left   = *DIS\rcItem\left + SideBarWidth +2
  DrawEdge_(*DIS\hDC,@rect,#BDR_SUNKENOUTER,#BF_RECT)
 EndIf
 
 If *DIS\itemState & #ODS_CHECKED
  Bmp = LoadBitmap_(0,#OBM_CHECK)
  old = SelectObject_(tempDC,Bmp)
  BitBlt_(*DIS\hDC,*DIS\rcItem\left-25,y+4,GetSystemMetrics_(#SM_CXMENUCHECK),GetSystemMetrics_(#SM_CYMENUCHECK),tempDC,0,0,#SRCAND)
  SelectObject_(tempDC,old)
  DeleteObject_(Bmp)
 EndIf
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawNorm()
  ColFill    = $FFFFFF
  FrameColor = $FFFFFF
If *DIS\itemState & #ODS_GRAYED
  SetTextColor_(*DIS\HDC,GetSysColor_(#COLOR_GRAYTEXT))
EndIf

 x = *DIS\rcItem\left + GetSystemMetrics_(#SM_CXMENUCHECK)+2
 y = *DIS\rcItem\top    

 ItemName$ = GetMenuIDName(*DIS\itemID)
 If ItemName$
  
  brush = CreateSolidBrush_(ColFill)
  FillRect_(*DIS\HDC,*DIS\rcItem,brush)
  FrameBrush  = CreateSolidBrush_(FrameColor)
  FrameRect_(*DIS\HDC,*DIS\rcItem,FrameBrush)
  DeleteObject_(brush)
  DeleteObject_(FrameBrush)
  
  SelectObject_(*DIS\HDC,MenuFont); Den Font umstellen
  
  *DIS\rcItem\left = *DIS\rcItem\left + SideBarWidth + 4
  DrawText_(*DIS\HDC,@ItemName$,Len(ItemName$),*DIS\rcItem,#DT_SINGLELINE|#DT_VCENTER|#DT_LEFT)  
;-----------------------------------------------------------------------------------------------------------
 Else ;Seperator zeichnen
  rect\top    = *DIS\rcItem\top+2
  rect\bottom = *DIS\rcItem\top+4
  rect\right  = *DIS\rcItem\right
  rect\left   = *DIS\rcItem\left + SideBarWidth +2
  DrawEdge_(*DIS\hDC,@rect,#BDR_SUNKENOUTER,#BF_RECT)  
 EndIf

 If *DIS\itemState & #ODS_CHECKED
  Bmp = LoadBitmap_(0,#OBM_CHECK)
  old = SelectObject_(TempDC,Bmp)
  BitBlt_(*DIS\hDC,*DIS\rcItem\left-25,y+4,GetSystemMetrics_(#SM_CXMENUCHECK),GetSystemMetrics_(#SM_CYMENUCHECK),tempDC,0,0,#SRCCOPY)
  SelectObject_(TempDC,old)
  DeleteObject_(Bmp)
 EndIf
 
 BitBlt_(*DIS\HDC,0,0,HBmpWidth,HBmpHeight,TempDC,0,0,#SRCAND)
 
EndProcedure

;-----------------------------------------------------------------------------------------------------------
Procedure WndProc(hWnd,Msg,wParam,lParam)
Result = #PB_ProcessPureBasicEvents 
Select Msg
;-----------------------------------------------------------------------------------------------------------
Case #WM_INITMENU
If TempDC = 0
 HDC = GetDC_(hWnd)
 TempDC = CreateCompatibleDC_(HDC)
 SelectObject_(TempDC,HBmp)
 ReleaseDC_(hWnd,HDC)
EndIf
 ModifyMenu_(hMenu,1,#MF_OWNERDRAW ,1,#Null)
 ModifyMenu_(hMenu,2,#MF_OWNERDRAW ,2,#Null)
;-----------------------------------------------------------------------------------------------------------
Case #WM_MEASUREITEM
 *MIS.MEASUREITEMSTRUCT = lParam
 HDC = GetDC_(hWnd)
 ItemName$ = GetMenuIDName(*MIS\itemID)
 If ItemName$ = ""
  *MIS\itemWidth  = SideBarWidth
  *MIS\itemHeight = 6
 Else
  OrgFont = SelectObject_(HDC, MenuFont)
  GetTextExtentPoint32_(HDC,ItemName$,Len(ItemName$),TextRect.SIZE)
  *MIS\itemWidth  = TextRect\cx + SideBarWidth +2
  *MIS\itemHeight = TextRect\cy +6
  SelectObject_(HDC,OrgFont)
  ReleaseDC_(hWnd,HDC)
 EndIf     
;-----------------------------------------------------------------------------------------------------------    
Case #WM_DRAWITEM
 *DIS.DRAWITEMSTRUCT = lParam
  SetBkMode_(*DIS\HDC, #TRANSPARENT)
  If *DIS\itemState & #ODS_SELECTED
   DrawSelected()        
  Else
   DrawNorm()
  EndIf
;-----------------------------------------------------------------------------------------------------------         
EndSelect
ProcedureReturn Result    
EndProcedure

;Popup-Menü erzeugen
hMenu = CreatePopupMenu(0)
If hMenu
 For i = 1 To 10
  MenuItem(100+i,"Ein Menüeintrag "+Str(i))
 Next i
 MenuBar()
 OpenSubMenu("Öffne Untermenü")
 MenuItem(1, "Untermenü 1")
 MenuBar()
 MenuItem(2, "Untermenü 2")
 CloseSubMenu()
 MenuBar()
 MenuItem(3, "Beenden")
EndIf 

SetMenuItemState(0,104,1)
SetMenuItemState(0,105,1)
DisableMenuItem(0,105,1) 
;-----------------------------------------------------------------------------------------------------------
;Neues Fenster öffen
If OpenWindow(0,200,200,600,400,"Office Xp Popup-Menü",#PB_Window_SystemMenu)
 MenuFont = LoadFont(0,"MS Sans Serif",10)
 DrawSimpleSidebar(SideBarWidth)
 SetMenuOwnerDrawn(hMenu);Menü in den OwnerDrawnModus schalten
 SetWindowCallback(@WndProc())     
;-----------------------------------------------------------------------------------------------------------
 Repeat
  Select WaitWindowEvent()
   Case #WM_RBUTTONDOWN
    DisplayPopupMenu(0,WindowID(0))
   Case #PB_Event_Menu
    Menu = EventMenu()
    If menu = 3
     Break
    EndIf 
   Case #PB_Event_CloseWindow
    Break
  EndSelect
 ForEver

EndIf
;-----------------------------------------------------------------------------------------------------------
End

Verfasst: 26.10.2006 08:06
von Little John
Funktioniert auch bei mir unter Windows 98. Cool! 8)
Der Seperator im Untermenü sieht genauso aus wie die beiden Separatoren im Haupt-Popupmenü -- und funktioniert sogar besser. ;)
D.h. wenn ich die Markierung mit den Pfeil-hoch/runter-Tasten bewege, wird der Seperator im Untermenü dabei erwartungsgemäß übersprungen. Die beiden Separatorn im Haupt-Popupmenü werden dabei nicht übersprungen. Die Markierung wird zunächst sozusagen vom Separator "verschluckt" (unsichtbar), und ich muss noch einmal die betr. Pfeiltaste drücken, damit die Markierung auf dem betr. Menüeintrag erscheint.

Gruß, Little John

Verfasst: 26.10.2006 09:50
von legion
Danke für die Info !
Das mit den Pfeiltasten hatte ich nicht bemerkt.
Aber der Seperator im Untermenü ist bei mir durchgängig und überragt die Sidebar.

Lg.
Legion

Re: Popup-Menü im Office XP Style

Verfasst: 26.10.2006 10:02
von Kiffi
Hallo legion,

Uih! Sieht schick aus :allright: Danke für's Teilen!

> Der Code funtioniert bei mir unter XP problemlos.

auch bei Windows 2000 SP 4 -> kein Problem.

> Vielleicht habt ja ihr eine Idee ?

leider nicht.

Dennoch wäre es toll, wenn Du am Ball bleibst. Wird schon klappen :)

Grüße ... Kiffi

Verfasst: 26.10.2006 10:40
von bluejoke
Fett!

Verfasst: 26.10.2006 14:41
von Alves
Schönes Menu!

Verfasst: 26.10.2006 18:18
von legion
UPDATE !

Seperatorproblem behoben, eine Submenütiefe möglich !

Lg.
Legion

Code: Alles auswählen

;-----------------------------------------------------------------------------------------------------------
; Popup-Menu im Office-Xp Style
; Code getestet under Windows XP und ME
; Eine Submenütiefe möglich
; Sonstige Fehler: Bitte um Info !
;-----------------------------------------------------------------------------------------------------------
Global *MIS.MEASUREITEMSTRUCT
Global *DIS.DRAWITEMSTRUCT
Global MII.MENUITEMINFO
Global hMenu,MenuFont,FrameColor,SideBarWidth,HBmpWidth,HBmpHeight,TempDC,HBmp,MenuHigh
Global Rect.RECT
Global TextRect.SIZE
SideBarWidth = 30
;-----------------------------------------------------------------------------------------------------------
Procedure GetMenuHigh(hWnd,MyMenuHandle)
MEM = AllocateMemory(1024)
HDC = GetDC_(hWnd)
OrgFont = SelectObject_(HDC, MenuFont)
GetTextExtentPoint32_(HDC,"X",1,Size.SIZE)
size\cy + 2
SelectObject_(HDC,OrgFont)
ReleaseDC_(hWnd,HDC)

MII\cbSize      = SizeOf(MENUITEMINFO)
MII\fMask       = #MIIM_STRING;|#MIIM_TYPE
MII\dwTypeData  = MEM
MII\cch         = 1023

For i = 0 To GetMenuItemCount_(MyMenuHandle)-1
 MII\dwTypeData = mem
 MII\cch = 1023
 GetMenuItemInfo_(MyMenuHandle,i,#True,@MII)
  If PeekS(mii\dwTypeData)= ""
   sizeX + 6
  Else
   sizeX + size\cy + 6
  EndIf
Next i
FreeMemory(mem)
ProcedureReturn sizeX
EndProcedure
;-----------------------------------------------------------------------------------------------------------
;Inhalt (Items) des Menü einlesen
Procedure$ GetMenuIDName(itemID)
  MII\cbSize        = SizeOf(MENUITEMINFO)
  MII\fMask         = #MIIM_STRING;|#MIIM_TYPE
  MII\fType         = #MFT_STRING
  MII\dwTypeData    = AllocateMemory(1024)
  MII\cch           = 1023
  If GetMenuItemInfo_(hMenu,itemID,0,MII)
   ItemName$        = PeekS(MII\dwTypeData)
  EndIf
  FreeMemory(MII\dwTypeData)
  ProcedureReturn ItemName$
EndProcedure
;-----------------------------------------------------------------------------------------------------------
;Menü in den OwnerDrawnModus schalten
Procedure SetMenuOwnerDrawn(MyMenuHandle)     
  MII\cbSize = SizeOf(MENUITEMINFO)
  MII\fMask  = #MIIM_TYPE	
  MII\fType  = #MFT_OWNERDRAW
  For i = 0 To GetMenuItemCount_(MyMenuHandle)-1
   SetMenuItemInfo_(MyMenuHandle,i,#True,MII)
  Next i
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawSimpleSidebar(BarWidth)
  Height     = GetMenuHigh(WindowID(0),hMenu)
  HBmp       = CreateImage(0,BarWidth,Height)
  HBmpWidth  = BarWidth
  HBmpHeight = Height
  StartDrawing(ImageOutput(0))
  Box(0,0,BarWidth,Height,$00DEEDEF)
  StopDrawing()
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawSelected()
  ColFill    = $00EED2C1
  FrameColor = $00C56A31
  SetTextColor_(*DIS\HDC,$82121A)	

If *DIS\itemState & #ODS_GRAYED
  SetTextColor_(*DIS\HDC,GetSysColor_(#COLOR_GRAYTEXT))
EndIf
	
 x = *DIS\rcItem\left + GetSystemMetrics_(#SM_CXMENUCHECK)+2
 y = *DIS\rcItem\top    

 ItemName$ = GetMenuIDName(*DIS\itemID)

 If ItemName$
  BitBlt_(*DIS\HDC,0,0,HBmpWidth,HBmpHeight,TempDC,0,0,#SRCAND)
  brush = CreateSolidBrush_(ColFill)
  FillRect_(*DIS\HDC,*DIS\rcItem,brush)
  FrameBrush  = CreateSolidBrush_(FrameColor)
  FrameRect_(*DIS\HDC,*DIS\rcItem,FrameBrush)
  DeleteObject_(brush)
  DeleteObject_(FrameBrush)
  SelectObject_(*DIS\HDC,MenuFont); Den Font umstellen
  
  *DIS\rcItem\left = *DIS\rcItem\left + SideBarWidth + 4
  DrawText_(*DIS\HDC,@ItemName$,Len(ItemName$),*DIS\rcItem,#DT_SINGLELINE|#DT_VCENTER|#DT_LEFT)  
;-----------------------------------------------------------------------------------------------------------
 Else ;Seperator zeichnen
  rect\top    = *DIS\rcItem\top+2
  rect\bottom = *DIS\rcItem\top+4
  rect\right  = *DIS\rcItem\right
  rect\left   = *DIS\rcItem\left + SideBarWidth +2
  DrawEdge_(*DIS\hDC,@rect,#BDR_SUNKENOUTER,#BF_RECT)
 EndIf
 
 If *DIS\itemState & #ODS_CHECKED
  Bmp = LoadBitmap_(0,#OBM_CHECK)
  old = SelectObject_(tempDC,Bmp)
  BitBlt_(*DIS\hDC,*DIS\rcItem\left-25,y+4,GetSystemMetrics_(#SM_CXMENUCHECK),GetSystemMetrics_(#SM_CYMENUCHECK),tempDC,0,0,#SRCAND)
  SelectObject_(tempDC,old)
  DeleteObject_(Bmp)
 EndIf
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawNorm()
  ColFill    = $FFFFFF
  FrameColor = $FFFFFF
If *DIS\itemState & #ODS_GRAYED
  SetTextColor_(*DIS\HDC,GetSysColor_(#COLOR_GRAYTEXT))
EndIf

 x = *DIS\rcItem\left + GetSystemMetrics_(#SM_CXMENUCHECK)+2
 y = *DIS\rcItem\top    

 ItemName$ = GetMenuIDName(*DIS\itemID)
 If ItemName$
  brush = CreateSolidBrush_(ColFill)
  FillRect_(*DIS\HDC,*DIS\rcItem,brush)
  FrameBrush  = CreateSolidBrush_(FrameColor)
  FrameRect_(*DIS\HDC,*DIS\rcItem,FrameBrush)
  DeleteObject_(brush)
  DeleteObject_(FrameBrush)
  
  SelectObject_(*DIS\HDC,MenuFont); Den Font umstellen
  
  *DIS\rcItem\left = *DIS\rcItem\left + SideBarWidth + 4
  DrawText_(*DIS\HDC,@ItemName$,Len(ItemName$),*DIS\rcItem,#DT_SINGLELINE|#DT_VCENTER|#DT_LEFT)  
;-----------------------------------------------------------------------------------------------------------
 Else ;Seperator zeichnen
  rect\top    = *DIS\rcItem\top+2
  rect\bottom = *DIS\rcItem\top+4
  rect\right  = *DIS\rcItem\right
  rect\left   = *DIS\rcItem\left + SideBarWidth +2
  DrawEdge_(*DIS\hDC,@rect,#BDR_SUNKENOUTER,#BF_RECT)  
 EndIf

 If *DIS\itemState & #ODS_CHECKED
  Bmp = LoadBitmap_(0,#OBM_CHECK)
  old = SelectObject_(TempDC,Bmp)
  BitBlt_(*DIS\hDC,*DIS\rcItem\left-25,y+4,GetSystemMetrics_(#SM_CXMENUCHECK),GetSystemMetrics_(#SM_CYMENUCHECK),tempDC,0,0,#SRCCOPY)
  SelectObject_(TempDC,old)
  DeleteObject_(Bmp)
 EndIf
 
 BitBlt_(*DIS\HDC,0,0,HBmpWidth,HBmpHeight,TempDC,0,0,#SRCAND)
 
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure WndProc(hWnd,Msg,wParam,lParam)
Result = #PB_ProcessPureBasicEvents 
Select Msg
;-----------------------------------------------------------------------------------------------------------
Case #WM_INITMENU
If TempDC = 0
 HDC = GetDC_(hWnd)
 TempDC = CreateCompatibleDC_(HDC)
 SelectObject_(TempDC,HBmp)
 ReleaseDC_(hWnd,HDC)
EndIf
;-----------------------------------------------------------------------------------------------------------
Case #WM_MEASUREITEM
 *MIS.MEASUREITEMSTRUCT = lParam
 HDC = GetDC_(hWnd)
 ItemName$ = GetMenuIDName(*MIS\itemID)
 If ItemName$ = ""
  *MIS\itemWidth  = SideBarWidth
  *MIS\itemHeight = 6
 Else
  OrgFont = SelectObject_(HDC, MenuFont)
  GetTextExtentPoint32_(HDC,ItemName$,Len(ItemName$),TextRect.SIZE)
  *MIS\itemWidth  = TextRect\cx + SideBarWidth +2
  *MIS\itemHeight = TextRect\cy +6
  SelectObject_(HDC,OrgFont)
  ReleaseDC_(hWnd,HDC)
 EndIf   
;-----------------------------------------------------------------------------------------------------------    
Case #WM_DRAWITEM
 *DIS.DRAWITEMSTRUCT = lParam
  SetBkMode_(*DIS\HDC, #TRANSPARENT)
  If *DIS\itemState & #ODS_SELECTED
   DrawSelected()        
  Else
   DrawNorm()
  EndIf
;-----------------------------------------------------------------------------------------------------------         
EndSelect
ProcedureReturn Result    
EndProcedure

;Popup-Menü erzeugen
hMenu = CreatePopupMenu(0)
If hMenu
 For i = 1 To 10
  MenuItem(100+i,"Ein Menüeintrag "+Str(i))
 Next i
 MenuBar()
 OpenSubMenu("Öffne Untermenü")
 MenuItem(1, "Untermenü 1")
 MenuBar()
 MenuItem(2, "Untermenü 2")
 MenuItem(3, "Untermenü 3")
 MenuItem(4, "Untermenü 4")
 CloseSubMenu()
 MenuBar()
 MenuItem(5, "Beenden")
EndIf 

SetMenuItemState(0,104,1)
SetMenuItemState(0,105,1)
DisableMenuItem(0,105,1)
SetMenuItemState(0,3,1)
SetMenuItemState(0,2,1)
DisableMenuItem(0,2,1) 
;-----------------------------------------------------------------------------------------------------------
;Neues Fenster öffen
If OpenWindow(0,200,200,600,400,"Office Xp Popup-Menü",#PB_Window_SystemMenu)
 MenuFont = LoadFont(0,"MS Sans Serif",10)
 DrawSimpleSidebar(SideBarWidth)
 SetMenuOwnerDrawn(hMenu);Menü in den OwnerDrawnModus schalten
 For i = 0 To GetMenuItemCount_(hMenu)-1
  SubHWND = GetSubMenu_(hMenu,i)
  If SubHWND <> 0 
  SetMenuOwnerDrawn(SubHWND) 
  EndIf  
 Next i
 
SetWindowCallback(@WndProc())     
;-----------------------------------------------------------------------------------------------------------
 Repeat
  Select WaitWindowEvent()
   Case #WM_RBUTTONDOWN
    DisplayPopupMenu(0,WindowID(0))
   Case #PB_Event_Menu
    Menu = EventMenu()
    If menu = 5
     Break
    EndIf 
   Case #PB_Event_CloseWindow
    Break
  EndSelect
 ForEver

EndIf
;-----------------------------------------------------------------------------------------------------------
End

Verfasst: 26.10.2006 19:11
von Little John
Bei Navigation mit den Pfeiltasten wird die Markierung immer noch von den Separatoren im Haupt-Popupmenü "verschluckt". Zusätzlich tritt dieses Problem nun auch beim Separator im Untermenü auf.

Gruß, Little John

Verfasst: 03.11.2006 22:49
von legion
UPDATE

Gradient-Sidebar, Gradient-Selector, Seitentext und Checkstate
Sub-Menüs wegen Seitentext nicht möglich.

Lg. Legion

Code: Alles auswählen

;-----------------------------------------------------------------------------------------------------------
; *****L-E-G-I-O-N-*-M-E-N-U*****
; Popup-Menu mit Gradient-Sidebar,Gradient-Selector,Seitentext und CheckStatus
; Code getestet under Windows XP
; wegen Seitentext keine Submenüs möglich
;-----------------------------------------------------------------------------------------------------------
 #vert = 0 
 #horz = 1 

Structure POINTAPI
 x.l
 y.l
EndStructure

Structure LPMENU
 MenuFont.l
 MenuColor.l
 FrameColor.l
 SideBarWidth.l
 GradStartColor.l
 GradEndColor.l
 SelGradStartColor.l
 SelGradEndColor.l 
 SideText.s
 SideText1Color.l
 SideText2Color.l
 CheckColorEnable.l
 CheckColorDisable.l
 SelectorFrameColor.l
 SelectorTextColor.l
 ImageWidth.l
 ImageHeight.l
EndStructure

Global Dim PtList.POINTAPI(2)
Global *MIS.MEASUREITEMSTRUCT
Global *DIS.DRAWITEMSTRUCT
Global MII.MENUITEMINFO
Global LPM.LPMENU
Global FTM.TEXTMETRIC
Global HDC,TempDC,GradTextDC,SelectorDC,HCheck,hMenu,SelHeight,SelWidht
Global Rect.RECT
Global TextRect.SIZE

Global CheckPos = LPM\SideBarWidth/2+24 ;Ausrichtung des Checkstate-Symbol
Global LPM\SideBarWidth         = 30
Global LPM\GradStartColor       = $00F7FAFB
Global LPM\GradEndColor         = $00D9EAED
Global LPM\SelGradStartColor    = $00FFFFFF
Global LPM\SelGradEndColor      = $0094E6FA
Global LPM\SideText1Color       = $00FFFFFF
Global LPM\SideText2Color       = $000E558D
Global LPM\CheckColorEnable     = $00000000
Global LPM\CheckColorDisable    = $0089A0A4
Global LPM\SelectorFrameColor.l = $002B7199
Global LPM\SelectorTextColor    = $00105883
Global LPM\MenuColor            = $00FFFFFF
Global LPM\SideText             = "Legion-Menü"
Global LPM\MenuFont = LoadFont(#PB_Any,"MS Sans Serif",10)
;-----------------------------------------------------------------------------------------------------------
Procedure GetMenuHigh(MyMenuHandle)
MEM = AllocateMemory(1024)
OrgFont = SelectObject_(HDC, FontID(LPM\MenuFont))
GetTextExtentPoint32_(HDC,"X",1,Size.SIZE)
size\cy
SelectObject_(HDC,OrgFont)

MII\cbSize      = SizeOf(MENUITEMINFO)
MII\fMask       = #MIIM_STRING;|#MIIM_TYPE
MII\dwTypeData  = MEM
MII\cch         = 1023

For i = 0 To GetMenuItemCount_(MyMenuHandle)-1
 MII\dwTypeData = mem
 MII\cch = 1023
 GetMenuItemInfo_(MyMenuHandle,i,#True,@MII)
  If PeekS(mii\dwTypeData)= ""
   sizeX + 6
  Else
   sizeX + size\cy + 6
  EndIf
Next i
FreeMemory(mem)
ProcedureReturn sizeX
EndProcedure
;-----------------------------------------------------------------------------------------------------------
;Inhalt (Items) des Menü einlesen
Procedure$ GetMenuIDName(itemID)
  Protected ItemDummy$
  MII\cbSize        = SizeOf(MENUITEMINFO)
  MII\fMask         = #MIIM_STRING;|#MIIM_TYPE
  MII\fType         = #MFT_STRING
  MII\dwTypeData    = AllocateMemory(1024)
  MII\cch           = 1023
  If GetMenuItemInfo_(hMenu,itemID,0,MII)
   ItemDummy$        = PeekS(MII\dwTypeData)
  EndIf
  FreeMemory(MII\dwTypeData)
  ProcedureReturn ItemDummy$
EndProcedure
;-----------------------------------------------------------------------------------------------------------
;Menü in den OwnerDrawnModus schalten
Procedure SetMenuOwnerDrawn(MyMenuHandle)     
  MII\cbSize = SizeOf(MENUITEMINFO)
  MII\fMask  = #MIIM_TYPE	
  MII\fType  = #MFT_OWNERDRAW
  For i = 0 To GetMenuItemCount_(MyMenuHandle)-1
   SetMenuItemInfo_(MyMenuHandle,i,#True,MII)
  Next i
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawGradientSelector(FrameColor,StartColor,EndColor)

  SelHeight     = *DIS\rcItem\bottom - *DIS\rcItem\top 
  SelWidht      = *DIS\rcItem\right - *DIS\rcItem\left
  SelDummy      = CreateImage(#PB_Any,SelWidht,SelHeight)
  SelBmp        = ImageID(SelDummy)

  type = #horz

  If type=#vert : i = SelWidht-1 : Else : i = SelHeight-1 : EndIf 
   sRed.f   = Red(StartColor)   : r.f = (Red  (StartColor) - Red  (EndColor))/i 
   sGreen.f = Green(StartColor) : g.f = (Green(StartColor) - Green(EndColor))/i 
   sBlue.f  = Blue(StartColor)  : b.f = (Blue (StartColor) - Blue (EndColor))/i 
   StartDrawing(ImageOutput(SelDummy))
   Box(0,0,SelWidht,SelHeight,FrameColor)  
    For a = 1 To i-1 
     x.f = sRed   - a*r 
     y.f = sGreen - a*g 
     z.f = sBlue  - a*b 
     If type=#horz 
      Line(1,a,SelWidht-2,0,RGB(x,y,z)) 
     Else 
      Line(a,1,0,SelHeight-2,RGB(x,y,z)) 
     EndIf 
    Next a     
    StopDrawing()  
  SelectObject_(SelectorDC,SelBmp)
  FreeImage(SelDummy)   
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawGradientSidebar(Hwnd,MyDC,BarWidth,StartColor,EndColor,SideText$) 
 Protected Height,HBmp,HBmpWidth,HBmpHeight,SourceDC,STFontDummy,HBmpDummy
  
  Height     = BarWidth
  HBmpDummy  = CreateImage(#PB_Any,GetMenuHigh(Hwnd),BarWidth)
  HBmp = ImageID(HBmpDummy)
  HBmpWidth  = GetMenuHigh(Hwnd)
  HBmpHeight = Height
  type = #horz

  If type=#vert : i = HBmpWidth : Else : i = HBmpHeight : EndIf 
   sRed.f   = Red(StartColor)   : r.f = (Red  (StartColor) - Red  (EndColor))/i 
   sGreen.f = Green(StartColor) : g.f = (Green(StartColor) - Green(EndColor))/i 
   sBlue.f  = Blue(StartColor)  : b.f = (Blue (StartColor) - Blue (EndColor))/i 
   STFontDummy = LoadFont(#PB_Any,"Arial",12,#PB_Font_Bold|#PB_Font_HighQuality)
   StartDrawing(ImageOutput(HBmpDummy)) 
    For a = 0 To i-1 
     x.f = sRed   - a*r 
     y.f = sGreen - a*g 
     z.f = sBlue  - a*b 
     If type=#horz 
      Line(0,a,HBmpWidth,0,RGB(x,y,z)) 
     Else 
      Line(a,0,0,HBmpHeight,RGB(x,y,z)) 
     EndIf 
    Next a 
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(STFontDummy))
  DrawText(5, 5, SideText$,LPM\SideText1Color)
  DrawText(4, 4, SideText$,LPM\SideText2Color)
  StopDrawing() 
  FreeFont(STFontDummy)
  SourceDC  = CreateCompatibleDC_(MyDC)
  SelectObject_(SourceDC,HBmp)
  FreeImage(HBmpDummy)
 
 Dummy = CreateImage(#PB_Any,BarWidth,GetMenuHigh(Hwnd))
 Dest = ImageID(Dummy)
 SelectObject_(MyDC,Dest)
 FreeImage(Dummy) 
    ;links oben
    PtList(0)\x = 0
    PtList(0)\y = HBmpWidth
    ;rechts oben
    PtList(1)\x = 0
    PtList(1)\y = 0
    ;links unten
    PtList(2)\x = HBmpHeight
    PtList(2)\y = HBmpWidth
    
    PlgBlt_(MyDC,PtList(),SourceDC,0,0,HBmpWidth,HBmpHeight,0,0,0)
    LPM\ImageWidth = HBmpWidth
    LPM\ImageHeight = HBmpHeight
    ReleaseDC_(hWnd,SourceDC)          
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawCheckState(CheckColor)  
  Height      = 18
  Width       = 18
  HCheckDummy = CreateImage(#PB_Any,Width,Height)
  HCheck      = ImageID(HCheckDummy)
  StartDrawing(ImageOutput(HCheckDummy))
  Box(0,0,Width,Height,CheckColor)
  Box(1,1,Width-2,Height-2,$FFFFFF)
  StopDrawing()  
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawSelected()
  SetTextColor_(*DIS\HDC,LPM\SelectorTextColor)	

If *DIS\itemState & #ODS_GRAYED
  SetTextColor_(*DIS\HDC,GetSysColor_(#COLOR_GRAYTEXT))
  CheckColor = LPM\CheckColorDisable
Else
  CheckColor = LPM\CheckColorEnable 
EndIf
	
 x = *DIS\rcItem\left + GetSystemMetrics_(#SM_CXMENUCHECK)+2
 y = *DIS\rcItem\top    

 ItemName$ = GetMenuIDName(*DIS\itemID)
 If ItemName$
  BitBlt_(*DIS\HDC,*DIS\rcItem\left,*DIS\rcItem\Top,SelWidht,SelHeight,SelectorDC,0,0,#SRCCOPY)
  SelectObject_(*DIS\HDC,FontID(LPM\MenuFont)); Den Font umstellen  
  *DIS\rcItem\left = *DIS\rcItem\left + LPM\SideBarWidth + 4
  DrawText_(*DIS\HDC,@ItemName$,Len(ItemName$),*DIS\rcItem,#DT_SINGLELINE|#DT_VCENTER|#DT_LEFT)  
;-----------------------------------------------------------------------------------------------------------
 Else ;Seperator zeichnen
  rect\top    = *DIS\rcItem\top+2
  rect\bottom = *DIS\rcItem\top+4
  rect\right  = *DIS\rcItem\right
  rect\left   = *DIS\rcItem\left + LPM\SideBarWidth +2
  DrawEdge_(*DIS\hDC,@rect,#BDR_SUNKENOUTER,#BF_RECT)
 EndIf
;----------------------------------------------------------------------------------------------------------- 
 If *DIS\itemState & #ODS_CHECKED
  DrawCheckState(CheckColor)
  Bmp = LoadBitmap_(0,#OBM_CHECK)
  old = SelectObject_(TempDC,HCheck)
  BitBlt_(*DIS\hDC,*DIS\rcItem\left-CheckPos-4,*DIS\rcItem\top+2,20,20,tempDC,0,0,#SRCCOPY)
  SelectObject_(TempDC,Bmp)
  BitBlt_(*DIS\hDC,*DIS\rcItem\left-CheckPos,y+4,GetSystemMetrics_(#SM_CXMENUCHECK),GetSystemMetrics_(#SM_CYMENUCHECK),tempDC,0,0,#SRCAND)
  SelectObject_(TempDC,old)
  DeleteObject_(HCheck)
  DeleteObject_(Bmp)
 EndIf
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure DrawNorm()
  LPM\FrameColor = $FFFFFF
If *DIS\itemState & #ODS_GRAYED
  SetTextColor_(*DIS\HDC,GetSysColor_(#COLOR_GRAYTEXT))
  CheckColor = LPM\CheckColorDisable
Else
  CheckColor = LPM\CheckColorEnable  
EndIf

 x = *DIS\rcItem\left + GetSystemMetrics_(#SM_CXMENUCHECK)+2
 y = *DIS\rcItem\top    

 ItemName$ = GetMenuIDName(*DIS\itemID)
 If ItemName$
  brush = CreateSolidBrush_(LPM\MenuColor)
  FillRect_(*DIS\HDC,*DIS\rcItem,brush)
  FrameBrush  = CreateSolidBrush_(LPM\FrameColor)
  FrameRect_(*DIS\HDC,*DIS\rcItem,FrameBrush)
  DeleteObject_(brush)
  DeleteObject_(FrameBrush)  
  SelectObject_(*DIS\HDC,FontID(LPM\MenuFont)); Den Font umstellen  
  *DIS\rcItem\left = *DIS\rcItem\left + LPM\SideBarWidth + 4
  DrawText_(*DIS\HDC,@ItemName$,Len(ItemName$),*DIS\rcItem,#DT_SINGLELINE|#DT_VCENTER|#DT_LEFT)  
;-----------------------------------------------------------------------------------------------------------
 Else ;Seperator zeichnen
  rect\top    = *DIS\rcItem\top+2
  rect\bottom = *DIS\rcItem\top+4
  rect\right  = *DIS\rcItem\right
  rect\left   = *DIS\rcItem\left + LPM\SideBarWidth +2
  DrawEdge_(*DIS\hDC,@rect,#BDR_SUNKENOUTER,#BF_RECT)  
 EndIf

 If *DIS\itemState & #ODS_CHECKED
  DrawCheckState(CheckColor)
  Bmp = LoadBitmap_(0,#OBM_CHECK)
  old = SelectObject_(TempDC,HCheck)
  BitBlt_(*DIS\hDC,*DIS\rcItem\left-CheckPos -4,*DIS\rcItem\top+2,20,20,tempDC,0,0,#SRCCOPY)
  SelectObject_(TempDC,Bmp)
  BitBlt_(*DIS\hDC,*DIS\rcItem\left-CheckPos,y+4,GetSystemMetrics_(#SM_CXMENUCHECK),GetSystemMetrics_(#SM_CYMENUCHECK),tempDC,0,0,#SRCAND)
  SelectObject_(TempDC,old)
  DeleteObject_(HCheck)
  DeleteObject_(Bmp)
 EndIf
 BitBlt_(*DIS\HDC,0,0,LPM\ImageHeight,LPM\ImageWidth,GradTextDC,0,0,#SRCAND)
EndProcedure
;-----------------------------------------------------------------------------------------------------------
Procedure WndProc(hWnd,Msg,wParam,lParam)
Result = #PB_ProcessPureBasicEvents 
Select Msg
;-----------------------------------------------------------------------------------------------------------
Case #WM_INITMENU
 HDC           = GetDC_(hWnd)
 TempDC        = CreateCompatibleDC_(HDC)
 GradTextDC    = CreateCompatibleDC_(HDC)
 SelectorDC    = CreateCompatibleDC_(HDC)
 SetMenuOwnerDrawn(hMenu);Menü in den OwnerDrawnModus schalten
 DrawGradientSidebar(hMenu,GradTextDC,LPM\SideBarWidth,LPM\GradStartColor,LPM\GradEndColor,LPM\SideText)
;-----------------------------------------------------------------------------------------------------------
Case #WM_MEASUREITEM
 *MIS.MEASUREITEMSTRUCT = lParam
 ItemName$ = GetMenuIDName(*MIS\itemID)
 If ItemName$ = ""
  *MIS\itemWidth  = LPM\SideBarWidth
  *MIS\itemHeight = 6
 Else 
  OrgFont = SelectObject_(HDC, FontID(LPM\MenuFont))
  GetTextExtentPoint32_(HDC,ItemName$,Len(ItemName$),TextRect.SIZE)
  *MIS\itemWidth  = TextRect\cx + LPM\SideBarWidth +2
  *MIS\itemHeight = TextRect\cy +6
  SelectObject_(HDC,OrgFont)
 EndIf 
;-----------------------------------------------------------------------------------------------------------    
Case #WM_DRAWITEM
 *DIS.DRAWITEMSTRUCT = lParam
  SetBkMode_(*DIS\HDC, #TRANSPARENT)
  If *DIS\itemState & #ODS_SELECTED
   DrawGradientSelector(LPM\SelectorFrameColor,LPM\SelGradStartColor,LPM\SelGradEndColor)
   DrawSelected()        
  Else
   DrawNorm()
  EndIf
  
Case #WM_EXITMENULOOP        
 ReleaseDC_(hWnd,HDC)
 ReleaseDC_(hWnd,TempDC)
 ReleaseDC_(hWnd,GradTextDC)
 ReleaseDC_(hWnd,SelectorDC) 
EndSelect
ProcedureReturn Result    
EndProcedure
;-----------------------------------------------------------------------------------------------------------
;Popup-Menü erzeugen
PMenuNr = CreatePopupMenu(#PB_Any)
hMenu = MenuID(PMenuNr)
 For i = 1 To 15
  MenuItem(100+i,"Ein Menüeintrag "+Str(i))
 Next i
 MenuBar()
 MenuItem(5, "Beenden")
; Menustate setzen
SetMenuItemState(PMenuNr,104,1)
SetMenuItemState(PMenuNr,105,1)
DisableMenuItem(PMenuNr,105,1)
;-----------------------------------------------------------------------------------------------------------
;Neues Fenster öffen
If OpenWindow(0,200,200,600,400,"Office Xp Popup-Menü",#PB_Window_SystemMenu)
 SetWindowCallback(@WndProc())     
;-----------------------------------------------------------------------------------------------------------
 Repeat
  Select WaitWindowEvent()
   Case #WM_RBUTTONDOWN
    DisplayPopupMenu(PMenuNr,WindowID(0))
   Case #PB_Event_Menu
    Menu = EventMenu()
    If menu = 5
     Break
    EndIf 
   Case #PB_Event_CloseWindow
    Break
  EndSelect
 ForEver

EndIf
;-----------------------------------------------------------------------------------------------------------
End

Verfasst: 04.11.2006 00:43
von winduff
:shock:

Wow! Super gemacht, danke fürs teilen :allright:
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de