ein OnHover nachbauen / benutzen

[Cyberaxx]

Hallo Delphi Gemeinde

Ich programmiere gerade eine Benutzerliste, naja ich versuche es zumindest ;)
Aufgebaut ist es Server / Gruppe / Benutzer
Die jeweilige Liste hat ein Panel als Header, darin enthalten in Image(Align=Left) und ein Label(Align=Client)
Im eingeklappten Modus ist nur das Panel mit dem Label und dem Image zu sehen.
Ich würde gerne eine Art Hover mit drin haben, sobald man mit der Maus nun über dieses Panel gleitet, soll die Farbe des Panels geändert werden, solange sich die Maus innerhalb des Panels befindet.
Ich habe hier schon gesucht und einiges ausprobiert, ich bekomme allerdings keine Lösung hin.
Das MouseOver wird ja nur aufgerufen wenn sich die Maus innerhalb befindet und das auch nur wenn sich keine weiteren Komponenten darauf befinden.

Gibt es da eine Möglichkeit wie man dies lösen könnte?

Code:

[+] Server1 [0/6] <-- On Hover
[-] Server2 [10/33] 
   [+] Gruppe1 <-- On Hover
   [+] Gruppe2
   [-] Gruppe3
      - User1 <-- On Hover
      - User2
[+] Server3 [0/2]

Hoffe mir kann hier jemand helfen :)

Gruß
Daniel

[SirThornberry]

eine wirklich funktionierende Variante habe ich bei so etwas nur per Timer hin bekommen in dem ständig geprüft wird ob sich der Mauscursor noch über der Komponente befindet.

[hathor]

Delphi-Quellcode:

procedure TForm1.Panel1MouseLeave(Sender: TObject);
begin
Panel1.Color:= clgreen;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Panel1.Color:= clred;
end;

[DeddyH]

Dann zieh die Maus mal extrem schnell über das Panel. Ich habe die Erfahrung gemacht, dass das MouseLeave-Event in dem Fall nicht (immer) ausgelöst wird.

[hathor]

Wie schnell - was ist extrem?
Bei mir funktioniert es.
Vielleicht musst Du das Betriebssystem mal "aufräumen"...

[DeddyH]

Was hat das mit dem Betriebssystem zu tun? Und bei unseren Kunden ist der Satz "bei mir funktioniert es" einer der unbeliebtesten :lol:

[hathor]

Zitat:

Zitat von DeddyH

Was hat das mit dem Betriebssystem zu tun? Und bei unseren Kunden ist der Satz "bei mir funktioniert es" einer der unbeliebtesten :lol:

Das klingt jetzt ziemlich aggressiv!

Letztendlich muss es ja nur bei Cyberaxx funktionieren und nicht bei Dir!

[DeddyH]

War aber nicht so gemeint.

[jaenicke]

Normalerweise wird das immer ausgelöst. Ich habe bis jetzt noch nie festgestellt, dass es nicht klappt, wenn sonst alles richtig läuft.

Wo es Probleme gab:

• Bei Verzögerungen bei der Botschaftsbehandlung. Zum Beispiel wegen langsamen Zeichenoperationen. Ein Problem z.B. bei Toolbar-Komponenten.
• Bei unsauberer eigener Umsetzung in alten Delphiversionen, in denen es die Ereignisse noch nicht gab.
• Wenn bestimmte "Systemerweiterungen" sich einklinken um z.B. systemweite Mausgesten oder ähnliches umzusetzen.

Auf einem sauberen System und normal laufenden Delphiprogrammen bzw. auch Programmen anderer Sprachen und den direkten Windows Botschaften habe ich noch nie Fehler damit reproduzieren können. :stupid:

[DeddyH]

Zitat:

Zitat von jaenicke

Bei Verzögerungen bei der Botschaftsbehandlung. Zum Beispiel wegen langsamen Zeichenoperationen.

Wenn man Komponenten schreibt, die von TGraphicControl oder TCustomControl abgeleitet sind, kann es schon passieren, dass die Botschaft nicht mehr ankommt. Ich denke, darauf wollte auch Jens hinaus. Und den :stupid: kannst Du Dir in Zukunft sparen, OK?

[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:

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:

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.

[Cyberaxx]

wie schaut es denn mit dem OnClick Ereignis aus, kann ich den ebenfalls so überschreiben wie bei dem Image und Label? Wenn ja welche Message brauche ich dafür?