画一个象windows 开始菜单的竖向标题

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;