Besondere Tasten
Immer wenn ich die mit DELPHI gelieferten Steuerelemente verwende, habe ich das Gefühl, dass etwas fehlt, sei es die Form, die Farbe usw.
Unabhängig von der Transformationsmethode unterscheiden sie sich alle von den für Ihr eigenes Projekt erforderlichen Standards. Ich habe einige Bücher konsultiert.
Später stellte ich fest, dass die folgenden Steuerelemente sehr nützlich sind! ! !
Hier ist der Quellcode:
Einheit DsFancyButton;
Schnittstelle
verwendet
SysUtils, Windows, Nachrichten, Klassen, Grafiken, Steuerelemente, Formulare;
Typ
TTextStyle = (txNone, txLowered, txRaised, txShadowed);
TShape = (shCapsule, shOval, shRectangle, shRoundRect);
TDsFancyButton = class(TGraphicControl)
Privat
FButtonColor: TColor;
FIsDown: Boolean;
FFrameColor: TColor;
FFrameWidth: Integer;
FCornerRadius: Integer;
FRgn, MRgn: HRgn;
FShape: TShape;
FTextColor: TColor;
FTextStyle: TTextStyle;
procedure SetButtonColor(Value: TColor);
procedure CMEnabledChanged(var message: TMessage);
Nachricht CM_ENABLEDCHANGED;
procedure CMTextChanged(var message: TMessage);
Nachricht CM_TEXTCHANGED;
procedure CMDialogChar(var message: TCMDialogChar);
Nachricht CM_DIALOGCHAR;
procedure WMSize(var message: TWMSize); message WM_PAINT;
geschützt
Verfahren Klicken Sie auf;
Prozedur DrawShape;
Prozedur Paint;
procedure SetFrameColor(Value: TColor);
procedure SetFrameWidth(Value: Integer);
procedure SetCornerRadius(Value: Integer);
procedure SetShape(Value: TShape);
procedure SetTextStyle(Value: TTextStyle);
procedure WMLButtonDown(var Message: TWMLButtonDown); message
WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TWMLButtonUp); message
WM_LBUTTONUP;
Prozedur WriteCaption;
öffentlich
Konstruktor Create(Aowner: TComponent);
Destruktor Zerstören; überschreiben;
veröffentlicht
Eigenschaft ButtonColor: TColor
read FButtonColor write SetButtonColor;
Eigentumsunterschrift;
Eigenschaft DragCursor;
Eigenschaft DragMode;
Eigenschaft Aktiviert;
Eigenschaft Schriftart;
Eigenschaft FrameColor: TColor
read FFrameColor write SetFrameColor;
Eigenschaft FrameWidth: Ganzzahl
read FFrameWidth write SetFrameWidth;
Eigenschaft ParentFont;
Eigenschaft ParentShowHint;
Eigenschaft PopupMenu;
Eigenschaft CornerRadius: Ganzzahl
read FCornerRadius write SetCornerRadius;
Eigenschaftsform: TShape
read FShape write SetShape default shRoundRect;
Eigenschaft ShowHint;
Eigenschaft TextStyle: TTextStyle
read FTextStyle write SetTExtStyle;
Eigenschaft Sichtbar;
Eigenschaft OnClick; Eigenschaft OnDragDrop;
Eigenschaft OnDragOver; Eigenschaft OnEndDrag;
Eigenschaft OnMouseDown; Eigenschaft OnMouseUp;
PropertyOnMouseMove;
Ende;
Verfahren Registrieren;
Durchführung
Konstruktor TDsFancyButton.Create(AOwner: TComponent);
beginnen
inheritedCreate(Aowner);
ControlStyle := [csClickEvents, csCaptureMouse, CSSetCaption];
Aktiviert := True;
FButtonColor := clBtnFace;
FIsDown := False;
FFrameColor := clGray;
FFrameWidth := 6;
FCornerRadius := 10;
FRgn := 0;
FShape := shRoundRect;
FTextStyle := txRaised;
Höhe := 25;
Sichtbar := True;
Breite := 97;
Ende;
Destruktor TDsFancyButton.Destroy;
beginnen
DeleteObject(FRgn);
DeleteObject(MRgn);
geerbt Zerstören;
Ende;
Prozedur TDsFancyButton.Paint;
var Dia: Ganzzahl;
ClrUp, ClrDown: TColor;
beginnen
Canvas.Brush.Style := bsClear;
wenn FIsDown dann
begin ClrUp := clBtnShadow; ClrDown := clBtnHighlight;
anders
begin ClrUp := clBtnHighlight; ClrDown := clBtnShadow;
mit Canvas tun
beginnen
Fall Form von
shRoundRect:
beginnen
Dia := 2*CornerRadius;
Mrgn := CreateRoundRectRgn(0, 0, Breite, Höhe, Durchmesser,
Durchmesser);
Ende;
shKapsel:
beginnen
Wenn Breite < Höhe, dann Durchmesser: = Breite, sonst Durchmesser: =
Höhe;
Mrgn := CreateRoundRectRgn(0, 0, Breite, Höhe, Durchmesser,
Durchmesser);
Ende;
shRectangle: MRgn := CreateRectRgn(0, 0, Breite - 1, Höhe
- 1);
shOval: MRgn := CreateEllipticRgn(0, 0, Breite, Höhe);
Ende;//Fall
Canvas.Brush.Color := FButtonColor;
FillRgn(Handle, MRgn, Brush.Handle);
Brush.Color :=ClrUp;
FrameRgn(Handle, MRgn, Brush.Handle, 1,1);
OffsetRgn(MRgn, 1, 1);
Brush.Color := ClrDown;
FrameRgn(Handle, MRgn, Brush.Handle, 1, 1);
end;//canvas
DrawShape;
WriteCaption;
Ende;
Prozedur TDsFancyButton.DrawShape;
var
FC, Warna: TColor;
R, G, B: Byte;
AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia: Integer;
beginnen
Wenn FFrameWidth mod 2=0, dann t := FFrameWidth
sonst t := FFrameWidth + 1;
Warna := ColorToRGB(ButtonColor);
FC := ColorToRGB(FrameColor);
Canvas.Brush.Color := Warna;
AwalR := GetRValue(FC); AkhirR := GetRValue(Warna);
AwalG := GetGValue(FC); AkhirG := GetGValue(Warna);
AwalB := GetBValue(FC); AkhirB := GetBValue(Warna);
FRgn := 0;
mit Canvas tun
für n := 0 bis t - 1 do
beginnen
R := AwalR + Trunc(Sqrt(t*t - Sqr(tn))*(AkhirR - AwalR)/t);
G := AwalG + Trunc(Sqrt(t*t - Sqr(tn))*(AkhirG - AwalG)/t);
B := AwalB + Trunc(Sqrt(t*t - Sqr(tn))*(AkhirB - AwalB)/t);
Brush.Color := RGB(R, G, B);
Gehäuseform von
shOval: FRgn := CreateEllipticRgn(1 + n, 1 + n, Breite - n,
Höhe - n);
shRoundRect:
beginnen
Dia := CornerRadius;
wenn (Dia - n) >0 dann
FRgn :=
CreateRoundRectRgn(1 + n, 1 + n ,Width - n, Height -
n, 2*(Dia - n), 2*(Dia - n))
sonst FRgn := CreateRectRgn( 1 + n, 1 + n, Breite - n - 1,
Höhe - n - 1);
Ende;
shKapsel:
beginnen
Wenn Breite < Höhe, dann Dia := Breite div 2 sonst Dia :=
Höhenteilung 2;
wenn (Dia - n) > 0 dann
FRgn:=
CreateRoundRectRgn(1 + n, 1 + n, Breite - n,
Höhe - n, 2*(Durchmesser - n), 2*(Durchmesser - n))
else FRgn := CreateRectRgn(1 + n, 1 + n ,Width - n -
1, Höhe - n - 1);
Ende;
sonst FRgn := CreateRectRgn(1 + n, 1 + n, Breite - n - 1,
Höhe - n - 1);
Ende;//Fall
FrameRgn(Handle, FRgn, Brush.Handle, 1, 1);
Ende;
Ende;
Prozedur TDsFancyButton.WriteCaption;
var
Flaggen: Wort;
BtnL, BtnT, BtnR, BtnB: Ganzzahl;
R, TR: TRect;
beginnen
R := ClientRect; TR := ClientRect;
Canvas.Font := Self.Font;
Canvas.Brush.Style := bsClear;
Flags := DT_CENTER oder DT_SINGLELINE;
Canvas.Font := Schriftart;
Wenn FIsDown, dann FTextColor := FrameColor
sonst FTextColor := Self.Font.Color;
mit Leinwand tun
beginnen
BtnT := (Height - TextHeight(Caption)) div 2;
BtnB := BtnT + TextHeight(Caption);
BtnL := (Width - TextWidth(Caption)) div 2;
BtnR := BtnL + TextWidth(Caption);
TR := Rect(BtnL, BtnT, BtnR, BtnB);
R := TR;
if ((TextStyle = txLowered) und FIsDown ) oder
((TextStyle = txRaised) und nicht FIsDown) dann
beginnen
Font.Color := clBtnHighLight;
OffsetRect(TR, -1 + 1, -1 + 1);
DrawText(Handle, PChar(Beschriftung), Länge(Beschriftung), TR,
Flaggen);
Ende
sonst wenn ((TextStyle = txLowered) und nicht FIsDown) oder
((TextStyle = txRaised) und FIsDown) dann
beginnen
Font.Color := clBtnHighLight;
OffsetRect(TR, + 2, + 2);
DrawText(Handle, PChar(Beschriftung), Länge(Beschriftung), TR,
Flaggen);
Ende
else if (TextStyle = txShadowed) und FIsDown then
beginnen
Font.Color := clBtnShadow;
OffsetREct(TR, 3 + 1, 3 + 1);
DrawText(Handle, PChar(Beschriftung),
Länge(Beschriftung), TR, Flags);
Ende
sonst wenn (TextStyle = txShadowed) und nicht FIsDown
Dann
beginnen
Font.Color := clBtnShadow;
OffsetRect(TR, 2 + 1, 2 + 1);
DrawText(Handle, PChar(Beschriftung),
Länge(Beschriftung), TR, Flags);
Ende;
wenn aktiviert, dann Font.Color := FTextColor//self.Font.Color
sonst wenn (TextStyle = txShadowed) und dann nicht aktiviert
Font.Color := clBtnFace
sonst Font.Color := clBtnShadow;
if FIsDown then OffsetRect(R, 1, 1)
sonst OffsetRect(R, -1, -1);
DrawText(Handle, PChar(Caption), Length(Caption), R, Flags);
Ende;
Ende;
Prozedur TDsFancyButton.SetButtonColor(Wert: TColor);
beginnen
wenn Wert <> FButtonColor dann
begin FButtonColor := value ; Invalidate;
Ende;
procedure TDsFancyButton.WMLButtonDown(var message:
TWMLButtonDown);
beginnen
wenn nicht PtInRegion(MRgn, message.xPos, message.yPos) then Exit;
FIsDown := True;
Malen;
geerbt;
Ende;
procedure TDsFancyButton.WMLButtonUp(var message: TWMLButtonUp);
beginnen
wenn nicht FIsDown, dann Exit;
FIsDown := False;
malen;
geerbt;
Ende;
Prozedur TDsFancyButton.SetShape(Wert: TShape);
beginnen
wenn Wert <> FShape dann
begin FShape := value; Invalidate;
Ende;
procedure TDsFancyButton.SetTextStyle(value: TTextStyle);
beginnen
wenn Wert<>FTextStyle dann
begin FTextStyle := value;
Ende;
Prozedur TDsFancyButton.SetFrameColor(Wert: TColor);
beginnen
wenn Wert<>FFrameColor dann
begin FFrameColor := Value;end;
Ende;
procedure TDsFancyButton.SetFrameWidth(Value: Integer);
var
w: ganze Zahl;
beginnen
wenn Breite<Höhe dann w := Breite sonst w := Höhe;
if Value<>FFrameWidth then FFrameWidth := value;
wenn FFrameWidth < 4 dann FFrameWidth := 4;
if FFrameWidth >(w div 2) then FFrameWidth := (w div 2);
Ungültig machen;
Ende;
procedure TDsFancyButton.SetCornerRadius(Value: integer);
var
w: ganze Zahl;
beginnen
wenn Breite<Höhe dann w := Breite sonst w := Höhe;
if value<>FCornerRadius then FCornerRadius := value;
wenn FCornerRadius<3 dann FCornerRadius := 3;
if FCornerRadius>w then FCornerRadius := w;
Ungültig machen;
Ende;
procedure TDsFancyButton.CMEnabledChanged(var message: Tmessage);
beginnen
geerbt;
ungültig machen;
Ende;
procedure TDsFancyButton.CMTextChanged(var message: TMessage);
beginnen
Ungültig machen;
Ende;
procedure TDsFancyButton.CMDialogChar(var message:TCMDialogChar);
beginnen
Mit Nachricht tun
wenn IsAccel (CharCode, Caption) und dann aktiviert
begin Klicken; Ergebnis := 1 ;ende
sonst vererbt;
Ende;
procedure TDsFancyButton.WMSize(var Message: TWMSize);
beginnen
geerbt;
wenn Breite>300, dann Breite := 300;
wenn Höhe>300, dann Höhe := 300;
Ende;
Prozedur TDsFancyButton.Click;
beginnen
FIsDown := False;
Ungültig machen;
geerbtes Klicken;
Ende;
Verfahren Registrieren;
beginnen
RegisterComponents('WYM COMPONENT',[TDsFancyButton]);
Ende;
Ende.
Geng Baiqiang.