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/)
-   -   Anfängerfrage eigene TLabel-Komponente (https://www.delphipraxis.net/196830-anfaengerfrage-eigene-tlabel-komponente.html)

DieDolly 23. Jun 2018 19:46

Anfängerfrage eigene TLabel-Komponente
 
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
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.

scrat1979 23. Jun 2018 20:17

AW: Anfängerfrage eigene TLabel-Komponente
 
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?

DieDolly 23. Jun 2018 20:19

AW: Anfängerfrage eigene TLabel-Komponente
 
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.

scrat1979 23. Jun 2018 20:20

AW: Anfängerfrage eigene TLabel-Komponente
 
Delphi-Quellcode:
procedure TMyLabel.CMMouseLeave(var Message: TMessage);
begin
 inherited;

// Hier Labelfarbe setzen

 if Assigned(FOnMouseLeave) then
  FOnMouseLeave;
end;

DieDolly 23. Jun 2018 20:42

AW: Anfängerfrage eigene TLabel-Komponente
 
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
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.

KodeZwerg 23. Jun 2018 21:00

AW: Anfängerfrage eigene TLabel-Komponente
 
Frage:
Bei dem hier:
Delphi-Quellcode:
function TMyLabel.GetLastLabelColor: TColor;
begin
 Result := FLastLabelColor;
 FLastLabelColor := -1;
end;
Delphi-Quellcode:
 FLastLabelColor := -1;
wieso killst du da den Farbwert?

DieDolly 23. Jun 2018 21:02

AW: Anfängerfrage eigene TLabel-Komponente
 
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
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.

scrat1979 23. Jun 2018 21:15

AW: Anfängerfrage eigene TLabel-Komponente
 
Ich verstehe nur nicht ganz, warum du das ganze zwischenspeichern willst. Du hast doch die Hover-Farbe und die „Standardfarbe“. Die Standardfarbe würde ich im Constructor und beim Farbwechsel durch neue manuelle Zuweisung in eine Hilfsvariable speichern. Im MouseEnter bzw. MouseMove/MouseEnter setzt du dann eben entweder die Hover-Farbe oder die aus der Hilfsvariable als Font.Color

DieDolly 23. Jun 2018 21:25

AW: Anfängerfrage eigene TLabel-Komponente
 
Ich bin für Verbesserungen und Anpassungen deinerseits + Bereitstellung der Änderungen dankbar.
Ich bin mir nicht sicher, ob ich verstehe was du meinst. Deswegen würde ich dich bitte, wenn möglich, die Änderungen einzubauen und zu zeigen.

himitsu 23. Jun 2018 22:39

AW: Anfängerfrage eigene TLabel-Komponente
 
Zitat:

Zitat von DieDolly (Beitrag 1405638)
Ich bin mir nicht sicher, ob ich verstehe was du meinst. Deswegen würde ich dich bitte, wenn möglich, die Änderungen einzubauen und zu zeigen.

Warum speicherst du LastColor, wo du diesen Wert doch bereits in einer anderen Variable kennt? :zwinker:
PS: Wenn du während des Hover eine neue Farbe zuweist, dann wird nach dem Leave die falsche Farbe angezeigt.

Wozu haben die Set-Methoden einen TLabel-Parameter?
Und warum verwendest du den, anstatt direkt auf Self zuzugreifen?

Bezüglich dem Default-Wert für deine Property solltest du nochmal nachsehen,
denn es macht die DFM übersichtlicher, wenn Default-Werte (das, was im Constructor gesetzt wurde) nicht sinnlos die DFM zumüllen.

Die Color-Property sollten Setter-Methoden bekommen, damit beim Zuweisen auch gleich die Anzeige aktualisiert werden kann.

Und warum eine Magic-Number, anstatt einer ordentlichen Konstante?
Es gibt sogar schon eine Fertige, die man statt der -1 nutzen kann. (Delphi-Referenz durchsuchenclNone / Delphi-Referenz durchsuchenVcl.Graphics.TColor)

DieDolly 23. Jun 2018 23:07

AW: Anfängerfrage eigene TLabel-Komponente
 
Das sind zu viele Infos für mich.
Ich bin absolute Anfängerin. Das ist alles mehr als kompliziert und unverständlich für mich was du schreibst.

So sieht mein Code mittlerweile aus.
Ich kann pro Label die Hover-Effekte per Objekt-Inspektor ausschalten.

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;
 // CColorClick: TColor = $000000AA;

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

  FHoverColor: TColor;
  FHoverColorEnabled: Boolean;
  FHoverStylesEnabled: Boolean;
  // FColorActive: TColor;
  // FColorClick: TColor;

  FOnMouseEnter: TNotifyEvent;
  FOnMouseLeave: TNotifyEvent;

  FUnderlinedOnEnter: Boolean;
  FItalicOnEnter: Boolean;

  function GetLastLabelColor: TColor;
  procedure SetLastLabelColor;
  function GetLastLabelStyle: TFontStyles;
  procedure SetLastLabelStyle;
  procedure SetLabelMouseProperties(Sender: TLabel; Color: TColor; Styles: TFontStyles = []; Cursor: TCursor = crDefault);
 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 HoverColor: TColor read FHoverColor write FHoverColor;
  property HoverColorEnabled: Boolean read FHoverColorEnabled write FHoverColorEnabled;
  property HoverStylesEnabled: Boolean read FHoverStylesEnabled write FHoverStylesEnabled;
  // property ColorActive: TColor read FColorActive write FColorActive;
  // property ColorClick: TColor read FColorClick write FColorClick;

  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

function TMyLabel.GetLastLabelColor: TColor;
begin
 // Wenn die Maus auf einem Label ist und man per Klick die Farbe ändert, dann hier darauf reagieren und nicht die alte Farbe zurückschreiben
 if FLastLabelColor = Self.Font.Color then
  Result := FLastLabelColor
 else
  Result := Self.Font.Color;

 FLastLabelColor := clNone;
end;

procedure TMyLabel.SetLastLabelColor;
begin
 if FLastLabelColor = clNone then
  FLastLabelColor := Self.Font.Color;
end;

function TMyLabel.GetLastLabelStyle: TFontStyles;
begin
 Result := FLastLabelStyle;
 FLastLabelStyle := [];
end;

procedure TMyLabel.SetLastLabelStyle;
begin
 if FLastLabelStyle = [] then
  FLastLabelStyle := Self.Font.Style;
end;

procedure TMyLabel.SetLabelMouseProperties(Sender: TLabel; Color: TColor; Styles: TFontStyles = []; Cursor: TCursor = crDefault);
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 := clNone;
 FLastLabelStyle := [];

 FUnderlinedOnEnter := True;
 // Color := CColorDefault;
 Font.Color := CColorDefault;

 HoverColor := CColorHover;
 FHoverColorEnabled := True;
 FHoverStylesEnabled := True;
 // ColorActive := CColorHover;
 // ColorClick := CColorClick;
end;

procedure TMyLabel.CMMouseEnter(var Message: TMessage);
var
 HoverColor: TColor;
 HoverStyles: TFontStyles;
begin
 inherited;

 SetLastLabelStyle;
 SetLastLabelColor;

 if FHoverColorEnabled then
  HoverColor := FHoverColor
 else
  HoverColor := Self.Font.Color;

 if FHoverStylesEnabled then
  begin
   HoverStyles := [];
   if FUnderlinedOnEnter then
    HoverStyles := HoverStyles + [fsUnderline];
   if FItalicOnEnter then
    HoverStyles := HoverStyles + [fsItalic];
  end
 else
  HoverStyles := Self.Font.Style;

 SetLabelMouseProperties(Self, HoverColor, HoverStyles, crHandPoint);

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

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

 SetLabelMouseProperties(Self, GetLastLabelColor, GetLastLabelStyle);

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

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

end.
Ich versuche mein absolut best-möglichstes. Aber ich bin leider ein wenig eingeschränkt und bin nicht in der Lage viele Informationen auf einmal aufzunehmen und zu verarbeiten.
Deshalb würde ich euch bitten Nachsicht mir mir zu haben und nur Stück für Stück vorzuschlagen. Mehrere Dinge auf einmal überfordern mich sofort.

Das hier funktioniert aber leider noch kein bisschen so wie es soll
Delphi-Quellcode:
function TMyLabel.GetLastLabelColor: TColor;
begin
 // Wenn die Maus auf einem Label ist und man per Klick die Farbe ändert, dann hier darauf reagieren und nicht die alte Farbe zurückschreiben
 if FLastLabelColor = Self.Font.Color then
  Result := FLastLabelColor
 else
  Result := Self.Font.Color;

 FLastLabelColor := clNone;
end;
Man fährt mit der Maus auf ein Label was schwarz ist, klick es an und per Code im OnClick ändert man die Farbe von beispielweise schwarz auf rot.
Entferne ich jetzt die Maus von diesem Label, sollte das Label eigentlich rot bleiben aber es wird zurück auf schwarz gesetzt.
Irgendwie müsste man prüfen und reagieren, wenn man Label.Font.Color setzt glaube ich.

Das konnte ich temporär so lösen
Delphi-Quellcode:
function TMyLabel.GetLastLabelColor: TColor;
 // Wenn die Maus auf einem Label ist und man per Klick die Farbe ändert, dann hier darauf reagieren und nicht die alte Farbe zurückschreiben
 if Self.Font.Color <> FLabelHoverColorTmp then
  Result := Self.Font.Color
 else
  Result := FLastLabelColor;
end;

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

 FLabelHoverColorTmp := Color;
end;

DieDolly 24. Jun 2018 11:39

AW: Anfängerfrage eigene TLabel-Komponente
 
Zitat:

Warum speicherst du LastColor, wo du diesen Wert doch bereits in einer anderen Variable kennt?
In welcher Variable kenne ich die zuletzt genutzte Farbe denn außer in FLastLabelColor?

Zitat:

PS: Wenn du während des Hover eine neue Farbe zuweist, dann wird nach dem Leave die falsche Farbe angezeigt.
Das habe ich durch die Hilfe von FLabelHoverColorTmp in SetLabelMouseProperties und abfragen in GetLastLabelColor ausgebessert.

Zitat:

Wozu haben die Set-Methoden einen TLabel-Parameter?
Und warum verwendest du den, anstatt direkt auf Self zuzugreifen?
Habe sie entfernt und greife jetzt auf Self zu.

Zitat:

Bezüglich dem Default-Wert für deine Property solltest du nochmal nachsehen,
denn es macht die DFM übersichtlicher, wenn Default-Werte (das, was im Constructor gesetzt wurde) nicht sinnlos die DFM zumüllen.
Das verstehe ich leider nicht so ganz. ich weiß, dass man oben in der Kopfdeklaration auch default so-und-so hinzufügen kann. Aber das wird nicht in den ObjektInspektor übernommen.

Zitat:

Die Color-Property sollten Setter-Methoden bekommen, damit beim Zuweisen auch gleich die Anzeige aktualisiert werden kann.
Das verstehe ich leider auch nicht so ganz.

Zitat:

Und warum eine Magic-Number, anstatt einer ordentlichen Konstante?
Es gibt sogar schon eine Fertige, die man statt der -1 nutzen kann. (Delphi-Referenz durchsuchenclNone / Delphi-Referenz durchsuchenVcl.Graphics.TColor)
Habe ich auch ausgebessert.

Alter Mann 24. Jun 2018 13:54

AW: Anfängerfrage eigene TLabel-Komponente
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo,

meinst du es so wie im Anhang?

DieDolly 24. Jun 2018 15:06

AW: Anfängerfrage eigene TLabel-Komponente
 
Dein Beispiel scheint nicht ganz zu funktionieren. Oder ich bediene es falsch. Die Stile werden nicht zum Original zurückgeschrieben wenn man die Maus entfernt.

Mein Beispiel sieht so aus und funktioniert mittlerweile auch, wenn man die Farbe des Labels wechselt, während man mit der Maus drauf ist
Delphi-Quellcode:
unit MyLabel;

interface

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

const
 CColorDefault: TColor = clWindowText;
 CColorHover: TColor = clRed;
 // CColorClick: TColor = $000000AA;

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

  FHoverColor: TColor;
  FHoverColorEnabled: Boolean;
  FHoverStylesEnabled: Boolean;
  // FColorActive: TColor;
  // FColorClick: TColor;

  FOnMouseEnter: TNotifyEvent;
  FOnMouseLeave: TNotifyEvent;

  FStyleOnEnterUnderlined: Boolean;
  FStyleOnEnterItalic: Boolean;

  function GetLastLabelColor: TColor;
  procedure SetLastLabelColor;
  function GetLastLabelStyle: TFontStyles;
  procedure SetLastLabelStyle;
  procedure SetLabelMouseProperties(Color: TColor; Styles: TFontStyles = []; Cursor: TCursor = crDefault);
 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 HoverColor: TColor read FHoverColor write FHoverColor;
  property HoverColorEnabled: Boolean read FHoverColorEnabled write FHoverColorEnabled;
  property HoverStylesEnabled: Boolean read FHoverStylesEnabled write FHoverStylesEnabled;
  // property ColorActive: TColor read FColorActive write FColorActive;
  // property ColorClick: TColor read FColorClick write FColorClick;

  property StyleOnEnterUnderlined: Boolean read FStyleOnEnterUnderlined write FStyleOnEnterUnderlined;
  property StyleOnEnterItalic: Boolean read FStyleOnEnterItalic write FStyleOnEnterItalic;

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

procedure register;

implementation

function TMyLabel.GetLastLabelColor: TColor;
begin
 // Wenn die Maus auf einem Label ist und man per Klick die Farbe ändert, dann hier darauf reagieren und nicht die alte Farbe zurückschreiben
 if Self.Font.Color <> FLabelHoverColorTmp then
  Result := Self.Font.Color
 else
  Result := FLastLabelColor;

 FLastLabelColor := clNone;
end;

procedure TMyLabel.SetLastLabelColor;
begin
 FLastLabelColor := Self.Font.Color;
end;

function TMyLabel.GetLastLabelStyle: TFontStyles;
begin
 // Wenn die Maus auf einem Label ist und man per Klick den Style ändert, dann hier darauf reagieren und nicht den alten Style zurückschreiben
 if Self.Font.Style <> FLabelHoverStyleTmp then
  Result := Self.Font.Style
 else
  Result := FLastLabelStyle;

 FLastLabelStyle := [];
end;

procedure TMyLabel.SetLastLabelStyle;
begin
 if FLastLabelStyle = [] then
  FLastLabelStyle := Self.Font.Style;
end;

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

 FLabelHoverColorTmp := Color;
 FLabelHoverStyleTmp := Styles;
end;

//

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

 FLastLabelColor := CColorDefault;
 FLastLabelStyle := [];

 FStyleOnEnterUnderlined := True;
 // Color := CColorDefault;
 Font.Color := CColorDefault; // CColorDefault;

 HoverColor := CColorHover;
 FHoverColorEnabled := True;
 FHoverStylesEnabled := True;
 // ColorActive := CColorHover;
 // ColorClick := CColorClick;
end;

procedure TMyLabel.CMMouseEnter(var Message: TMessage);
var
 HoverColor: TColor;
 HoverStyles: TFontStyles;
begin
 inherited;

 if not Self.Enabled then
  Exit;

 SetLastLabelColor;
 SetLastLabelStyle;

 if FHoverColorEnabled then
  HoverColor := FHoverColor
 else
  HoverColor := Self.Font.Color;

 if FHoverStylesEnabled then
  begin
   HoverStyles := [];
   if FStyleOnEnterUnderlined then
    HoverStyles := HoverStyles + [fsUnderline];
   if FStyleOnEnterItalic then
    HoverStyles := HoverStyles + [fsItalic];
  end
 else
  HoverStyles := Self.Font.Style;

 SetLabelMouseProperties(HoverColor, HoverStyles, crHandPoint);

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

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

 SetLabelMouseProperties(GetLastLabelColor, GetLastLabelStyle);

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

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

end.

Alter Mann 24. Jun 2018 15:51

AW: Anfängerfrage eigene TLabel-Komponente
 
okay,
dann habe ich es nicht verstanden:(
Ist aber kein Problem:)

DieDolly 24. Jun 2018 16:53

AW: Anfängerfrage eigene TLabel-Komponente
 
Stell dir ein Link-Label vor. Im Prinzip habe ich mir ein Link-Label gemacht was ein paar Optionen mehr hat. Eben genau die, die ich brauche.

Rollo62 25. Jun 2018 06:25

AW: Anfängerfrage eigene TLabel-Komponente
 
Bin nicht ganz sicher was du erreichen möchtest, aber statt eigener MotifyEvents sollte man die Enter/Exit Funktionen überschreiben, und darin die und darin die existierenden NotifyEevnts aufrufen.

Delphi-Quellcode:
    procedure DoEnter; override;
    procedure DoExit; override;
...

procedure TMyLabel.DoEnter;
begin
    IrgendwelcheOptionenVorbereiten;

    if Assigned(FOnEnter) then // Wenn man in TMyLabel darauf zugreifen kann
      FOnEnter(Self);

  inherited; // das wird aber eigentlich schon in inherited so ähnlich gemacht ...
end;

DieDolly 25. Jun 2018 11:24

AW: Anfängerfrage eigene TLabel-Komponente
 
Ist es auch möglich OnMouseMove und OnMouseLeave zu überschreiben?
Wenn ich das versuche bekomme ich die Meldung, dass diese Methoden nicht in der Basisklasse gefunden wurden.
Aber auch mit DoEnter und DoExit bekomme ich die Meldung.

DoEnter würde wenn ich das richtig verstanden habe ja schon ausgelöst, wenn ich mit der Tastatur dahin navigiere.


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:59 Uhr.

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