Ich brauche eure Hilfe noch einmal.
Ich versuche gerade eine eigene Label-Komponente zu erstellen. Die einzigen Unterschiede sollen sein

1. andere Standardfarbe
2. eigenes MouseMove- und MouseLeave-Event, was immer ausgeführt werden soll und was eine Farbe und ggf. Styles setzt (ähnlich wie ein Link)

Leider komme ich gerade nicht weiter. Mein Ansatz ist vermutlich mehr als fragwürdig

zusammenfalten · markieren

Delphi-Quellcode:

unit MyLabel;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.StdCtrls, Vcl.Graphics, Vcl.Controls;

const
 CColorDefault: TColor = clRed;
 CColorHover: TColor = clGreen;

type
 TMyLabel = class(TLabel)
 private
  {Private-Deklarationen}
  FLastLabelColor: TColor;

  FColorHover: TColor;
  FColorActive: TColor;

  FOnMouseMove: TNotifyEvent;
  FOnMouseLeave: TNotifyEvent;

  procedure setLastLabelColor(aLabel: TLabel);
  function getLastLabelColor: TColor;
 protected
  {Protected-Deklarationen}
 public
  {Public-Deklarationen}
  constructor Create(AOwner: TComponent); override;

  procedure CMMouseMove(var Message: TMessage); message CM_MOUSEENTER;
  procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
 published
  {Published-Deklarationen}
  property ColorHover: TColor read FColorHover write FColorHover;
  property ColorActive: TColor read FColorActive write FColorActive;

  property OnMouseMove: TNotifyEvent read FOnMouseMove write FOnMouseMove;
  property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
 end;

procedure register;

implementation

// Funktionen um die letzte Farbe eines Labels vor dem MouseMove-Event zwischenzuspeichern und wieder auszulesen
procedure TMyLabel.setLastLabelColor(aLabel: TLabel);
begin
 if FLastLabelColor = -1 then
  FLastLabelColor := aLabel.Font.Color;
end;

function TMyLabel.getLastLabelColor: TColor;
begin
 Result := FLastLabelColor;
 FLastLabelColor := -1;
end;

//

constructor TMyLabel.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);

 Color := CColorHover;
 ColorHover := CColorHover;
 ColorActive := CColorHover;
end;

procedure TMyLabel.CMMouseMove(var Message: TMessage);
begin
 inherited;
 if Assigned(FOnMouseMove) then
  begin

  end;
end;

procedure TMyLabel.CMMouseLeave(var Message: TMessage);
begin
 inherited;
 if Assigned(FOnMouseLeave) then
  begin

  end;
end;

procedure register;
begin
 RegisterComponents('My Label', [TMyLabel]);
end;

end.

Das sieht doch schon gar nicht schlecht aus.

Solltest du nicht im MouseLeave und MouseMove (wäre hier MouseEnter nicht besser?) jeweils die Labelfarbe auch setzen? Was genau funktioniert denn nicht?

Ich weiß nicht wie ich auf das Event reagiere. Aktuell habe ich ein Showmessage in beiden Events stehen aber ich bekomme den Dialog nicht angezeigt.

markieren

Delphi-Quellcode:

procedure TMyLabel.CMMouseLeave(var Message: TMessage);
begin
 inherited;

// Hier Labelfarbe setzen

 if Assigned(FOnMouseLeave) then
  FOnMouseLeave;
end;

Das hat mir geholfen danke.

Das mit dem MouseLeave scheint nicht ganz zu klappen. Die Farbe die das Label vorher hatte wird nicht wieder zugewiesen.

Mein Versuch

zusammenfalten · markieren

Delphi-Quellcode:

function TMyLabel.GetLastLabelColor: TColor;
begin
 Result := FLastLabelColor;
 FLastLabelColor := -1;
end;

procedure TMyLabel.SetLastLabelColor(aLabel: TLabel);
begin
 if FLastLabelColor = -1 then
  FLastLabelColor := aLabel.Font.Color;
end;

constructor TMyLabel.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);

 FLastLabelColor := 1;

 // usw.
end;

procedure TMyLabel.SetLabelMouseProperties(Sender: TLabel; Color: TColor; Cursor: TCursor = crDefault; Styles: TFontStyles = []);
begin
 TLabel(Sender).Font.Color := Color;
 TLabel(Sender).Cursor := Cursor;
 TLabel(Sender).Font.Style := Styles;
end;

