unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  Menus, ImgList, StdCtrls, ExtCtrls; 
 
type 
  TForm1 = class(TForm) 
    ImageList1: TImageList; 
    PopupMenu1: TPopupMenu; 
    Menupunkt1: TMenuItem; 
    MenuPunkt2: TMenuItem; 
    MenuPunkt3: TMenuItem; 
    MenuPunkt4: TMenuItem; 
    procedure FormCreate(Sender: TObject); 
    procedure Menupunkt1MeasureItem(Sender: TObject; ACanvas: TCanvas; 
      var Width, Height: Integer); 
    procedure Menupunkt1DrawItem(Sender: TObject; ACanvas: TCanvas; 
      ARect: TRect; Selected: Boolean); 
    procedure MenuPunkt2DrawItem(Sender: TObject; ACanvas: TCanvas; 
      ARect: TRect; Selected: Boolean); 
    procedure MenuPunkt3DrawItem(Sender: TObject; ACanvas: TCanvas; 
      ARect: TRect; Selected: Boolean); 
    procedure MenuPunkt4DrawItem(Sender: TObject; ACanvas: TCanvas; 
      ARect: TRect; Selected: Boolean); 
  private 
    procedure ZeichneBanner(ACanvas: TCanvas); 
    procedure ZeichneItem(Sender: TMenuItem; ACanvas: TCanvas; 
      ARect: TRect; Selected: Boolean; Farbe: TColor; FStyle: TFontstyles); 
  public 
    { Public-Deklarationen } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
var 
  ItemHoehe, GesamtHoehe, Links, SchriftAnfang, BannerBreite, Rand: integer; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  x: integer; 
begin 
  PopupMenu1.OwnerDraw := true; 
  Rand := 2; 
  BannerBreite := 20; 
  Links := BannerBreite + Rand; 
  ItemHoehe := Imagelist1.height + Rand * 2; 
  SchriftAnfang := Links + ImageList1.width + Rand * 4; 
  GesamtHoehe := PopupMenu1.Items.count * ItemHoehe; 
  for x := 0 to PopupMenu1.Items.Count - 1 do begin 
    PopupMenu1.Items[x].OnMeasureItem := Menupunkt1MeasureItem; 
    PopupMenu1.Items[x].Imageindex := x; 
  end; 
end; 
 
procedure TForm1.Menupunkt1MeasureItem(Sender: TObject; ACanvas: TCanvas; 
  var Width, Height: Integer); 
begin 
  width := 100; 
  height := ItemHoehe; 
end; 
 
procedure TForm1.ZeichneItem(Sender: TMenuItem; ACanvas: TCanvas; 
  ARect: TRect; Selected: Boolean; Farbe: TColor; FStyle: TFontstyles); 
begin 
  if Selected then ACanvas.Brush.Color := $FFBFF0 
  else ACanvas.Brush.Color := $EEEEFF; 
  ARect.Left := BannerBreite; 
  ACanvas.FillRect(ARect); 
  ACanvas.Font.Color := Farbe; 
  ACanvas.Font.Style := FStyle; 
  ARect.Left := SchriftAnfang; 
  DrawText(ACanvas.Handle, PChar(Sender.Caption), -1, ARect, 
    DT_LEFT or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP); 
  ARect.Left := Links; 
  ACanvas.Brush.Color := Farbe; 
  ACanvas.Pen.Style := psClear; 
  ACanvas.Rectangle(ARect.Left, ARect.Top, 
    SchriftAnfang - Rand * 2, ARect.Bottom); 
  ImageList1.Draw(ACanvas, Links + rand, ARect.Top + Rand, Sender.ImageIndex); 
end; 
 
procedure TForm1.Menupunkt1DrawItem(Sender: TObject; ACanvas: TCanvas; 
  ARect: TRect; Selected: Boolean); 
begin 
  ZeichneItem(TMenuItem(Sender), ACanvas, ARect, Selected, clBlue, [fsItalic]); 
end; 
 
procedure TForm1.MenuPunkt2DrawItem(Sender: TObject; ACanvas: TCanvas; 
  ARect: TRect; Selected: Boolean); 
begin 
  ZeichneItem(TMenuItem(Sender), ACanvas, ARect, Selected, clRed, []); 
end; 
 
procedure TForm1.MenuPunkt3DrawItem(Sender: TObject; ACanvas: TCanvas; 
  ARect: TRect; Selected: Boolean); 
begin 
  ZeichneItem(TMenuItem(Sender), ACanvas, ARect, Selected, clGreen, [fsBold]); 
end; 
 
procedure TForm1.MenuPunkt4DrawItem(Sender: TObject; ACanvas: TCanvas; 
  ARect: TRect; Selected: Boolean); 
begin 
  ZeichneItem(TMenuItem(Sender), ACanvas, ARect, Selected, clMaroon, 
    [fsUnderline]); 
  ZeichneBanner(ACanvas); 
end; 
 
procedure TForm1.ZeichneBanner(ACanvas: TCanvas); 
var 
  Logfont: TLogFont; 
  s: string; 
  sz: TSize; 
begin 
  s := 'DBR - Delphi'; 
  with ACanvas do begin 
    Brush.Color := clBlack; 
    FillRect(Rect(0, 0, BannerBreite, GesamtHoehe)); 
    Font.Name := 'Arial'; 
    Font.Size := 8; 
    Font.Style := [fsBold]; 
    Font.Color := clWhite; 
    GetObject(Font.Handle, sizeof(Logfont), @Logfont); 
    Logfont.lfEscapement := 900; 
    Font.Handle := CreateFontIndirect(Logfont); 
    sz := TextExtent(s); 
    TextOut((bannerbreite - sz.cy) shr 1, 
      Gesamthoehe - (GesamtHoehe - sz.cx) shr 1, s); 
  end; 
end; 
 
end.