http://delphi.xcjc.net/viewthread.php?tid=42705
画一个象windows 开始菜单的竖向标题 (cjc)
Reminder : UnitTools, Unit1
// 画一个象windows 开始菜单的竖向标题
procedure DrawBar(ACanvas: TCanvas; const title: string);
var
lf : TLogFont;
tf : TFont;
H, i: Integer;
dy: real;
begin
with ACanvas do begin
H := ClipRect.Bottom;
dy := H / 128;
for i := 0 to 128 do
begin
Brush.Color := RGB(0,0,255-i); //$00000000+i*$10000;
FillRect( Rect(0,round(i*dy), 20, round((i+1)*dy)) );
end;
Font.Name := 'Tahoma';
Font.Style := Font.Style + [fsBold];
Font.Color := clWhite;
tf := TFont.Create;
try
tf.Assign(Font);
GetObject(tf.Handle, sizeof(lf), @lf);
lf.lfEscapement := 900;
lf.lfHeight := Font.Height - 2;
tf.Handle := CreateFontIndirect(lf);
Font.Assign(tf);
finally
tf.Free;
end;
ACanvas.Brush.Style := bsClear;
TextOut(2, H-4, Title);
end;
end;
在子菜单项中,OnDrawItem里加入如下代码:
procedure TForm1.mnTrayCloseDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; Selected: Boolean);
begin
if Selected then begin
ACanvas.Brush.Color := clHighlight;
ACanvas.Font.Color := clWhite;
end
else begin
ACanvas.Brush.Color := clMenu;
ACanvas.Font.Color := clBlack;
end;
ARect.Left := 22;
ACanvas.FillRect(ARect);
if selected then
begin
ACanvas.Brush.Color := clWhite;
ACanvas.FrameRect(ARect);
end;
ARect.Left := 24;
ImageListSheet.Draw(ACanvas,ARect.Left+1,ARect.Top+2,
(Sender as TMenuItem).ImageIndex);
ARect.Left := 24+20;
ACanvas.Brush.Style := bsClear;
ACanvas.TextOut(ARect.Left+3, ARect.Top+2,
(Sender as TMenuItem).Caption);
if ACanvas.ClipRect.Bottom = ARect.Bottom then DrawBar(ACanvas,'Reminder');
end;