![]() |
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:
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.
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. 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:
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.
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; 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; |
AW: Anfängerfrage eigene TLabel-Komponente
Zitat:
Zitat:
Zitat:
Zitat:
Zitat:
Zitat:
|
AW: Anfängerfrage eigene TLabel-Komponente
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo,
meinst du es so wie im Anhang? |
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. |
AW: Anfängerfrage eigene TLabel-Komponente
okay,
dann habe ich es nicht verstanden:( Ist aber kein Problem:) |
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.
|
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; |
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 20:34 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