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.