AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Anfängerfrage eigene TLabel-Komponente

Ein Thema von DieDolly · begonnen am 23. Jun 2018 · letzter Beitrag vom 25. Jun 2018
 
DieDolly

Registriert seit: 22. Jun 2018
2.175 Beiträge
 
#14

AW: Anfängerfrage eigene TLabel-Komponente

  Alt 24. Jun 2018, 15:06
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.
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:57 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz