Anfängerfrage eigene TLabel-Komponente

[DieDolly]

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.