Mega Code Archive
Give your menus a [customisable] new look with this component
<![CDATA[
Create a new look for your menus with this VCL.
Set the Ownerdraw property of the Menu you wish to change to true, and call the Execute method.
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).Bitmap<>nil 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).Bitmap<>nil 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.
]]>