Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Dynamisches Menü mit Panels und Collection (https://www.delphipraxis.net/107420-dynamisches-menue-mit-panels-und-collection.html)

Cyberaxx 27. Jan 2008 14:34


Dynamisches Menü mit Panels und Collection
 
Hallo,

Habe ein Problem mit der Erstellung eines Menüs bestehend aus der Verwaltungsklasse, der Collection und den CollectionItems.
Diese bestehen eigentlich nur aus einem TJvPanel.

Von außen kann das aktive CollectionItem gesetzt und geholt werden. Zudem reagieren die Panels auch auf den Klick.
Wenn das erste Item aktiv ist, ich drauf klicke und das Menü klappt es ohne Probleme. Ist aber ein anderes ITem aktiv so bekomme ich eine AV wenn er in die OnClick Methode zurück springt. Das Panel aber nicht mehr existiert, das das Menü ja bereits gelöscht ist.
Das Panel nutze ich damit ich den Rahmen farblich unterlegen kann für das aktive Item.

Delphi-Quellcode:
unit menu_class;

interface

uses
  Classes, Defines, Windows, SysUtils, Controls, Graphics, JvPanel;

type
  TButtonStyle = (etButton, etSeperator, etText);

type
  TMenuEntry = class(TCollectionItem)
  private
    FPanel: TJvPanel;
    FButtonStyle: TButtonStyle;
  public
    destructor Destroy(); override;
    property Button: TJvPanel read FPanel write FPanel;
    property ButtonStyle: TButtonStyle read FButtonStyle write FButtonStyle;
  end;

type
  TMenuEntries = class(TCollection)
  private
    function GetEntry(Index: Integer): TMenuEntry;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(AOwner: TWinControl): TMenuEntry;
    procedure Del(Index: Integer);
    property MenuEntry[Index: Integer]: TMenuEntry read GetEntry;
  end;

type
  TMenuManager = class(TObject)
  private
    FOwner: TWinControl;
    FXPos: Integer;
    FYPos: Integer;
    FTempYPos: Integer;
    FMenuEntries: TMenuEntries;
    FActiveButton: Integer;
    FItemClick: TNotifyEvent;
    function GetAcctiveButton: Integer;
    procedure SetActiveButton(const Value: Integer);
    procedure OnClick(Sender: TObject);
  public
    constructor Create(AOwner: TWinControl; XPos, YPos: Integer);
    destructor Destroy; override;
    procedure AddButton(Caption: String; ButtonStyle: TButtonStyle = etButton);
    procedure RemoveButton(Index: Integer);
    procedure ClearButtons;
    function Count: Integer;
    property ButtonActive: Integer read GetAcctiveButton write SetActiveButton;
    property OnItemClick: TNotifyEvent read FItemClick write FItemClick;
  end;

implementation

{ TMenuManager }

procedure TMenuManager.AddButton(Caption: String;
  ButtonStyle: TButtonStyle);
  var
    AMenuEntry: TMenuEntry;
begin
  Self.FTempYPos := Self.FMenuEntries.Count * 40 + Self.FYPos;

  AMenuEntry := Self.FMenuEntries.Add(Self.FOwner);
  AMenuEntry.FPanel.DoubleBuffered := True;
  AMenuEntry.FPanel.Left := Self.FXPos;
  AMenuEntry.FPanel.Top := Self.FTempYPos;
  AMenuEntry.FPanel.Height := 33;
  AMenuEntry.FPanel.Width := 233;
  AMenuEntry.FPanel.Transparent := True;
  AMenuEntry.FPanel.BevelInner := bvNone;
  AMenuEntry.FPanel.BevelOuter := bvNone;
  AMenuEntry.FPanel.Color := clGray;
  AMenuEntry.FPanel.Alignment := taLeftJustify;
  AMenuEntry.FPanel.Caption := Caption;
  AMenuEntry.FPanel.Font.Color := clBlack;
  AMenuEntry.FPanel.Font.Size := 24;
  AMenuEntry.FPanel.Font.Style := [fsBold];

  if ButtonStyle = etSeperator then
    AMenuEntry.FPanel.BorderWidth := 0
      else AMenuEntry.FPanel.BorderWidth := 1;

  AMenuEntry.FPanel.Parent := FOwner;
  AMenuEntry.FPanel.OnClick := Self.OnClick;
  AMenuEntry.FPanel.Tag := AMenuEntry.Index;

  AMenuEntry.FButtonStyle := ButtonStyle;
end;

procedure TMenuManager.ClearButtons;
begin
  while Self.FMenuEntries.Count > 0 do begin
    Self.FMenuEntries.Del(Self.FMenuEntries.Count -1);
    end;
end;

function TMenuManager.Count: Integer;
begin
  Result := Self.FMenuEntries.Count;
end;

constructor TMenuManager.Create(AOwner: TWinControl; XPos, YPos: Integer);
begin
  inherited Create;

  Self.FOwner := AOwner;
  Self.FXPos := XPos;
  Self.FYPos := YPos;
  Self.FTempYPos := Self.FYPos;
  Self.FActiveButton := -1;

  Self.FMenuEntries := TMenuEntries.Create;
end;

destructor TMenuManager.Destroy;
begin
  Self.ClearButtons;
  Self.FMenuEntries.Destroy;

  inherited Destroy;
end;

function TMenuManager.GetAcctiveButton: Integer;
begin
  Result := Self.FActiveButton;
end;

procedure TMenuManager.OnClick(Sender: TObject);
begin
  if Assigned(FItemClick) then begin
    if Sender is TJvPanel then begin
      Self.SetActiveButton(TJvPanel(Sender).Tag);
      //Self.FActiveButton := TJvPanel(Sender).Tag;
      OnItemClick(Self);
      // <-- panel existiert nicht mehr
      end;
    end;  // hier error!!!!!!!!!!!!!!!!!
end;

procedure TMenuManager.RemoveButton(Index: Integer);
begin
  Self.FMenuEntries.Del(Index);
end;

procedure TMenuManager.SetActiveButton(const Value: Integer);
  var
    AMenuEntry: TMenuEntry;
begin
  if Value = -1 then
    Exit;
   
  AMenuEntry := Self.FMenuEntries.MenuEntry[Value];

  if (AMenuEntry <> nil) and (Value <> Self.FActiveButton) then begin
    if AMenuEntry.ButtonStyle = etButton then begin
      AMenuEntry.FPanel.Color := clYellow;
      if Self.FActiveButton > -1 then
        Self.FMenuEntries.MenuEntry[Self.FActiveButton].FPanel.Color := clGray;
      Self.FActiveButton := Value;
      end;
    end;
end;

{ TMenuEntries }

function TMenuEntries.Add(AOwner: TWinControl): TMenuEntry;
begin
  Result := inherited Add as TMenuEntry;

  Result.FPanel := TJvPanel.Create(AOwner);
  Result.FPanel.Parent := AOwner;
end;

constructor TMenuEntries.Create;
begin
  inherited Create(TMenuEntry);

end;

procedure TMenuEntries.Del(Index: Integer);
begin
  Self.GetEntry(Index).Free;
end;

destructor TMenuEntries.Destroy;
begin

  inherited Destroy;
end;

function TMenuEntries.GetEntry(Index: Integer): TMenuEntry;
begin
  Result := inherited Items[Index] as TMenuEntry;
end;

{ TMenuEntry }

destructor TMenuEntry.Destroy;
begin
  Self.FPanel.SetFocus;
  Self.FPanel.Free;

  inherited Destroy;
end;

end.
Meine Main Klasse

Delphi-Quellcode:
type
  TMain_Frm = class(TForm)
    procedure MenuManagerClick(Sender: TObject);
  private
    FMenuManager: TMenuManager;
    procedure CenterLoadCore;
    procedure SelectPressed;
  public
    { Public declarations }
  end;

implementation

procedure TMain_Frm.CenterLoadCore;
  var
    XPos: Integer;
    YPos: Integer;
begin
  // Menü erstellen und Position festlegen
  XPos := Trunc(Screen.Width / 14);
  YPos := Trunc(Screen.Height / 5);
  FMenuManager := TMenuManager.Create(Self, XPos, YPos);
  FMenuManager.OnItemClick := Self.MenuManagerClick;

  Self.FMenuManager.AddButton('Musik');
  Self.FMenuManager.AddButton('DVD');
  Self.FMenuManager.AddButton('Video');
  Self.FMenuManager.AddButton('Audio - Radio');
  Self.FMenuManager.AddButton('Video - Radio');
  Self.FMenuManager.AddButton('Playlisten');
  Self.FMenuManager.AddButton('Module');
  Self.FMenuManager.AddButton('Beenden');
  Self.FMenuManager.ButtonActive := 0;
end;

procedure TMain_Frm.MenuManagerClick(Sender: TObject);
begin
  Self.SelectPressed;
end;

procedure TMain_Frm.SelectPressed;
  var
    I: Integer;
begin
  Self.JvLabel1.Caption := Format('Entry: %d', [Self.FMenuManager.ButtonActive]);
  Self.FMenuManager.RemoveButton(Self.FMenuManager.ButtonActive);
  Self.FMenuManager.ClearButtons;
end;
Falls jemand hierfür eine Lösung findet oder vllt einen besseren Vorschlag hat würde ich mich freuen diese zu hören :)

