Einzelnen Beitrag anzeigen

Volker Z.

Registriert seit: 4. Dez 2012
Ort: Augsburg, Bayern, Süddeutschland
419 Beiträge
 
Delphi XE4 Ultimate
 
#2

AW: MenuItem selektieren

  Alt 4. Aug 2013, 23:23
Hallo,

suchst Du vielleicht etwas in der Art (TButton und TPopupMenu auf das Formular legen und ein paar Menüeinträge anlegen):
Delphi-Quellcode:
interface

type
  TForm1 = class(TForm)
    [...]
    procedure Button1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    FSelected : TMenuItem;
    procedure OnItemClick (Sender : TObject);
    procedure OnItemDraw (Sender : TObject; ACanvas : TCanvas; ARect : TRect; Selected : Boolean);
  public
    { Public-Deklarationen }
  end;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  p : TPoint;
begin
  p := ClientToScreen (Point (Button1.Left + 1, Button1.Top + Button1.Height));
  PopupMenu1.Popup (p.X, p.Y)
end;

procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  m : TMenuItem;
begin
  m := PopupMenu1.Items.Find (Button1.Caption);
  if Assigned (m) then
    begin
      if FSelected = m then
        Exit;

      m.OnDrawItem := OnItemDraw;

      if Assigned (FSelected) then
        FSelected.OnDrawItem := nil;

      FSelected := m
    end
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  PopupMenu1.OwnerDraw := True;
  for i := 0 to PopupMenu1.Items.Count - 1 do
    PopupMenu1.Items [i].OnClick := OnItemClick;

  FSelected := nil
end;

procedure TForm1.OnItemClick (Sender : TObject);
begin
  if not (Sender is TMenuItem) then
    Exit;

  Button1.Caption := (Sender as TMenuItem).Caption
end;

procedure TForm1.OnItemDraw (Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean);
var
  m : TMenuItem;
begin
  if not (Sender is TMenuItem) then
    Exit;

  m := (Sender as TMenuItem);
  try
    m.OnDrawItem := nil;
    DrawMenuItem (m, ACanvas, ARect, [odSelected, odFocused, odNoAccel])
  finally
    m.OnDrawItem := OnItemDraw
  end
end;
Gruß
Volker Zeller
  Mit Zitat antworten Zitat