unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus,Math;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Menu1: TMenuItem;
Menu2: TMenuItem;
procedure Menu1DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
resourcestring
FlowerSoftWareStudio='Flower Software Studio';
FlowerSoftware='Flower Software';
FlowerSoft='FlowerSoft';
Flower='Flower';
implementation
{$R *.dfm}
var
MenuBackground:TBitmap;
MenuOffset:Integer;
blnMenuRefresh:Boolean;
type
TArtRectMode=(armHorizontal,armVertical,armRectangle,armEllipse);
procedure DrawArtRect(ACanvas:TCanvas;ARect:TRect;ColorFrom,ColorTo:TColor;
ArtRectMode:TArtRectMode;Supplement:Integer=100);
var
Bmp:TBitmap;
i,n:Integer;
r1,g1,b1,r2,g2,b2:Integer;
r,g,b:Integer;
dr,dg,db,nr,ng,nb:Extended;
YXScale,f
ouble;
OldColor:TColor;
begin
OldColor:=-1;
Bmp:=TBitmap.Create;
with Bmp do
begin
Width:=ARect.Right-ARect.Left;
Height:=ARect.Bottom-ARect.Top;
Canvas.Pen.Color:=clWhite;
Canvas.Brush.Color:=clWhite;
Canvas.Rectangle(0,0,Width,Height);
end;
r1:=GetRValue(ColorFrom);
g1:=GetGValue(ColorFrom);
b1:=GetBValue(ColorFrom);
r2:=GetRValue(ColorTo);
g2:=GetGValue(ColorTo);
b2:=GetBValue(ColorTo);
case ArtRectMode of
armHorizontal:
begin
dr:=(r2-r1)/Bmp.Width;
dg:=(g2-g1)/Bmp.Width;
db:=(b2-b1)/Bmp.Width;
nr:=r1;
ng:=g1;
nb:=b1;
with Bmp.Canvas do
begin
for i:=0 to Bmp.Width do
begin
r:=Trunc(nr);
g:=Trunc(ng);
b:=Trunc(nb);
// r:=Trunc(r1+(r2-r1)/Bmp.Width*i);
// g:=Trunc(g1+(g2-g1)/Bmp.Width*i);
// b:=Trunc(b1+(b2-b1)/Bmp.Width*i);
Pen.Color:=RGB(r,g,b);
MoveTo(i,0);
LineTo(i,Bmp.Height);
nr:=nr+dr;
ng:=ng+dg;
nb:=nb+db;
end;
end;
end;
armVertical:
begin
dr:=(r2-r1)/Bmp.Height;
dg:=(g2-g1)/Bmp.Height;
db:=(b2-b1)/Bmp.Height;
nr:=r1;
ng:=g1;
nb:=b1;
with Bmp.Canvas do
begin
for i:=0 to Bmp.Height do
begin
r:=Trunc(nr);
g:=Trunc(ng);
b:=Trunc(nb);
Pen.Color:=RGB(r,g,b);
MoveTo(0,i);
LineTo(Bmp.Width,i);
nr:=nr+dr;
ng:=ng+dg;
nb:=nb+db;
end;
end;
end;
armRectangle:
begin
YXScale:=Abs(Supplement/100);
n:=Trunc(Max(Bmp.Height/YXScale,Bmp.Width)/2);
dr:=(r2-r1)/n;
dg:=(g2-g1)/n;
db:=(b2-b1)/n;
nr:=r1;
ng:=g1;
nb:=b1;
with Bmp.Canvas do
begin
Brush.Style:=bsSolid;
Pen.Mode:=pmCopy;
Pen.Style:=psSolid;
for i:=n downto 0 do
begin
r:=Trunc(nr);
g:=Trunc(ng);
b:=Trunc(nb);
Pen.Color:=RGB(r,g,b);
// Brush.Color:=Pen.Color;
Brush.Style:=bsClear;
Rectangle(Bmp.Width div 2 -i,Bmp.Height div 2-Trunc(i*YXScale),
Bmp.Width div 2 +i,Bmp.Height div 2 +Trunc(i*YXScale));
nr:=nr+dr;
ng:=ng+dg;
nb:=nb+db;
end;
end;
end;
end;//case
ACanvas.CopyMode:=cmSrcCopy;
ACanvas.CopyRect(ARect,Bmp.Canvas,Rect(0,0,Bmp.Width,Bmp.Height));
Bmp.Free;
end;
procedure ExtractCaption(ACaption:string;var s1,s2,s3:string);
// s2 is the text of a Hot Key
var
i:Integer;
s:string;
blnFound:Boolean;
begin
s:=ACaption;
s1:='';
s2:='';
s3:='';
blnFound:=False;
while s<>'' do
begin
i:=Pos('&',s);
if i>0 then
begin
blnFound:=True;
s1:=s1+Copy(s,1,i-1);
s:=Copy(s,i+1,Length(s));
if s<>'' then
if s[1]='&' then
begin
s1:=s1+'&';
s:=Copy(s,2,Length(s));
blnFound:=False;
end;
end
else
begin
if blnFound then
begin
s2:=s[1];
s3:=Copy(s,2,Length(s));
end
else
s3:=s;
s:='';
end;
end;
end;
procedure DrawCaption(ACanvas:TCanvas;X,Y:Integer;ACaption:string);
var
s1,s2,s3:string;
OldPen:TPen;
OldBrush:TBrush;
OldFont:TFont;
begin
OldPen:=TPen.Create;
OldBrush:=TBrush.Create;
OldFont:=TFont.Create;
ExtractCaption(ACaption,s1,s2,s3);
with ACanvas do
begin
OldPen.Assign(Pen);
OldBrush.Assign(Brush);
OldFont.Assign(Font);
Pen.Mode:=pmMerge;
Brush.Style:=bsClear;
TextOut(X,Y,s1);
Font.Style:=Font.Style+[fsUnderline];
TextOut(PenPos.X,PenPos.Y,s2);
Font.Assign(OldFont);
TextOut(PenPos.X,PenPos.Y,s3);
Pen.Assign(OldPen);
Brush.Assign(OldBrush);
end;
OldPen.Free;
OldBrush.Free;
OldFont.Free;
end;
procedure DrawArtText(ACanvas:TCanvas;X,Y:Integer;ColorFrom,ColorTo:TColor;
Text:string);
var
SrcBmp,BackBmp:TBitmap;
h,w:Integer;
SrcRect:TRect;
begin
SrcBmp:=TBitmap.Create;
BackBmp:=TBitmap.Create;
h:=ACanvas.TextHeight(Text);
w:=ACanvas.TextWidth(Text);
with SrcRect do
begin
Left:=0;
Top:=0;
Right:=w;
Bottom:=h;
end;
with SrcBmp do
begin
Width:=w;
Height:=h;
end;
with BackBmp do
begin
Width:=w;
Height:=h;
DrawArtRect(Canvas,SrcRect,ColorFrom,ColorTo,armVertical);
end;
with SrcBmp.Canvas do
begin
Font.Assign(ACanvas.Font);
Font.Color:=clWhite;
Brush.Color:=clBlack;
Pen.Color:=Brush.Color;
Rectangle(SrcRect);
DrawCaption(SrcBmp.Canvas,0,0,Text);
// Mask background
ACanvas.CopyMode:=cmSrcInvert;
ACanvas.CopyRect(Rect(x,y,x+w,y+h),SrcBmp.Canvas,SrcRect);
// Obtain the art text foreground
CopyMode:=cmSrcAnd;
CopyRect(SrcRect,BackBmp.Canvas,SrcRect);
end;
with ACanvas do
begin
// Merge foreground and background
CopyMode:=cmSrcPaint;
COpyRect(Rect(x,y,x+w,y+h),SrcBmp.Canvas,SrcRect);
end;
SrcBmp.Free;
BackBmp.Free;
end;
procedure TForm1.Menu1DrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
var
MenuItem:TMenuItem;
MenuFullRect,MenuItemRect,SrcRect,SelectRect,DestRect:TRect;
SrcBmp:TBitMap;
BlankWidth,LabelWidth,w:Integer;
LabelString:string;
begin
MenuItem:=TMenuItem(Sender);
DestRect:=ARect;
with SrcRect do
begin
Left:=0;
Top:=0;
Right:=ARect.Right-ARect.Left;
Bottom:=ARect.Bottom-ARect.Top;
if MenuItem.MenuIndex=MenuItem.Parent.Count-1 then
begin
Right:=Right+ClientWidth-ARect.Right+MenuOffset;
DestRect.Right:=DestRect.Left+Right-Left;
end;
end;
SelectRect:=SrcRect;
SelectRect.Right:=SelectRect.Left+ARect.Right-ARect.Left;
with MenuFullRect do
begin
Left:=0;
Top:=0;
Right:=ClientWidth;
Bottom:=ARect.Bottom-ARect.Top;
end;
with MenuItemRect do
begin
Left:=DestRect.Left-MenuOffset;
Top:=0;
Right:=Left+DestRect.Right-DestRect.Left;
Bottom:=DestRect.Bottom-DestRect.Top;
end;
SrcBmp:=TBitmap.Create;
with SrcBmp do
begin
Width:=SrcRect.Right-SrcRect.Left;
Height:=SrcRect.Bottom-SrcRect.Top;
end;
if blnMenuRefresh then
begin
with MenuBackground do
begin
Width:=MenuFullRect.Right;
Height:=MenuFullRect.Bottom;
DrawArtRect(Canvas,MenuFullRect,clSkyBlue,clYellow,armHorizontal);
end;
blnMenuRefresh:=False;
end;
with SrcBmp.Canvas do
begin
CopyMode:=cmSrcCopy;
CopyRect(SrcRect,MenuBackground.Canvas,MenuItemRect);
if MenuItem.MenuIndex=MenuItem.Parent.Count-1 then
begin
Font.Size:=10;
Font.Name:='宋体';
Font.Charset:=GB2312_Charset;
LabelString:='';
LabelWidth:=0;
BlankWidth:=SrcRect.Right-SrcRect.Left-SelectRect.Right+SelectRect.Left;
w:=TextWidth(Flower);
if BlankWidth>w+70 then
begin
LabelWidth:=w;
LabelString:=Flower;
end;
w:=TextWidth(FlowerSoft);
if BlankWidth>w+70 then
begin
LabelWidth:=w;
LabelString:=FlowerSoft;
end;
w:=TextWidth(FlowerSoftware);
if BlankWidth>w+70 then
begin
LabelWidth:=w;
LabelString:=FlowerSoftware;
end;
w:=TextWidth(FlowerSoftwareStudio);
if BlankWidth>w+70 then
begin
LabelWidth:=w;
LabelString:=FlowerSoftwareStudio;
end;
if LabelString<>'' then
DrawArtText(SrcBmp.Canvas,SrcRect.Right-LabelWidth-70,0,clRed,clLime,
LabelString);
end;
Font.Size:=9;
Font.Name:='宋体';
Font.Charset:=GB2312_Charset;
Brush.Style:=bsClear;
Pen.Style:=psSolid;
Pen.Mode:=pmCopy;
if MenuItem.Enabled then
begin
if Selected then
begin
Pen.Color:=clRed;
Rectangle(SelectRect);
Font.Color:=clRed;
DrawCaption(SrcBmp.Canvas,SrcRect.Left+8,SrcRect.Top+6,MenuItem.Caption);
end
else
begin
Font.Color:=clRed;
DrawCaption(SrcBmp.Canvas,SrcRect.Left+5,SrcRect.Top+4,MenuItem.Caption);
end;
end
else
begin
Font.Color:=clGray;
DrawCaption(SrcBmp.Canvas,SrcRect.Left+5,SrcRect.Top+4,MenuItem.Caption);
end;
end;
ACanvas.CopyMode:=cmSrcCopy;
ACanvas.CopyRect(DestRect,SrcBmp.Canvas,SrcRect);
SrcBmp.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MenuBackground:=TBitmap.Create;
MenuOffset:=ClientOrigin.X-Left;
blnMenuRefresh:=True;
end;
procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
NewHeight: Integer; var Resize: Boolean);
begin
blnMenuRefresh:=True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
MenuBackground.Free;
end;
end.
属性:
MainMenu1.OwnerDraw:=True
事件:
Menu1.OnDrawItem:=Menu1DrawItem
Menu2.OnDrawItem:=Menu1DrawItem