Title: Give your menus a (customisable) new look with this component.
Question: Bored with the standard Delphi menus? try the XPMenu addition. Just place the component allongside your menus, enable Ownerdraw property on every menu you wish to take the look you want, and call the XPMenu Execute method.
Answer:
unit XpMenu;
interface
uses
Windows, Classes, Graphics, Menus;
type
TXpMenu = class(TComponent)
private
{ Private declarations }
FSelColor:TColor;
FStripColor:TColor;
FBackColor:TColor;
FStripWidth:integer;
FSelFontColor:TColor;
FNotSelFontColor:TColor;
FNotActiveColor:TColor;
protected
{ Protected declarations }
public
{ Public declarations }
Procedure Execute;
Procedure RemoveXPs;
Constructor Create(AOwner:TComponent);override;
published
{ Published declarations }
procedure DefMenuDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
procedure DefMenuMeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure DefMenuAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
property SelectionColor:TColor read FSelColor write FSelColor;
property SelectionFontColor: TColor read FSelFontColor write FSelFontColor;
property NotSelectedFontColor: TColor read FNotSelFontColor write FNotSelFontColor;
property NotActiveColor: TColor read FNotActiveColor write FNotActiveColor;
property StripColor:TColor read FStripColor write FStripColor;
property BackColor:TColor read FBackColor write FBackColor;
property StripWidth:integer read FStripWidth write FStripWidth;
end;
procedure Register;
implementation
constructor TXpMenu.Create(AOwner:TComponent);
begin
inherited Create(AOwner);
FSelFontColor:=clWhite;
FSelColor:=$00FEC0D0;
FStripColor:=clGray;
FBackColor:=clWhite;
FNotSelFontColor:=clBlack;
FNotActiveColor:=clGray;
FStripWidth:=20;
end;
procedure TXpMenu.DefMenuDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
const
cHotkeyPrefix='&';
Alignments: array[TPopupAlignment] of 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;
Alignment: TPopupAlignment;
BitMp:TBitmap;
begin
BitMp:=TBitmap.Create;
ParentMenu := TMenuItem(Sender).GetParentMenu;
NotEnabled:= TMenuItem(Sender).Enabled = false;
//outputdebugstring(pchar(string(ParentMenu.ClassName)));
if ParentMenu is TMenu then
Alignment := paLeft
else if ParentMenu is TPopupMenu then
Alignment := TPopupMenu(ParentMenu).Alignment
else
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;
if not ((Sender as TMenuItem).Parent.Name='') then
begin
ACanvas.Brush.Color:=FStripColor;
ACanvas.FillRect(myBaseR);
if not ((Sender as TMenuItem).Caption='-') then
begin
if Selected then
begin
ACanvas.Brush.Color:=FSelColor;//clSilver;
ACanvas.FillRect(Myrect);
ACanvas.Rectangle(mySrect);
if (Sender as TMenuItem).Bitmapnil then
begin
MyBrect.Left:=ARect.Left+2;
MyBrect.Right:=MyBrect.Left+(Sender as TMenuItem).Bitmap.Width;
MyBrect.Top:=ARect.Top+2;
MyBrect.Bottom:=ARect.Top+(Sender as TMenuItem).Bitmap.Height;
ACanvas.Brush.Color:=FStripColor;
ACanvas.FillRect(MyBrect);
//If (Sender as TMenuItem).ImageIndex-1 then
// begin
// (ParentMenu as TMainMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,(Sender as TMenuItem).Bitmap);
// end;
If (Sender as TMenuItem).ImageIndex-1 then
begin
if (ParentMenu is TMainMenu) then
begin
if not ((ParentMenu as TMainMenu).Images=nil) then
(ParentMenu as TMainMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,BitMp);
end
else
begin
if not ((ParentMenu as TPopupMenu).Images=nil) then
(ParentMenu as TPopupMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,BitMp);
end;
ACanvas.Draw(mySrect.left+2,arect.top+2,BitMp);
end
else
ACanvas.Draw(mySrect.left,mySrect.top,(Sender as TMenuItem).Bitmap);
ACanvas.Brush.Color:=FSelColor;//clSilver;
end;
end
else
begin
ACanvas.Brush.Color:=FBackColor;
ACanvas.FillRect(Myrect);
If (Sender as TMenuItem).ImageIndex-1 then
begin
if (ParentMenu is TMainMenu) then
begin
if not ((ParentMenu as TMainMenu).Images=nil) then
(ParentMenu as TMainMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,BitMp);
// (ParentMenu as TMainMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,(Sender as TMenuItem).Bitmap);
end
else
begin
if not ((ParentMenu as TPopupMenu).Images=nil) then
(ParentMenu as TPopupMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,BitMp);
// (ParentMenu as TPopupMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,(Sender as TMenuItem).Bitmap);
end;
ACanvas.Draw(mySrect.left+2,arect.top+2,BitMp);
end
else
ACanvas.Draw(mySrect.left+2,arect.top+2,(Sender as TMenuItem).Bitmap);
end;
Myrect.left:=Myrect.left+4;
myrect.top:=myrect.top+1;
flags:=DT_EXPANDTABS {or DT_SINGLELINE or DT_CALCRECT }or DT_NOCLIP or Alignments[Alignment];
if Selected then
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FSelFontColor;
DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),Myrect,Flags);
end
else
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FNotSelFontColor;
DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),Myrect,Flags);
end;
if not (TMenuItem(Sender).GetParentComponent is TMainMenu) then
begin
//outputDebugstring(pchar( ));
Myrect.left:=MyRect.right-ACanvas.TextWidth(shortcuttotext((Sender as TMenuItem).shortcut))-1;
if Selected then
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FSelFontColor;
DrawText(ACanvas.Handle,pchar(shortcuttotext((Sender as TMenuItem).shortcut)),length(shortcuttotext((Sender as TMenuItem).shortcut)),Myrect,Flags);
end
else
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FNotSelFontColor;
DrawText(ACanvas.Handle,pchar(shortcuttotext((Sender as TMenuItem).shortcut)),length(shortcuttotext((Sender as TMenuItem).shortcut)),Myrect,Flags);
end;
end;
//ACanvas.TextOut(Myrect.Left+4,arect.top+1,(Sender as TMenuItem).Caption);//+shortcuttotext((Sender as TMenuItem).shortcut));
end
else
begin
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;
BitMp.free;
end;
procedure TXpMenu.DefMenuMeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
begin
width:=width+FStripWidth;
if (not (shortcuttotext((Sender as TMenuItem).ShortCut)='')) or (TMenuItem(Sender).GetParentComponent is TPopupMenu) then
width:=width+ACanvas.TextWidth(shortcuttotext((Sender as TMenuItem).shortcut));
end;
procedure TXpMenu.DefMenuAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
const
cHotkeyPrefix='&';
Alignments: array[TPopupAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
myBaseR:TRect;
myrect:TRect;
myBRect:TRect;
mySrect:TRect;
selected:boolean;
NotEnabled:boolean;
pl:Array [0..3] of tpoint;
ParentMenu:TMenu;
Flags:integer;
Alignment: TPopupAlignment;
begin
ParentMenu := TMenuItem(Sender).GetParentMenu;
if ParentMenu is TMenu then
Alignment := paLeft
else if ParentMenu is TPopupMenu then
Alignment := TPopupMenu(ParentMenu).Alignment
else
Alignment := paLeft;
Selected := odSelected in State;
NotEnabled:= odDisabled in State;
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 is TPopupMenu) then
ACanvas.FillRect(myBaseR);
if not ((Sender as TMenuItem).Caption='-') then
begin
if ((Sender as TMenuItem).Parent.Name='') then
begin
if Selected then
begin
if (TMenuItem(Sender).GetParentComponent is TPopupMenu) then
begin
ACanvas.Brush.Color:=FSelColor;//clSilver;
ACanvas.FillRect(mySrect);
ACanvas.Rectangle(mySrect);
if (Sender as TMenuItem).Bitmapnil then
begin
MyBrect.Left:=ARect.Left+2;
MyBrect.Right:=MyBrect.Left+(Sender as TMenuItem).Bitmap.Width;
MyBrect.Top:=ARect.Top+2;
MyBrect.Bottom:=ARect.Top+(Sender as TMenuItem).Bitmap.Height;
ACanvas.Brush.Color:=FStripColor;
ACanvas.FillRect(MyBrect);
ACanvas.Draw(mySrect.left,mySrect.top,(Sender as TMenuItem).Bitmap);
ACanvas.Brush.Color:=FSelColor;//clSilver;
end;
end
else
begin
ACanvas.Brush.Color:=FBackColor;
ACanvas.FillRect(mySrect);
ACanvas.Rectangle(mySrect);
end;
end
else
begin
if (TMenuItem(Sender).GetParentComponent is TPopupMenu) then
begin
ACanvas.Brush.Color:=FBackColor;
ACanvas.FillRect(Myrect);
If (Sender as TMenuItem).ImageIndex-1 then
begin
if not ((ParentMenu as TPopupMenu).Images=nil) then
(ParentMenu as TPopupMenu).Images.GetBitmap((Sender as TMenuItem).ImageIndex,(Sender as TMenuItem).Bitmap);
end;
ACanvas.Draw(mySrect.left+2,arect.top+2,(Sender as TMenuItem).Bitmap);
end
else
begin
ACanvas.Brush.Color:=clBtnFace;
ACanvas.FillRect(mySrect);
if odHotLight in State then
begin
ACanvas.Brush.Color:=FSelColor;//clSilver;
ACanvas.FillRect(mySrect);
ACanvas.Rectangle(mySrect);
end;
end;
end;
mySrect.left:=mySrect.left+4;
mySrect.top:=mySrect.top+1;
flags:=DT_EXPANDTABS {or DT_SINGLELINE or DT_CALCRECT }or DT_NOCLIP or Alignments[Alignment];
if not (TMenuItem(Sender).GetParentComponent is TPopupMenu) then
begin
if Selected then
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FSelFontColor;
DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),mySrect,Flags)
end
else
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FNotSelFontColor;
DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),mySrect,Flags)
end;
end
else
begin
myrect.left:=myrect.left+4;
myrect.top:=myrect.top+1;
if Selected then
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FSelFontColor;
DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),myrect,Flags);
end
else
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FNotSelFontColor;
DrawText(ACanvas.Handle,pchar((Sender as TMenuItem).Caption),length((Sender as TMenuItem).Caption),myrect,Flags);
end;
Myrect.left:=MyRect.right-ACanvas.TextWidth(shortcuttotext((Sender as TMenuItem).shortcut))-1;
if Selected then
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FSelFontColor;
DrawText(ACanvas.Handle,pchar(shortcuttotext((Sender as TMenuItem).shortcut)),length(shortcuttotext((Sender as TMenuItem).shortcut)),Myrect,Flags);
end
else
begin
if NotEnabled then
ACanvas.Font.Color:=FNotActiveColor
else
ACanvas.Font.Color:=FNotSelFontColor;
DrawText(ACanvas.Handle,pchar(shortcuttotext((Sender as TMenuItem).shortcut)),length(shortcuttotext((Sender as TMenuItem).shortcut)),Myrect,Flags);
end;
end;
//ACanvas.TextOut(mySrect.Left+4,mySrect.top+1,(Sender as TMenuItem).Caption);
end;
end
else
begin
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;
Procedure TXpMenu.RemoveXPs;
var
i:Integer;
begin
with owner do
begin
for i:=0 to ComponentCount-1 do
begin
if Components[i] is TMenuItem then
begin
(Components[i] as TMenuItem).OnDrawItem:=nil;
(Components[i] as TMenuItem).OnMeasureItem:=nil;
(Components[i] as TMenuItem).OnAdvancedDrawItem:=nil;
end;
end;
end;
end;
Procedure TXpMenu.Execute;
var
i:Integer;
begin
with owner do
begin
for i:=0 to ComponentCount-1 do
begin
if Components[i] is TMenuItem then
begin
(Components[i] as TMenuItem).OnDrawItem:=Self.DefMenuDrawItem;
(Components[i] as TMenuItem).OnMeasureItem:=Self.DefMenuMeasureItem;
(Components[i] as TMenuItem).OnAdvancedDrawItem:=Self.DefMenuAdvancedDrawItem;
end;
end;
end;
end;
procedure Register;
begin
RegisterComponents('VNPVcls', [TXpMenu]);
end;
end.