Opprett et nytt utseende for menyer med dette VCL.Set den Ownerdraw tilhører menyen du ønsker å endre til sann, og kaller Execute method.unit XpMenu; interfaceuses Windows, kurs , grafikk, Menyer -typen TXpMenu = klasse (TComponent) private {felleserklæringer} FSelColor: TColor; FStripColor: TColor; FBackColor: TColor; FStripWidth: integer; FSelFontColor: TColor; FNotSelFontColor: TColor; FNotActiveColor: TColor; beskyttet {Beskyttede erklæringer} public {offentlige erklæringer} Prosedyre Utfør; Prosedyre RemoveXPs; Constructor Opprette (AOwner: TComponent); styre; publiserte {Publisert erklæringer} prosedyre DefMenuDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; Valgt: Boolean); Prosedyren DefMenuMeasureItem (Sender: TObject; ACanvas: TCanvas; Var Bredde, Høyde: Integer); Prosedyren DefMenuAdvancedDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; Stat: TOwnerDrawState); Eiendommen SelectionColor: TColor lese FSelColor skrive FSelColor; Eiendommen SelectionFontColor: TColor lese FSelFontColor skrive FSelFontColor; Eiendommen NotSelectedFontColor: TColor lese FNotSelFontColor skrive FNotSelFontColor; Eiendommen NotActiveColor: TColor lese FNotActiveColor skrive FNotActiveColor; Eiendommen StripColor: TColor lese FStripColor skrive FStripColor; Eiendommen Backcolor: TColor lese FBackColor skrive FBackColor; Eiendommen StripWidth: integer lese FStripWidth skrive FStripWidth; enden, prosedyre register, implementationconstructor TXpMenu.Create (AOwner: TComponent), begynner arvet Opprette (AOwner); FSelFontColor: = clWhite; FSelColor: = $ 00FEC0D0; FStripColor: = clGray; FBackColor: = clWhite; FNotSelFontColor: = clBlack; FNotActiveColor: = clGray; FStripWidth: = 20; ende; prosedyre TXpMenu.DefMenuDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; Valgt: Boolean); konst cHotkeyPrefix = "& '; Justeringer: array [TPopupAlignment] Word = (DT_LEFT, DT_RIGHT, DT_CENTER); Var myBaseR: TRect; myrect: TRect; myBRect: TRect; mySrect: TRect; vCaption: String; vColumn: integer; ParentMenu: TMenu; Flags: integer; NotEnabled: boolean; Justering: TPopupAlignment; BitMp: TBitmap, begynner BitMp: = TBitmap.Create; ParentMenu: = TMenuItem (Sender) .GetParentMenu; NotEnabled: = TMenuItem (Sender) .Enabled = false; //outputdebugstring(pchar(string(ParentMenu.ClassName))); hvis ParentMenu er TMenu deretter Alignment: = paLeft annet hvis ParentMenu er TPopupMenu deretter Alignment: = TPopupMenu (ParentMenu) .Alignment annet Alignment: = paLeft; myBaseR.Left: = ARect.Left; myBaseR.Right: = myBaseR.Left + FStripWidth; myBaseR.Top:=ARect.Top; myBaseR.Bottom: = ARect.Bottom; Myrect.Left: = ARect.Left + FStripWidth; Myrect.Right: = ARect.Right; Myrect.Top:=ARect.Top; Myrect.Bottom: = ARect.Bottom; mySrect.Left: = ARect.Left; mySrect.Right: = ARect.Right; mySrect.Top:=ARect.Top; mySrect.Bottom: = ARect.Bottom; hvis ikke ((Sender som TMenuItem) .Parent.Name = ''), og start ACanvas.Brush.Color: = FStripColor; ACanvas.FillRect (myBaseR); hvis ikke ((Sender som TMenuItem) .Caption = '-'), og start hvis Valgt deretter begynne ACanvas.Brush.Color: = FSelColor; //clSilver; ACanvas.FillRect (Myrect); ACanvas.Rectangle (mySrect); if (Sender som TMenuItem) .Bitmap < > null da begynne MyBrect.Left: = ARect.Left + 2; MyBrect.Right: = MyBrect.Left + (Sender som TMenuItem) .Bitmap.Width; MyBrect.Top:=ARect.Top+2; MyBrect.Bottom: = ARect.Top + (Sender som TMenuItem) .Bitmap.Height; ACanvas.Brush.Color: = FStripColor; ACanvas.FillRect (MyBrect); //Hvis (Sender som TMenuItem) .ImageIndex > -1 deretter //begynne //(ParentMenu som TMainMenu) .Images.GetBitmap ((Sender som TMenuItem) .ImageIndex, (Sender som TMenuItem) .Bitmap); //End; Hvis (Sender som TMenuItem) .ImageIndex > -1 deretter begynne if (ParentMenu er TMainMenu), og start om ikke ((ParentMenu som TMainMenu) .images = null) da (ParentMenu som TMainMenu) .Images.GetBitmap ((Sender som TMenuItem) .ImageIndex, BitMp); ende annet begynne hvis ikke ((ParentMenu som TPopupMenu) .images = null) da (ParentMenu som TPopupMenu) .Images.GetBitmap ((Sender som TMenuItem) .ImageIndex, BitMp); slutt; ACanvas.Draw (mySrect.left + 2, arect.top + 2, BitMp); ende annet ACanvas.Draw (mySrect.left, mySrect.top, (Sender som TMenuItem) .Bitmap); ACanvas.Brush.Color: = FSelColor; //clSilver; slutt; ende ellers begynner ACanvas.Brush.Color: = FBackColor; ACanvas.FillRect (Myrect); Hvis (Sender som TMenuItem) .ImageIndex > -1 deretter begynne if (ParentMenu er TMainMenu), og start om ikke ((ParentMenu som TMainMenu) .images = null) da (ParentMenu som TMainMenu) .Images.GetBitmap ((Sender som TMenuItem) .ImageIndex, BitMp); //(ParentMenu som TMainMenu) .Images.GetBitmap ((Sender som TMenuItem) .ImageIndex, (Sender som TMenuItem) .Bitmap); ende annet begynne hvis ikke ((ParentMenu som TPopupMenu) .images = null) da (ParentMenu som TPopupMenu) .Images.GetBitmap ((Sender som TMenuItem) .ImageIndex, BitMp); //(ParentMenu som TPopupMenu) .Images.GetBitmap ( (Sender som TMenuItem) .ImageIndex, (Sender som TMenuItem) .Bitmap); slutt; ACanvas.Draw (mySrect.left + 2, arect.top + 2, BitMp); ende annet ACanvas.Draw (mySrect.left + 2, arect.top + 2, (Sender som TMenuItem) .Bitmap); slutt; Myrect.left: = Myrect.left + 4; myrect.top:=myrect.top+1; flagg: = DT_EXPANDTABS {eller DT_SINGLELINE eller DT_CALCRECT} eller DT_NOCLIP eller justeringer [Justering]; Hvis Valgt deretter begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font.Color: = FSelFontColor; DrawText (ACanvas.Handle, pchar ((Sender som TMenuItem) .Caption), lengde ((Sender som TMenuItem) .Caption), Myrect, Flags); ende annet begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font.Color: = FNotSelFontColor; DrawText (ACanvas.Handle, pchar ((Sender som TMenuItem) .Caption), lengde ((Sender som TMenuItem) .Caption), Myrect, Flags); slutt; hvis ikke (TMenuItem (Sender) .GetParentComponent er TMainMenu) da begynne //OutputDebugString (pchar ()); Myrect.left: = MyRect.right-ACanvas.TextWidth (shortcuttotext ((Sender som TMenuItem) .shortcut)) - 1; Hvis Valgt deretter begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font.Color: = FSelFontColor; DrawText (ACanvas.Handle, pchar (shortcuttotext ((Sender som TMenuItem) .shortcut)), lengde (shortcuttotext ((Sender som TMenuItem) .shortcut)), Myrect, Flagg); ende annet begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font.Color: = FNotSelFontColor; DrawText (ACanvas.Handle, pchar (shortcuttotext ((Sender som TMenuItem) .shortcut)), lengde (shortcuttotext ((Sender som TMenuItem) .shortcut)), Myrect, Flagg); slutt; slutt; //ACanvas.TextOut(Myrect.Left+4,arect.top+1,(Sender Som TMenuItem) .Caption); //+ shortcuttotext ((Sender som TMenuItem) .shortcut)); ende ellers begynner ACanvas.Brush.Color: = FBackColor; ACanvas.FillRect (Myrect); myrect.top:=myrect.top+1; myrect.bottom: = myrect.top + 1; myrect.Left: = myrect.Left + 12; ACanvas.Brush.Color: = FStripColor; ACanvas.FillRect (Myrect); slutt; slutt; BitMp.free; end; prosedyre TXpMenu.DefMenuMeasureItem (Sender: TObject; ACanvas: TCanvas; Var Bredde, Høyde: Integer), begynner bredde: = bredde + FStripWidth; if (ikke (shortcuttotext ((Sender som TMenuItem) .ShortCut) = '')) eller (TMenuItem (Sender) .GetParentComponent er TPopupMenu) så bredde: = bredde + ACanvas.TextWidth (shortcuttotext ((Sender som TMenuItem) .shortcut) ); end; prosedyre TXpMenu.DefMenuAdvancedDrawItem (Sender: TObject; ACanvas: TCanvas; ARect: TRect; stat: TOwnerDrawState); konst cHotkeyPrefix = "& '; Justeringer: array [TPopupAlignment] Word = (DT_LEFT, DT_RIGHT, DT_CENTER); Var myBaseR: TRect; myrect: TRect; myBRect: TRect; mySrect: TRect; valgt: boolean; NotEnabled: boolean; pl: Array [0..3] av tpoint; ParentMenu: TMenu; Flags: integer; Justering: TPopupAlignment, begynner ParentMenu: = TMenuItem (Sender) .GetParentMenu; hvis ParentMenu er TMenu deretter Alignment: = paLeft annet hvis ParentMenu er TPopupMenu deretter Alignment: = TPopupMenu (ParentMenu) .Alignment annet Alignment: = paLeft; Valgt: = odSelected i stat; NotEnabled: = odDisabled i stat; myBaseR.Left: = ARect.Left; myBaseR.Right: = myBaseR.Left + FStripWidth; myBaseR.Top:=ARect.Top; myBaseR.Bottom: = ARect.Bottom; Myrect.Left: = ARect.Left + FStripWidth; Myrect.Right: = ARect.Right; Myrect.Top:=ARect.Top; Myrect.Bottom: = ARect.Bottom; mySrect.Left: = ARect.Left; mySrect.Right: = ARect.Right; mySrect.Top:=ARect.Top; mySrect.Bottom: = ARect.Bottom; pl [0] .x: = mySRect.Left; pl [0] .Y: = mySRect.Bottom; pl [1]: = mySRect.TopLeft; pl [2] .x: = mySRect.Right; pl [2] .Y: = mySRect.Top; pl [3]: = mySRect.BottomRight; ACanvas.Brush.Color: = FStripColor; if (TMenuItem (Sender) .GetParentComponent er TPopupMenu) så ACanvas.FillRect (myBaseR); hvis ikke ((Sender som TMenuItem) .Caption = '-'), og start if ((Sender som TMenuItem) .Parent.Name = ''), og start hvis Valgt deretter begynne if (TMenuItem (Sender) .GetParentComponent er TPopupMenu) da begynne ACanvas.Brush.Color: = FSelColor; //clSilver; ACanvas.FillRect (mySrect); ACanvas.Rectangle (mySrect); if (Sender som TMenuItem) .Bitmap < > null da begynne MyBrect.Left: = ARect.Left + 2; MyBrect.Right: = MyBrect.Left + (Sender som TMenuItem) .Bitmap.Width; MyBrect.Top:=ARect.Top+2; MyBrect.Bottom: = ARect.Top + (Sender som TMenuItem) .Bitmap.Height; ACanvas.Brush.Color: = FStripColor; ACanvas.FillRect (MyBrect); ACanvas.Draw (mySrect.left, mySrect.top, (Sender som TMenuItem) .Bitmap); ACanvas.Brush.Color: = FSelColor; //clSilver; slutt; ende ellers begynner ACanvas.Brush.Color: = FBackColor; ACanvas.FillRect (mySrect); ACanvas.Rectangle (mySrect); slutt; ende annet begynne if (TMenuItem (Sender) .GetParentComponent er TPopupMenu), og start ACanvas.Brush.Color: = FBackColor; ACanvas.FillRect (Myrect); Hvis (Sender som TMenuItem) .ImageIndex > -1 deretter begynne hvis ikke ((ParentMenu som TPopupMenu) .images = null) da (ParentMenu som TPopupMenu) .Images.GetBitmap ((Sender som TMenuItem) .ImageIndex, (Sender som TMenuItem) .Bitmap); slutt; ACanvas.Draw (mySrect.left + 2, arect.top + 2, (Sender som TMenuItem) .Bitmap); ende ellers begynner ACanvas.Brush.Color: = clBtnFace; ACanvas.FillRect (mySrect); hvis odHotLight i State deretter begynne ACanvas.Brush.Color: = FSelColor; //clSilver; ACanvas.FillRect (mySrect); ACanvas.Rectangle (mySrect); slutt; slutt; slutt; mySrect.left: = mySrect.left + 4; mySrect.top:=mySrect.top+1; flagg: = DT_EXPANDTABS {eller DT_SINGLELINE eller DT_CALCRECT} eller DT_NOCLIP eller justeringer [Justering]; hvis ikke (TMenuItem (Sender) .GetParentComponent er TPopupMenu), og start hvis Valgt deretter begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font.Color: = FSelFontColor; DrawText (ACanvas.Handle, pchar ((Sender som TMenuItem) .Caption), lengde ((Sender som TMenuItem) .Caption), mySrect, Flags) ender annet begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font Color: = FNotSelFontColor; DrawText (ACanvas.Handle, pchar ((Sender som TMenuItem) .Caption), lengde ((Sender som TMenuItem) .Caption), mySrect, Flags) end; ende ellers begynner myrect.left: = myrect.left + 4; myrect.top:=myrect.top+1; Hvis Valgt deretter begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font.Color: = FSelFontColor; DrawText (ACanvas.Handle, pchar ((Sender som TMenuItem) .Caption), lengde ((Sender som TMenuItem) .Caption), myrect, Flags); ende annet begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font.Color: = FNotSelFontColor; DrawText (ACanvas.Handle, pchar ((Sender som TMenuItem) .Caption), lengde ((Sender som TMenuItem) .Caption), myrect, Flags); slutt; Myrect.left: = MyRect.right-ACanvas.TextWidth (shortcuttotext ((Sender som TMenuItem) .shortcut)) - 1; Hvis Valgt deretter begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font.Color: = FSelFontColor; DrawText (ACanvas.Handle, pchar (shortcuttotext ((Sender som TMenuItem) .shortcut)), lengde (shortcuttotext ((Sender som TMenuItem) .shortcut)), Myrect, Flagg); ende annet begynne hvis NotEnabled deretter ACanvas.Font.Color: = FNotActiveColor annet ACanvas.Font.Color: = FNotSelFontColor; DrawText (ACanvas.Handle, pchar (shortcuttotext ((Sender som TMenuItem) .shortcut)), lengde (shortcuttotext ((Sender som TMenuItem) .shortcut)), Myrect, Flagg); slutt; slutt; //ACanvas.TextOut(mySrect.Left+4,mySrect.top+1,(Sender Som TMenuItem) .Caption); slutt; ende ellers begynner ACanvas.Brush.Color: = FBackColor; ACanvas.FillRect (Myrect); myrect.top:=myrect.top+1; myrect.bottom: = myrect.top + 1; myrect.Left: = myrect.Left + 12; ACanvas.Brush.Color: = FStripColor; ACanvas.FillRect (Myrect); end, end, Prosedyre TXpMenu.RemoveXPs, Var jeg: Integer; begynne med eieren gjør begynne for i: = 0 til ComponentCount-en ikke starter hvis komponenter [i] er TMenuItem da begynne (komponenter [i] som TMenuItem) .OnDrawItem: = null; (Komponenter [i] som TMenuItem) .OnMeasureItem: = null; (Komponenter [i] som TMenuItem) .OnAdvancedDrawItem: = null; slutt; slutt; end, end, Prosedyre TXpMenu.Execute, Var jeg: Integer; begynne med eieren gjør begynne for i: = 0 til ComponentCount-en ikke starter hvis komponenter [i] er TMenuItem da begynne (komponenter [i] som TMenuItem) .OnDrawItem: = Self.DefMenuDrawItem; (Komponenter [i] som TMenuItem) .OnMeasureItem: = Self.DefMenuMeasureItem; (Komponenter [i] som TMenuItem) .OnAdvancedDrawItem: = Self.DefMenuAdvancedDrawItem; slutt; slutt; end, end, prosedyre Register, begynner RegisterComponents ( 'VNPVcls', [TXpMenu]); end;. slutten