// Items eines TMainMenu werden selbst gestaltet. Dazu wird durch Doppelklick
// im Objektinspektor für ein Item das Event "DrawItem" erzeugt und für alle
// anderen Items übernommen. Siehe auch:
Popup Menüs selbst gestalten


// Getestet mit D4 unter XP

uses Menus; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  MainMenu1.OwnerDraw := true; 
end; 
 
procedure TForm1.NotEnabled1DrawItem(Sender: TObject; ACanvas: TCanvas; 
  ARect: TRect; Selected: Boolean); 
var txt: string; 
begin 
  txt := (Sender as TMenuItem).Caption; 
  if (Sender as TMenuItem).shortcut > 0 then 
    txt := txt + '   [' + 
      shortcuttotext((Sender as TMenuItem).shortcut) + ']'; 
  with ACanvas do begin 
    if Selected then begin 
      if (Sender as TMenuItem).Enabled then begin 
        Brush.Color := clGreen; 
        Font.Color := clYellow; 
        Font.Style := [fsBold]; 
      end else begin 
        Brush.Color := clSilver; 
        Font.Color := clWhite; 
        Font.Style := []; 
      end; 
    end else begin 
      if (Sender as TMenuItem).Enabled then begin 
        Brush.Color := $80E0FF; 
        Font.Color := clBlack; 
      end else begin 
        Brush.Color := clSilver; 
        Font.Color := clWhite; 
      end; 
      Font.Style := []; 
    end; 
    FillRect(ARect); 
    inc(ARect.left, 20); 
    DrawText(handle, PChar(txt), -1, Arect, 
      DT_SingleLine or DT_VCenter); 
    if (Sender as TMenuItem).checked 
      then begin 
      brush.color := clblack; 
      ellipse(Arect.left - 15, ARect.top + 6, ARect.left - 6, ARect.top + 15); 
      if (Sender as TMenuItem).RadioItem 
        then brush.color := $FF8020 
      else brush.color := $2080FF; 
      pen.color := brush.color; 
      ellipse(Arect.left - 16, ARect.top + 5, ARect.left - 7, ARect.top + 14); 
    end; 
  end; 
end; 
 
procedure TForm1.NotEnabled1MeasureItem(Sender: TObject; ACanvas: TCanvas; 
  var Width, Height: Integer); 
begin 
  width := 170; 
  height := 20; 
end; 
 
procedure TForm1.CheckTest1Click(Sender: TObject); 
begin 
  (Sender as TMenuItem).checked := not (Sender as TMenuItem).checked; 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke