ein OnHover nachbauen / benutzen

[Cyberaxx]

Wenn ich hier mich noch einmal zu Wort melden darf

Nutze Delphi 7 und das standard Panel besitzt bei mir die Eienschaft MouseLeave nicht.
Dazu kommt, ich wollte es ungerne mit "Fremdkomponenten" realisieren.
Ich schaue mal ob bei mir das Jedi Panel die Eigenschaft besitt.

Vielleicht hat aber das Image und das Label die Eigenschaft, die müsste ich ja benutzen.

Code:

 --------------------------
| Image | Label          |
 --------------------------

Der Rahmen ist das Panel, da wäre es fast einfacher mit einem Timer manuell abzufragen auf welchem Panel sich die Maus befindet, wenn auch sicher nicht die eleganteste Lösung.

Edit: Das Label hat die Eigenscaft aber das Image nicht...

[Sprint]

Zitat von Cyberaxx:

Nutze Delphi 7 und das standard Panel besitzt bei mir die Eienschaft MouseLeave nicht.
Dazu kommt, ich wollte es ungerne mit "Fremdkomponenten" realisieren.

Kannst dein TPanel erweitern, so das die Nachrichten von CM_MOUSELEAVE und CM_MOUSEENTER abgefangen werden.
Das ist nicht besonders kompliziert. Hab dir mal ein Beispiel gemacht. Testen und auswerten muss du es selber.
Hab's nur unter Vista x64 getestet.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TPanel = class(ExtCtrls.TPanel)
  private
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  public
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure PanelOnMouseEnter(Sender: TObject);
    procedure PanelOnMouseLeave(Sender: TObject);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TPanel }

procedure TPanel.CMMouseEnter(var Message: TMessage);
begin
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TPanel.CMMouseLeave(var Message: TMessage);
begin
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  with TPanel.Create(Self) do
  begin
    Parent := Self;
    Visible := True;
    OnMouseEnter := PanelOnMouseEnter;
    OnMouseLeave := PanelOnMouseLeave;
  end;
end;

procedure TForm1.PanelOnMouseEnter(Sender: TObject);
begin
  TPanel(Sender).Color := clRed;
end;

procedure TForm1.PanelOnMouseLeave(Sender: TObject);
begin
  TPanel(Sender).Color := clBlack;;
end;

end.

[Cyberaxx]

Das werde ich mal einsetzen, genau auf diese Messages bin ich vorhin auch gestossen, nachdem ich das mit den Events hier gelesen hatte.

Für die Listen Server/Groups würde es auch alles wunderbar klappen.

Einziger Nachteil wäre bei dem Benutzer, dort existiert auf dem Panel noch ein Image und zwei Labels.
Schade das nicht die übergeordneten Objekte aufgerufen werden. Dadurch das über dem Panel noch weiter Objekte sitzen, werden eben die Events nicht mhr aufgelöst.
Oder gibt es da doch eine Chance anstatt es bei jeder Komponente einzeln umzusetzen?

[Cyberaxx]

Das hat geklappt, die Panels reagieren nun auf die beiden Events.

Im Anhang ist ein Bild welches den Aufbau des Benutzers darstellen soll. Bisher ist alles auf einem Frame, soll später aber auch auf ein Panel.
Dort klappen die beiden Events nicht, da eben dort noch andere Komponenten hängen. Gibt es nicht so etwas wie MousePreview wie bei den Keys?

Wenn ich über einen Timer die abfrage welche Komponente sich dort befindet schlägt es mittels ControlAtPos auch fehl.

[Cyberaxx]

Habe nun eine Lösung gefunden, ist zwar sicher nicht die schönste und eleganteste aber es klappt.
Man sollte zuerst wohl die Absoluten Maus Koordinaten auf die Form umrechnen um mit ControlAtPos zu arbeiten...

In einem Timer hole ich mir die Maus Position, setze sie in Relation zur Form und frage dann solange ControlAtPos ab bis ich das gewünschte Control habe und Prüfe dann den Namen.

