Tombol unggulan
Setiap kali saya menggunakan kontrol yang disertakan dengan DELPHI, saya merasa ada sesuatu yang hilang, baik itu bentuk, warna, dll.
Terlepas dari metode transformasinya, semuanya berbeda dari standar yang disyaratkan oleh proyek Anda sendiri.
Belakangan, saya menemukan bahwa kontrol berikut sangat berguna! ! !
Ini kode sumbernya:
unit DsFancyButton;
antarmuka
kegunaan
SysUtils, Windows, Pesan, Kelas, Grafik, Kontrol, Formulir;
jenis
TTextStyle = (txNone, txLowered, txRaised, txShadow);
TShape = (shCapsule, shOval, shRectangle, shRoundRect);
TDsFancyButton = kelas(TGraphicControl)
Pribadi
FButtonWarna: TWarna;
FIsDown: Boolean;
FFframeWarna: TWarna;
Lebar Bingkai FF: Integer;
FCornerRadius: Bilangan Bulat;
FRgn, MRgn: HRgn;
Bentuk F: Bentuk T;
FTeksWarna: TWarna;
FTextStyle: TTextStyle;
prosedur SetButtonColor(Nilai: TColor);
prosedur CMEnabledChanged(var pesan: TMessage);
pesan CM_ENABLEDCHANGED;
prosedur CMTextChanged(var pesan: TMessage);
pesan CM_TEXTCHANGED;
procedure CMDialogChar(var pesan: TCMDialogChar);
pesan CM_DIALOGCHAR;
prosedur WMSize(var pesan: TWMSize); pesan WM_PAINT;
terlindung
prosedur Klik;
prosedur DrawShape;
prosedur Cat;
prosedur SetFrameColor(Nilai: TColor);
prosedur SetFrameWidth(Nilai: Integer);
procedure SetCornerRadius(Nilai: Integer);
prosedur SetShape(Nilai: TShape);
prosedur SetTextStyle(Nilai: TTextStyle);
prosedur WMLButtonDown(var Pesan: TWMLButtonDown);
WM_LBUTTONDOWN;
prosedur WMLButtonUp(var Pesan: TWMLButtonUp);
WM_LBUTTONUP;
prosedur TulisCaption;
publik
konstruktor Buat (Pemilik: TComponent);
destruktor Hancurkan;
diterbitkan
properti ButtonColor: TColor
baca FButtonColor tulis SetButtonColor;
keterangan properti;
properti DragCursor;
properti DragMode;
properti Diaktifkan;
font properti;
properti FrameColor: TColor
baca FFrameColor tulis SetFrameColor;
properti FrameWidth: Integer
baca FFrameWidth tulis SetFrameWidth;
properti ParentFont;
properti ParentShowHint;
properti Menu Popup;
properti CornerRadius: Integer
baca FCornerRadius tulis SetCornerRadius;
Properti Bentuk: TShape
baca FShape tulis SetShape default shRoundRect;
properti Tampilkan Petunjuk;
properti Gaya Teks: TTextStyle
baca FTextStyle tulis SetTExtStyle;
properti Terlihat;
properti OnClick; properti OnDragDrop;
properti OnDragOver; properti OnEndDrag;
properti OnMouseDown; Properti OnMouseUp;
PropertyOnMouseMove;
akhir;
prosedur Daftar;
pelaksanaan
konstruktor TDsFancyButton.Create(Pemilik: TComponent);
mulai
warisanBuat(Pemilik);
Gaya Kontrol := [csClickEvents, csCaptureMouse, CSSetCaption];
Diaktifkan := Benar;
FButtonColor := clBtnWajah;
FIsDown := Salah;
FFrameColor := clAbu-abu;
Lebar Bingkai FF := 6;
Radius Pojok := 10;
FRgn := 0;
FShape := ShRoundRect;
FTextStyle := txDibesarkan;
Tinggi := 25;
Terlihat := Benar;
Lebar := 97;
akhir;
destruktor TDsFancyButton.Destroy;
mulai
Hapus Objek(FRgn);
Hapus Objek(MRgn);
Kehancuran yang diwariskan;
akhir;
prosedur TDsFancyButton.Paint;
var Dia: bilangan bulat;
ClrUp, ClrDown: TWarna;
mulai
Kanvas.Kuas.Gaya := bsClear;
jika FIsDown lalu
mulai ClrUp := clBtnShadow; ClrDown := clBtnHighlight akhir;
kalau tidak
mulai ClrUp := clBtnHighlight; ClrDown := clBtnBayangan akhir;
dengan Canvas lakukan
mulai
kasus Bentuk
bulat lurus:
mulai
Dia := 2*Radius Sudut;
Mrgn := CreateRoundRectRgn(0, 0, Lebar, Tinggi, Dia,
Dia);
akhir;
shKapsul:
mulai
jika Lebar < Tinggi maka Dia := Lebar lagi Dia :=
Tinggi;
Mrgn := CreateRoundRectRgn(0, 0, Lebar, Tinggi, Dia,
Dia);
akhir;
shRectangle: MRgn := CreateRectRgn(0, 0, Lebar - 1, Tinggi
- 1);
shOval: MRgn := CreateEllipticRgn(0, 0, Lebar, Tinggi);
akhir;//kasus
Kanvas.Kuas.Warna := FButtonColor;
FillRgn(Pegangan, MRgn, Kuas.Pegangan);
Kuas.Warna :=ClrUp;
FrameRgn(Pegangan, MRgn, Kuas.Pegangan, 1,1);
OffsetRgn(MRgn, 1, 1);
Kuas.Warna := ClrDown;
FrameRgn(Pegangan, MRgn, Kuas.Pegangan, 1, 1);
akhir;//kanvas
Bentuk Gambar;
TulisCaption;
akhir;
prosedur TDsFancyButton.DrawShape;
var
FC, Warna: TWarna;
R, G, B: Byte;
AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia: Integer;
mulai
jika FFrameWidth mod 2=0 maka t := FFrameWidth
lain t := FFrameWidth + 1;
Warna := ColorToRGB(TombolWarna);
FC := ColorToRGB(BingkaiWarna);
Kanvas.Kuas.Warna := Warna;
AwalR := GetRValue(FC); AkhirR := GetRValue(Warna);
AwalG := GetGValue(FC); AkhirG := GetGValue(Warna);
AwalB := GetBValue(FC); AkhirB := GetBValue(Warna);
FRgn := 0;
dengan Canvas lakukan
untuk n := 0 sampai t - 1 lakukan
mulai
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);
Kuas.Warna := RGB(R, G, B);
Bentuk Kasus dari
shOval: FRgn := CreateEllipticRgn(1 + n, 1 + n, Lebar - n,
Tinggi - n);
bulat lurus:
mulai
Dia := Radius Sudut;
jika (Dia - n) >0 maka
Perancis :=
CreateRoundRectRgn(1 + n, 1 + n ,Lebar - n, Tinggi -
n, 2*(Diameter - n), 2*(Diameter - n))
else FRgn := CreateRectRgn( 1 + n, 1 + n, Lebar - n - 1,
Tinggi - n - 1);
akhir;
shKapsul:
mulai
jika Lebar < Tinggi maka Dia := Lebar div 2 lain Dia :=
Tinggi div 2;
jika (Dia - n) > 0 maka
Perancis:=
CreateRoundRectRgn(1 + n, 1 + n, Lebar - n,
Tinggi - n, 2*(Dia - n), 2*(Dia - n))
else FRgn := CreateRectRgn(1 + n, 1 + n ,Lebar - n -
1, Tinggi - n - 1);
akhir;
else FRgn := CreateRectRgn(1 + n, 1 + n, Lebar - n - 1,
Tinggi - n - 1);
akhir;//kasus
FrameRgn(Pegangan, FRgn, Kuas.Pegangan, 1, 1);
akhir;
akhir;
prosedur TDsFancyButton.WriteCaption;
var
Bendera: Kata;
BtnL, BtnT, BtnR, BtnB: Bilangan Bulat;
R, TR: Benar;
mulai
R := KlienRect; TR := ClientRect;
Kanvas.Font := Self.Font;
Kanvas.Kuas.Gaya := bsClear;
Bendera := DT_CENTER atau DT_SINGLELINE;
Kanvas.Font := Font;
jika FIsDown maka FTextColor := FrameColor
else FTextColor := Self.Font.Color;
dengan kanvas lakukan
mulai
BtnT := (Tinggi - Tinggi Teks(Keterangan)) div 2;
BtnB := BtnT + Tinggi Teks(Keterangan);
BtnL := (Lebar - Lebar Teks(Keterangan)) div 2;
BtnR := BtnL + Lebar Teks(Keterangan);
TR := Persegi(BtnL, BtnT, BtnR, BtnB);
R := TR;
jika ((TextStyle = txLowered) dan FIsDown ) atau
((TextStyle = txRaised) dan bukan FIsDown) lalu
mulai
Font.Warna := clBtnHighLight;
OffsetRect(TR, -1 + 1, -1 + 1);
DrawText(Handle, PChar(Caption), Panjang(Caption), TR,
Bendera);
akhir
else if ((TextStyle = txLowered) dan bukan FIsDown) atau
((TextStyle = txRaised) dan FIsDown) lalu
mulai
Font.Warna := clBtnHighLight;
OffsetRect(TR, + 2, + 2);
DrawText(Handle, PChar(Caption), Panjang(Caption), TR,
Bendera);
akhir
else if (TextStyle = txShadowed) dan FIsDown lalu
mulai
Font.Warna := clBtnShadow;
OffsetRect(TR, 3 + 1, 3 + 1);
DrawText(Pegangan, PChar(Keterangan),
Panjang (Keterangan), TR, Bendera);
akhir
else if (TextStyle = txShadowed) dan bukan FIsDown
Kemudian
mulai
Font.Warna := clBtnShadow;
OffsetRect(TR, 2 + 1, 2 + 1);
DrawText(Pegangan, PChar(Keterangan),
Panjang (Keterangan), TR, Bendera);
akhir;
jika Diaktifkan maka Font.Color := FTextColor//self.Font.Color
else if (TextStyle = txShadowed) dan tidak Diaktifkan
Font.Warna := clBtnFace
lain Font.Warna := clBtnShadow;
jika FIsDown maka OffsetRect(R, 1, 1)
else OffsetRect(R, -1, -1);
DrawText(Handle, PChar(Caption), Panjang(Caption), R, Flags);
akhir;
akhir;
prosedur TDsFancyButton.SetButtonColor(nilai: TColor);
mulai
jika nilai <> FButtonColor maka
mulai FButtonColor := nilai Tidak valid;
akhir;
prosedur TDsFancyButton.WMLButtonDown(pesan var:
TWMLButtonDown);
mulai
jika bukan PtInRegion(MRgn, message.xPos, message.yPos) lalu Keluar;
FIsDown := Benar;
Cat;
diwariskan;
akhir;
procedure TDsFancyButton.WMLButtonUp(pesan var: TWMLButtonUp);
mulai
jika bukan FIsDown maka Keluar;
FIsDown := Salah;
cat;
diwariskan;
akhir;
prosedur TDsFancyButton.SetShape(nilai: TShape);
mulai
jika nilai <> FShape maka
mulai FShape := nilai Tidak valid;
akhir;
prosedur TDsFancyButton.SetTextStyle(nilai: TTextStyle);
mulai
jika nilai<>FTextStyle maka
mulai FTextStyle := nilai;
akhir;
prosedur TDsFancyButton.SetFrameColor(nilai: TColor);
mulai
jika Nilai<>FFrameColor lalu
mulai FFrameColor := Nilai;
akhir;
prosedur TDsFancyButton.SetFrameWidth(Nilai: Integer);
var
w: bilangan bulat;
mulai
jika Lebar<tinggi maka w := Lebar lagi w := Tinggi;
jika Nilai<>FFrameWidth maka FFrameWidth := nilai;
jika FFrameWidth < 4 maka FFrameWidth := 4;
jika FFrameWidth >(w div 2) maka FFrameWidth := (w div 2);
Tidak valid;
akhir;
procedure TDsFancyButton.SetCornerRadius(Nilai: integer);
var
w: bilangan bulat;
mulai
jika Lebar<Tinggi maka w := Lebar lagi w := Tinggi;
jika nilai<>FCornerRadius maka FCornerRadius := nilai;
jika FCornerRadius<3 maka FCornerRadius := 3;
jika FCornerRadius>w maka FCornerRadius := w;
Tidak valid;
akhir;
procedure TDsFancyButton.CMEnabledChanged(var pesan: Tmessage);
mulai
diwariskan;
membatalkan;
akhir;
prosedur TDsFancyButton.CMTextChanged(var pesan: TMessage);
mulai
Tidak valid;
akhir;
prosedur TDsFancyButton.CMDialogChar(var pesan:TCMDialogChar);
mulai
Dengan Pesan lakukan
jika IsAccel (CharCode, Caption) dan Diaktifkan maka
mulai Klik; Hasil := 1 ;akhir
yang lain diwariskan;
akhir;
procedure TDsFancyButton.WMSize(var Pesan: TWMsize);
mulai
diwariskan;
jika lebar>300 maka lebar := 300;
jika Tinggi>300 maka Tinggi := 300;
akhir;
prosedur TDsFancyButton.Klik;
mulai
FIsDown := Salah;
Tidak valid;
Klik yang diwariskan;
akhir;
prosedur Daftar;
mulai
RegisterComponents('KOMPONEN WYM',[TDsFancyButton]);
akhir;
akhir.
Geng Baiqiang.