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
 
#7

AW: Anfängerfrage eigene TLabel-Komponente

  Alt 23. Jun 2018, 21:02
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.

Geändert von DieDolly (23. Jun 2018 um 21:09 Uhr)
  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 15:53 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