Delphi-Quellcode:

procedure TForm1.Timer1Timer(Sender: TObject);

  function GetControl(const c: TControl): TControl;
  var
    c2: TControl;
  begin
    Result:= c;
    c2:= nil;
    repeat
      if Result is TWincontrol then
      begin
        c2:= TWincontrol(Result).ControlAtPos(Result.ScreenToClient(mouse.CursorPos), false, true);

        if c2 is TFrame then begin
          if Pos('Server', TFrame(c2).Name) > 0 then begin
            Result := C2;
            Exit;
          end;
        end;

        if Assigned(c2) then
          Result:= c2;
      end;
    until not Assigned(c2) or not (Result is TWincontrol);
  end;

  var
    Cap: String;
    AControl: TControl;
begin
  AControl := GetControl(Self);
  if Assigned(AControl) then
    Cap := AControl.Name + '@' + AControl.ClassName
      else Cap := 'NONE';

  Label1.Caption := Format('[%d|%d] - [%d|%d] - %s', [Mouse.CursorPos.X, Mouse.CursorPos.Y, APoint.X, APoint.Y, Cap]);
end;

Wie gesagt nicht schön aber sicher selten und es funktioniert, noch...
Bin aber für jeden Verbesserungsvorschlag offen.

[Cyberaxx]

So das hier ist das bisherige Final des Hovers

Delphi-Quellcode:

procedure TUserlist.TimerTimer(Sender: TObject);
  var
    APoint: TPoint;
    AControl: TControl;
    SControl: TControl;
begin
  FTimer.Enabled := False;

  APoint := FBaseFrame.ScreentoClient(Mouse.CursorPos);
  AControl := FBaseFrame.ControlatPos(Apoint, True, True);

  if Assigned(AControl) then begin
    if AControl is TFrame then begin
      SControl := TWincontrol(AControl).ControlAtPos(AControl.ScreenToClient(mouse.CursorPos), False, True);
      if Assigned(SControl) then begin
        if SControl is TPanel then begin
          if Assigned(LastControl) then begin
            if LastControl <> SControl then
              TPanel(LastControl).ParentColor := True;
          end;

          TPanel(SControl).Color := HoverColor;
          LastControl := SControl;
        end;
      end;
    end
      else if Assigned(LastControl) then begin
        TPanel(LastControl).ParentColor := True;
      end;
  end
    else if Assigned(LastControl) then begin
      TPanel(LastControl).ParentColor := True;
    end;

  FTimer.Enabled := True;
end;

LastControl ist vom Typ TControl und im Private der TUserliste deklariert.

Für Optimierungen bin ich offen
Wußte nicht das es doch recht schwer ist eine schöne Benutzerliste für einen Chat zu erstellen...

Ebenfalls wird in dieser Form auch das "Hint" dann ablaufen.

[Sprint]

Zitat von Cyberaxx:

Für Optimierungen bin ich offen

Warum TTimer und nicht CM_MOUSEENTER & CM_MOUSELEAVE für die anderen Komponenten (TLabel / TImage)?

[Cyberaxx]

Da so viele Komponenten aufeinander liegen muss ich immer schauen das ich das Panel erreiche, denn nur dieses soll Hovern.
Ich müsste pro Liste das OnEnter/OnLeave des Images und Labels. Von da muss ich auf das Panel um die Farbe zu ändern.
Dazu brauche ich auch immer das letzte aktiv gewesene Panel um dort die Farbe wieder zu ändern sobald ich nicht mehr auf diesem bin.

Da ich nicht über das OnEnter/OnLeave des Panels gehen kann um das Hint Zeitversetzt aufzurufen, Aufgrund dessen das diese beidem Prozeduren durch das Image und Label nicht aufgerufen werden.

Bei dem Deteils des Benutzers siehts es zudem etwas anders aus. Dieses besteht nur aus einem Panel und darauf enthalten sind zwei Labels und einige Images, die nicht das ganze Panel belegen.