Gruß

Cyber

Cyberaxx 29. Jan 2008 06:39

Re: Dynamisches Menü mit Panels und Collection
 
Keiner der mir helfen könnte?

Hab ein wenig rum probiert und durchs suchen bin ich dann auf PostMessage gestossen.
Da mein TObject leider kein Control besitzt klappt dies nicht.
Habe dann einfach mal testweise TWinControl genommen und meine anstatt den Button nun zu löschen sende ich eine Message.
Empfangen wird sie auch von meinem MenuManager.
Wenn ich aber nun meine Main App beende Reagiert es entweder überhaupt nicht mehr oder es kommt mal wieder eine AV, je nachdem ob ich meine MenuManager beende oder nicht.

MenuManager beenden -> Ich kann klicken wohin ich will es tut sich nichts mehr.
MenuManager nicht beenden -> AV beim beenden.

Delphi-Quellcode:
type
  TMenuManager = class(TWinControl)
  private
    FOwner: TWinControl;
    FXPos: Integer;
    FYPos: Integer;
    FTempYPos: Integer;
    FMenuEntries: TMenuEntries;
    FActiveButton: Integer;
    FItemClick: TNotifyEvent;
    FHandle: HWND;
    function GetAcctiveButton: Integer;
    procedure SetActiveButton(const Value: Integer);
    procedure OnClick(Sender: TObject);
  protected
    procedure GetMessage(var Message: TMessage); Message WM_DELBUTTON;
  public
    constructor Create(AOwner: TWinControl; XPos, YPos: Integer);
    destructor Destroy; override;
    procedure AddButton(Caption: String; ButtonStyle: TButtonStyle = etButton);
    procedure RemoveButton(Index: Integer);
    procedure ClearButtons;
    function Count: Integer;
    property ButtonActive: Integer read GetAcctiveButton write SetActiveButton;
    property OnItemClick: TNotifyEvent read FItemClick write FItemClick;
  end;

