أزرار مميزة
كلما أستخدم عناصر التحكم التي تأتي مع DELPHI، أشعر أن هناك شيئًا مفقودًا، سواء كان الشكل أو اللون أو ما إلى ذلك.
وبغض النظر عن طريقة التحول، فهي كلها مختلفة عن المعايير التي يتطلبها مشروعك الخاص، وقد استشرت بعض الكتب.
لاحقًا، وجدت أن عناصر التحكم التالية مفيدة جدًا! ! !
هنا هو كود المصدر الخاص به:
وحدة DsFancyButton؛
واجهة
الاستخدامات
SysUtils، Windows، الرسائل، الفئات، الرسومات، عناصر التحكم، النماذج؛
يكتب
TTextStyle = (txNone, txLowered, txRaised, txShadow);
TShape = (shCapsule, shOval, shRectangle, shRoundRect);
TDsFancyButton = فئة (TGraphicControl)
خاص
FButtonColor: TColor؛
FIsDown: منطقية؛
FFrameColor: TColor؛
FFrameWidth: عدد صحيح؛
FCornerRadius: عدد صحيح؛
فرجن، مرجن: هرجن؛
شكل: شكل؛
FTextColor: TColor;
FTextStyle: TTextStyle;
الإجراء SetButtonColor(Value: TColor);
الإجراء CMEnabledChanged(var message: TMessage);
الرسالة CM_ENABLEDCHANGED؛
الإجراء CMTextChanged(var message: TMessage);
الرسالة CM_TEXTCHANGE؛
الإجراء CMDialogChar (رسالة فار: TCMDialogChar)؛
الرسالة CM_DIALOGCHAR؛
الإجراء WMSize(var message: TWMSize message WM_PAINT);
محمي
تجاوز الإجراء؛
الإجراء DrawShape؛
طلاء الإجراء؛
الإجراء SetFrameColor(Value: TColor);
الإجراء SetFrameWidth(Value: Integer);
الإجراء SetCornerRadius(Value: Integer);
الإجراء SetShape(Value: TShape);
الإجراء SetTextStyle(Value: TTextStyle);
الإجراء WMLButtonDown(رسالة فار: رسالة TWMLButtonDown);
WM_LBUTTONDOWN;
الإجراء WMLButtonUp(رسالة فار: رسالة TWMLButtonUp);
WM_LBUTTONUP;
الإجراء WriteCaption؛
عام
إنشاء المنشئ (Aowner: TComponent)؛
تدمير المدمرة؛
نشرت
خاصية زر اللون: TColor
قراءة FButtonColor، كتابة SetButtonColor؛
تسمية توضيحية للملكية؛
خاصية DragCursor؛
خاصية DragMode؛
خاصية تمكين؛
خط الملكية؛
خاصية لون الإطار: TColor
قراءة FFrameColor كتابة SetFrameColor؛
خاصية عرض الإطار: عدد صحيح
قراءة FFrameWidth، كتابة SetFrameWidth؛
خاصية ParentFont;
خاصية ParentShowHint;
الخاصية PopupMenu؛
نصف قطر الملكية: عدد صحيح
قراءة FCornerRadius، كتابة SetCornerRadius؛
شكل الملكية: TShape
قراءة FShape، كتابة SetShape الافتراضي shRoundRect؛
خاصية ShowHint؛
خاصية TextStyle: TTextStyle
قراءة FTextStyle، كتابة SetTextStyle؛
الملكية مرئية؛
خاصية OnClick؛ خاصية OnDragDrop؛
خاصية OnDragOver؛ خاصية OnEndDrag؛
الملكية OnMouseDown؛ الملكية OnMouseUp؛
this.PropertyOnMouseMove;
نهاية؛
سجل الإجراء؛
تطبيق
المنشئ TDsFancyButton.Create(AOwner: TComponent);
يبدأ
inheritedCreate(Aowner);
ControlStyle := [csClickEvents, csCaptureMouse, CSSetCaption];
ممكّن := صحيح؛
FButtonColor := clBtnFace;
FIsDown := False;
FFrameColor := clGray;
FFrameWidth := 6;
نصف قطر الزاوية:= 10;
فرجن := 0;
FShape := shRoundRect;
FTextStyle := txRaised;
الارتفاع := 25;
مرئي:= صحيح؛
العرض := 97;
نهاية؛
destructor TDsFancyButton.Destroy;
يبدأ
DeleteObject(FRgn);
DeleteObject(MRgn);
التدمير الموروث؛
نهاية؛
الإجراء TDsFancyButton.Paint؛
فار ديا: عدد صحيح؛
ClrUp، ClrDown: TColor؛
يبدأ
Canvas.Brush.Style := bsClear;
إذا FIsDown بعد ذلك
begin ClrUp := clBtnShadow;
آخر
begin ClrUp := clBtnHighlight;
مع قماش القيام به
يبدأ
شكل القضية
شروندريكت:
يبدأ
ضياء:= 2*نصف قطر الزاوية؛
Mrgn := CreateRoundRectRgn(0, 0, العرض, الارتفاع, القطر,
ضياء)؛
نهاية؛
كبسولة:
يبدأ
إذا كان العرض < الارتفاع ثم ضياء: = العرض وإلا ضياء: =
ارتفاع؛
Mrgn := CreateRoundRectRgn(0, 0, Width, Height, Dia,
ضياء)؛
نهاية؛
shRectangle: MRgn := CreateRectRgn(0, 0, العرض - 1, الارتفاع
- 1)؛
shOval: MRgn := CreateEllipticRgn(0, 0, Width, Height);
النهاية؛//حالة
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);
النهاية؛//canvas
DrawShape;
this.WriteCaption;
نهاية؛
الإجراء TDsFancyButton.DrawShape؛
فار
FC، اللون: TColor؛
R، G، B: بايت؛
AwalR، AwalG، AwalB، AkhirR، AkhirG، AkhirB، n، t، Dia: عدد صحيح؛
يبدأ
إذا كان FFrameWidth mod 2=0 ثم t := FFrameWidth
else 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);
فرجن := 0;
مع قماش القيام به
لـ n := 0 إلى t - 1 افعل
يبدأ
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);
شكل القضية
shOval: FRgn := CreateEllipticRgn(1 + n, 1 + n, العرض - n,
الارتفاع - ن)؛
شروندريكت:
يبدأ
ضياء: = نصف قطر الزاوية؛
إذا (ضياء - ن) >0 ثم
فرجن :=
CreateRoundRectRgn(1 + n, 1 + n ,العرض - n, الارتفاع -
ن، 2*(ضياء - ن)، 2*(ضياء - ن))
آخر FRgn := CreateRectRgn( 1 + n, 1 + n, العرض - n - 1,
الارتفاع - ن - 1)؛
نهاية؛
كبسولة:
يبدأ
إذا كان العرض < الارتفاع ثم القطر: = العرض div 2 وإلا القطر: =
شعبة الارتفاع 2؛
إذا (ضياء - ن) > 0 ثم
فرجن:=
CreateRoundRectRgn(1 + n, 1 + n, العرض - n,
الارتفاع - ن، 2*(ضياء - ن)، 2*(ضياء - ن))
آخر FRgn := CreateRectRgn(1 + n, 1 + n ,Width - n -
1، الارتفاع - ن - 1)؛
نهاية؛
آخر FRgn := CreateRectRgn(1 + n, 1 + n, العرض - n - 1,
الارتفاع - ن - 1)؛
النهاية؛//حالة
FrameRgn(Handle, FRgn, Brush.Handle, 1, 1);
نهاية؛
نهاية؛
الإجراء TDsFancyButton.WriteCaption؛
فار
الأعلام: كلمة؛
BtnL، BtnT، BtnR، BtnB: عدد صحيح؛
R، TR: TRect؛
يبدأ
R := ClientREct TR := ClientRect;
Canvas.Font := Self.Font;
Canvas.Brush.Style := bsClear;
الأعلام := DT_CENTER أو DT_SINGLELINE؛
Canvas.Font := الخط؛
إذا FIsDown ثم FTextColor := FrameColor
else FTextColor := Self.Font.Color;
مع قماش القيام به
يبدأ
BtnT := (الارتفاع - TextHeight(Caption)) div 2;
BtnB := BtnT + TextHeight(Caption);
BtnL := (Width - TextWidth(Caption)) div 2;
BtnR := BtnL + TextWidth(Caption);
TR := Rect(BtnL, BtnT, BtnR, BtnB);
ص := تر؛
إذا ((TextStyle = txLowered) وFIsDown ) أو
((TextStyle = txRaised) وليس FIsDown) إذن
يبدأ
Font.Color := clBtnHighLight;
OffsetRect(TR, -1 + 1, -1 + 1);
DrawText(Handle, PChar(Caption), Length(Caption), TR,
أعلام)؛
نهاية
وإلا إذا ((TextStyle = txLowered) وليس FIsDown) أو
((TextStyle = txRaised) وFIsDown) ثم
يبدأ
Font.Color := clBtnHighLight;
OffsetRect(TR, + 2, + 2);
DrawText(Handle, PChar(Caption), Length(Caption), TR,
أعلام)؛
نهاية
وإلا إذا (TextStyle = txShadowed) ثم FIsDown
يبدأ
Font.Color := clBtnShadow;
OffsetREct(TR, 3 + 1, 3 + 1);
DrawText(مقبض، PChar(تسمية توضيحية)،
الطول (التسمية التوضيحية)، TR، الأعلام)؛
نهاية
وإلا إذا كان (TextStyle = txShadowed) وليس FIsDown
ثم
يبدأ
Font.Color := clBtnShadow;
OffsetRect(TR, 2 + 1, 2 + 1);
رسم نص (مقبض، PChar (تسمية توضيحية)،
الطول (التسمية التوضيحية)، TR، الأعلام)؛
نهاية؛
إذا تم تمكينه، ثم Font.Color := FTextColor//self.Font.Color
وإلا إذا (TextStyle = txShadowed) ولم يتم تمكينه بعد ذلك
Font.Color := clBtnFace
else Font.Color := clBtnShadow;
إذا كان FIsDown ثم OffsetRect(R, 1, 1)
else OffsetRect(R, -1, -1);
DrawText(Handle, PChar(Caption), Length(Caption), R, Flags);
نهاية؛
نهاية؛
الإجراء TDsFancyButton.SetButtonColor(value: TColor);
يبدأ
إذا كانت القيمة <> FButtonColor إذن
ابدأ FButtonColor := القيمة؛
نهاية؛
الإجراء TDsFancyButton.WMLButtonDown (رسالة فار:
TWMLButtonDown);
يبدأ
إذا لم يكن PtInRegion(MRgn, message.xPos, message.yPos) ثم خروج;
FIsDown := True;
طلاء؛
موروث؛
نهاية؛
الإجراء TDsFancyButton.WMLButtonUp(رسالة فار: TWMLButtonUp);
يبدأ
إذا لم يكن FIsDown ثم خروج؛
FIsDown := False;
طلاء؛
موروث؛
نهاية؛
الإجراء TDsFancyButton.SetShape(value: TShape);
يبدأ
إذا كانت القيمة <> FShape إذن
start FShape := end;
نهاية؛
الإجراء TDsFancyButton.SetTextStyle(القيمة: TTextStyle);
يبدأ
إذا كانت القيمة<>FTextStyle إذن
start FTextStyle := value;
نهاية؛
الإجراء TDsFancyButton.SetFrameColor(value: TColor);
يبدأ
إذا كانت القيمة<>FFrameColor إذن
start FFrameColor := Value;Envalidate;end;
نهاية؛
الإجراء TDsFancyButton.SetFrameWidth(Value: Integer);
فار
ث: عدد صحيح؛
يبدأ
إذا كان العرض <الارتفاع ثم w := العرض آخر w := الارتفاع؛
إذا كانت القيمة<>FFrameWidth ثم FFrameWidth := القيمة؛
إذا كان FFrameWidth < 4، فإن FFrameWidth := 4؛
إذا كان FFrameWidth >(w div 2) ثم FFrameWidth := (w div 2);
يبطل؛
نهاية؛
الإجراء TDsFancyButton.SetCornerRadius(Value: integer);
فار
ث: عدد صحيح؛
يبدأ
إذا كان العرض <الارتفاع ثم w := العرض آخر w := الارتفاع؛
إذا كانت القيمة<>FCornerRadius ثم FCornerRadius:= القيمة؛
إذا كان FCornerRadius <3 ثم FCornerRadius := 3؛
إذا FCornerRadius>w ثم FCornerRadius := w؛
يبطل؛
نهاية؛
الإجراء TDsFancyButton.CMenabledChanged(var message: Tmessage);
يبدأ
موروث؛
يبطل؛
نهاية؛
الإجراء TDsFancyButton.CMTextChanged(var message: TMessage);
يبدأ
يبطل؛
نهاية؛
الإجراء TDsFancyButton.CMDialogChar(var message:TCMDialogChar);
يبدأ
مع رسالة تفعل
إذا كان IsAccel (CharCode، Caption) وممكّنًا بعد ذلك
ابدأ انقر النتيجة := 1 ;النهاية
وغير ذلك موروث؛
نهاية؛
الإجراء TDsFancyButton.WMSize(var الرسالة: TWMSize);
يبدأ
موروث؛
إذا كان العرض> 300 فإن العرض := 300؛
إذا كان الارتفاع> 300 فإن الارتفاع := 300؛
نهاية؛
الإجراء TDsFancyButton.Click؛
يبدأ
FIsDown := False;
يبطل؛
النقرة الموروثة؛
نهاية؛
سجل الإجراء؛
يبدأ
RegisterComponents('WYM COMPONENT',[TDsFancyButton]);
نهاية؛
نهاية.
جينج بايكيانج.