Ich müsste dann also zwei globale Prozeduren haben, auf die jedes Panel, Image und Label zugreifen.

Delphi-Quellcode:

procedure OnMouseEnter(Sender: TObject);
procedure OnMouseLeave(Sender: TObject);

Sobald das OnEnter aufgerufen wird, muss ich dann auf das Panel kommen indem ich das jeweilige Parent des Images und Labels prüfen.
Den Zustand des Panels speichern und prüfen ob es sich geändert hat.

Delphi-Quellcode:

procedure OnMouseEnter(Sender: TObject);
  var
    TmpPanel: TPanel;
begin
  if Sender is TImage then begin
    if TImage(Sender).Parent is TPanel then
      TmpPanel := (TImage(Sender).Parent) as TPanel;
  end
    else if Sender is TLabel then begin
      if TLabel(Sender).Parent is TPanel then
        TmpPanel := (TLabel(Sender).Parent) as TPanel;
    end
      else if Sender is TPanel then begin
        TmpPanel := (Sender) as TPanel;
      end
        else Exit;

  TmpPanel.Color := clAqua;
end;

procedure OnMouseLeave(Sender: TObject);
  var
    TmpPanel: TPanel;
begin
  if Sender is TImage then begin
    if TImage(Sender).Parent is TPanel then
      TmpPanel := (TImage(Sender).Parent) as TPanel;
  end
    else if Sender is TLabel then begin
      if TLabel(Sender).Parent is TPanel then
        TmpPanel := (TLabel(Sender).Parent) as TPanel;
    end
      else if Sender is TPanel then begin
        TmpPanel := (Sender) as TPanel;
      end
        else Exit;

  TmpPanel.ParentColor := True;
end;

Das ist nun ungetestet, wie würde ich da aber das Hint anzeigen?
Ist das wirklich Performanter?

Edit: Proceduren geändert!

[Sprint]

Du brauchst doch nur die Nachrichten von TImage und TLabel an Parent weiterreichen.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TPanel = class(ExtCtrls.TPanel)
  private
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  public
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  end;

  TLabel = class(StdCtrls.TLabel)
  private
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  end;

  TImage = class(ExtCtrls.TImage)
  private
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  end;

  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure PanelOnMouseEnter(Sender: TObject);
    procedure PanelOnMouseLeave(Sender: TObject);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TPanel }

procedure TPanel.CMMouseEnter(var Message: TMessage);
begin
  if Assigned(FOnMouseEnter) then 
    FOnMouseEnter(Self);
end;

procedure TPanel.CMMouseLeave(var Message: TMessage);
begin
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;

{ TLabel }

procedure TLabel.CMMouseEnter(var Message: TMessage);
begin
  if Assigned(Parent) then
    Parent.Perform(CM_MOUSEENTER, 0, 0);
end;

procedure TLabel.CMMouseLeave(var Message: TMessage);
begin
  if Assigned(Parent) then
    Parent.Perform(CM_MOUSELEAVE, 0, 0);
end;

{ TImage }

procedure TImage.CMMouseEnter(var Message: TMessage);
begin
  if Assigned(Parent) then
    Parent.Perform(CM_MOUSEENTER, 0, 0);
end;

procedure TImage.CMMouseLeave(var Message: TMessage);
begin
  if Assigned(Parent) then
    Parent.Perform(CM_MOUSELEAVE, 0, 0);
end;

{ TForm1 }

procedure TForm1.PanelOnMouseEnter(Sender: TObject);
begin
  TPanel(Sender).Color := clHighlight;
end;

procedure TForm1.PanelOnMouseLeave(Sender: TObject);
begin
  TPanel(Sender).Color := clBtnFace;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel1.OnMouseEnter := PanelOnMouseEnter;
  Panel1.OnMouseLeave := PanelOnMouseLeave;
end;

end.

[Cyberaxx]

Ich geb zu, aufs Perform wäre ich am wenigsten gekommen, aber man lernt ja nie aus.