implementation

constructor TMenuManager.Create(AOwner: TWinControl; XPos, YPos: Integer);
begin
  inherited Create(AOwner);

  Self.Parent := AOwner;
  Self.FOwner := AOwner;
  Self.FXPos := XPos;
  Self.FYPos := YPos;
  Self.FTempYPos := Self.FYPos;
  Self.FActiveButton := -1;

  Self.FMenuEntries := TMenuEntries.Create;
end;

procedure TMenuManager.GetMessage(var Message: TMessage);
begin
    ShowMessage('Message');
end;

procedure TMenuManager.RemoveButton(Index: Integer);
begin
  //Self.FMenuEntries.Del(Index);
  PostMessage(Self.FOwner.Handle, WM_DELBUTTON, Index, 0);
end;
Mir kommt es so vor als würde meine Main App also die Form keine Messages mehr empfangen :/

shmia 29. Jan 2008 15:02

Re: Dynamisches Menü mit Panels und Collection
 
Also ich mag mich jetzt nicht durch deinen ganzen Sourcecode kämpfen, würde dir aber folgenden Tipp geben:
Erstelle auf dem Formular ein ganz "normales Pupupmenue".
Dein Einstieg ist dann:
Delphi-Quellcode:
var
  rootitem : TMenuItem;
begin
  rootitem := PopupMenu1.Items;
Die Klasse TMenuItem hat die Eigenschaft, dass sie baumartige Strukturen (also Menustrukturen) aufbaut.
Deine Aufgabe ist nun, die TMenuItem-Objekte zur Laufzeit auf Panels zu übertragen.
Jedes Panel ist dann mit einem TMenuItem verbunden.
Wenn das Panel geklickt wird, wird im Hintergrund das TMenuItem angeclickt.
Delphi-Quellcode:
var
  item : TMenuItem;
begin
  // Im Sender steckt ein Panel oder JvPanel oder was auch immer
  // die Verbindung wurde zuvor über das Tag Property zum MenuItem hergestellt
  TMenuItem((sender as TPanel).Tag).Click; // Menuaktion auslösen
Nachtrag:
die Sache geht noch einfacher, wenn du eine ActionList und ein leeren Toolbar nimmst.
Zur Laufzeit kann man nun Toolbuttons erzeugen und mit einer TBasicAction aus der ActionList verbinden.

Cyberaxx 29. Jan 2008 16:04

Re: Dynamisches Menü mit Panels und Collection
 
Das mit dem MenuItem ist eigentlich keine so schlechte Idee, jedoch wäre es natürlich auch gut zu wissen warum mein Programm eine AV verursacht oder die Messages ins leere gehen nachdem die Klasse futsch ist, sonst träume ich noch Nachts davon :(


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:51 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz