Registriert seit: 4. Dez 2012
Ort: Augsburg, Bayern, Süddeutschland
419 Beiträge
Delphi XE4 Ultimate
|
AW: MenuItem selektieren
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
|
|
Zitat
|