procedure TMyLabel.CMMouseEnter(var Message: TMessage);
begin
 inherited;

 SetLastLabelColor(Self); // alte Farbe zwischenspeichern?
 SetLabelMouseProperties(Self, CColorHover, crHandPoint);

 if Assigned(FOnMouseEnter) then
  FOnMouseEnter(Self);
end;

procedure TMyLabel.CMMouseLeave(var Message: TMessage);
begin
 inherited;

 SetLabelMouseProperties(Self, GetLastLabelColor); // alte, zwischengespeicherte Farbe wieder setzen

 if Assigned(FOnMouseLeave) then
  FOnMouseLeave(Self);
end;

Statt der zwischengespeicherten Farbe (clRed) wird aber schwarz zurückgeschrieben.

Frage:
Bei dem hier:

markieren

Delphi-Quellcode:

function TMyLabel.GetLastLabelColor: TColor;
begin
 Result := FLastLabelColor;
 FLastLabelColor := -1;
end;

 FLastLabelColor := -1; wieso killst du da den Farbwert?

Weil ich ab da den Wert der Zwischenvariable nicht mehr brauche.
Ich habe den Fehler gefunden. Im Constructor fehlte ein Minuszeichen.

Hier ist mein Zwischenresultat

zusammenfalten · markieren

Delphi-Quellcode:

unit MyLabel;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.StdCtrls, Vcl.Graphics, Vcl.Controls, Dialogs;

const
 CColorDefault: TColor = clRed;
 CColorHover: TColor = clGreen;

type
 TMyLabel = class(TLabel)
 private
  {Private-Deklarationen}
  FLastLabelColor: TColor;
  FStyles: TFontStyles;

  FColorHover: TColor;
  FColorActive: TColor;

  FOnMouseEnter: TNotifyEvent;
  FOnMouseLeave: TNotifyEvent;

  FUnderlinedOnEnter: Boolean;
  FItalicOnEnter: Boolean;

  function GetLastLabelColor: TColor;
  procedure SetLastLabelColor(aLabel: TLabel);
  procedure SetLabelMouseProperties(Sender: TLabel; Color: TColor; Cursor: TCursor = crDefault; Styles: TFontStyles = []);
 protected
  {Protected-Deklarationen}
 public
  {Public-Deklarationen}
  constructor Create(AOwner: TComponent); override;

  procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
 published
  {Published-Deklarationen}
  property ColorHover: TColor read FColorHover write FColorHover;
  property ColorActive: TColor read FColorActive write FColorActive;
  property UnderlinedOnEnter: Boolean read FUnderlinedOnEnter write FUnderlinedOnEnter;

  property ItalicOnEnter: Boolean read FItalicOnEnter write FItalicOnEnter;

  property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
 end;

procedure register;

implementation

// Funktionen um die letzte Farbe eines Labels vor dem MouseMove-Event zwischenzuspeichern und wieder auszulesen
function TMyLabel.GetLastLabelColor: TColor;
begin
 Result := FLastLabelColor;
 FLastLabelColor := -1;
end;

procedure TMyLabel.SetLastLabelColor(aLabel: TLabel);
begin
 if FLastLabelColor = -1 then
  FLastLabelColor := aLabel.Font.Color;
end;

procedure TMyLabel.SetLabelMouseProperties(Sender: TLabel; Color: TColor; Cursor: TCursor = crDefault; Styles: TFontStyles = []);
begin
 TLabel(Sender).Font.Color := Color;
 TLabel(Sender).Cursor := Cursor;
 TLabel(Sender).Font.Style := Styles;
end;

//

constructor TMyLabel.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);

 FLastLabelColor := -1;

 Color := CColorDefault;
 Font.Color := CColorDefault;

 ColorHover := CColorHover;
 ColorActive := CColorHover;
end;

procedure TMyLabel.CMMouseEnter(var Message: TMessage);
begin
 inherited;

 FStyles := [];
 if FUnderlinedOnEnter then
  FStyles := FStyles + [fsUnderline];
 if FItalicOnEnter then
  FStyles := FStyles + [fsItalic];

 SetLastLabelColor(Self);
 SetLabelMouseProperties(Self, CColorHover, crHandPoint, FStyles);

 if Assigned(FOnMouseEnter) then
  FOnMouseEnter(Self);
end;

procedure TMyLabel.CMMouseLeave(var Message: TMessage);
begin
 inherited;

 SetLabelMouseProperties(Self, GetLastLabelColor);

 if Assigned(FOnMouseLeave) then
  FOnMouseLeave(Self);
end;

procedure register;
begin
 RegisterComponents('My Label', [TMyLabel]);
end;

end.