Рекомендуемые кнопки
Всякий раз, когда я использую элементы управления DELPHI, я чувствую, что чего-то не хватает, будь то форма, цвет и т. д.
Независимо от метода трансформации, все они отличаются от стандартов, требуемых вашим собственным проектом. Я сверился с некоторыми книгами.
Позже я обнаружил, что следующие элементы управления очень полезны! ! !
Вот его исходный код:
модуль DsFancyButton;
интерфейс
использует
SysUtils, Windows, сообщения, классы, графика, элементы управления, формы;
тип
TTextStyle = (txNone, txLowered, txRaising, txShadow);
TShape = (shCapsule, shOval, shRectangle, shRoundRect);
TDsFancyButton = класс (TGraphicControl)
Частный
Фбуттонколор: Тколор;
FIsDown: логическое значение;
Ффрамеколор: Тколор;
FFrameWidth: целое число;
FCornerRadius: целое число;
FRgn, MRgn: HRgn;
Фшапе: Тшапе;
Фтекстколор: Тколор;
ФТекстСтиль: ТТекстСтиль;
процедура SetButtonColor (Значение: TColor);
процедура CMEnabledChanged (сообщение var: TMessage);
сообщение CM_ENABLEDCHANGED;
процедура CMTextChanged (вар сообщение: TMessage);
сообщение CM_TEXTCHANGED;
процедура CMDialogChar (сообщение var: TCMDialogChar);
сообщение CM_DIALOGCHAR;
процедура WMSize (сообщение var: сообщение TWMSize WM_PAINT);
защищенный
процедура переопределения;
процедура DrawShape;
процедура Paint;
процедура SetFrameColor (Значение: TColor);
процедура SetFrameWidth (Значение: целое число);
процедура SetCornerRadius (Значение: целое число);
процедура SetShape (Значение: TShape);
процедура SetTextStyle (Значение: TTextStyle);
процедура WMLButtonDown (сообщение var: сообщение TWMLButtonDown);
WM_LBUTTONDOWN;
процедура WMLButtonUp (сообщение var: сообщение TWMLButtonUp);
WM_LBUTTONUP;
процедура WriteCaption;
общественный
конструктор Create (владелец: TComponent override);
деструктор Уничтожить;
опубликовано
свойство ButtonColor: TColor
прочитать FButtonColor записать SetButtonColor;
свойство Заголовок;
свойство DragCursor;
свойство DragMode;
свойство Включено;
свойство Шрифт;
свойство FrameColor: TColor
прочитать FFrameColor, записать SetFrameColor;
свойство FrameWidth: целое число
прочитать FFrameWidth и записать SetFrameWidth;
свойство Родительский шрифт;
свойство ParentShowHint;
свойство PopupMenu;
свойство CornerRadius: целое число
прочитать FCornerRadius и записать SetCornerRadius;
Форма свойства: TShape
чтение FShape запись SetShape default shRoundRect;
свойство ШоуХинт;
свойство TextStyle: TTextStyle
прочитать FTextStyle, записать SetTEXtStyle;
свойство Видимое;
свойство OnClick; свойство OnDragDrop;
свойство OnDragOver; свойство OnEndDrag;
свойство OnMouseDown; свойство OnMouseUp;
СвойствоOnMouseMove;
конец;
процедура Регистр;
выполнение
конструктор TDsFancyButton.Create(AOwner: TComponent);
начинать
унаследованноеСоздать (Владелец);
ControlStyle: = [csClickEvents, csCaptureMouse, CSSetCaption];
Включено := Истина;
FButtonColor := clBtnFace;
FIsDown := Ложь;
FFrameColor: = clGray;
ФФрамемидс: = 6;
FCornerRadius := 10;
ФРгн := 0;
FShape := shRoundRect;
FTextStyle:= txRaising;
Высота:= 25;
Видимый := Истина;
Ширина: = 97;
конец;
деструктор TDsFancyButton.Destroy;
начинать
УдалитьОбъект(FRgn);
УдалитьОбъект(MRgn);
унаследовал Уничтожить;
конец;
процедура TDsFancyButton.Paint;
вар Dia: целое число;
ClrUp, ClrDown: TColor;
начинать
Canvas.Brush.Style := bsClear;
если FIsDown, то
начало ClrUp: = clBtnShadow ClrDown: = clBtnHighlight конец;
еще
начало ClrUp: = clBtnHighlight ClrDown: = clBtnShadow конец;
с холстом сделать
начинать
корпус Форма
шРаундРект:
начинать
Диаметр := 2*Угловой радиус;
Mrgn := CreateRoundRectRgn(0, 0, Ширина, Высота, Диаметр,
Диа);
конец;
шКапсула:
начинать
если Ширина < Высота, то Диаметр := Ширина иначе Диаметр :=
Высота;
Mrgn := CreateRoundRectRgn(0, 0, Ширина, Высота, Диаметр,
Диа);
конец;
shRectangle: MRgn := CreateRectRgn(0, 0, Ширина - 1, Высота
- 1);
shOval: MRgn := CreateEllipticRgn(0, 0, Width, Height);
конец;//случай
Canvas.Brush.Color := FButtonColor;
FillRgn(Handle, MRgn, Brush.Handle);
Кисть.Цвет :=ClrUp;
FrameRgn(Handle, MRgn, Brush.Handle, 1,1);
OffsetRgn(MRgn, 1, 1);
Кисть.Цвет := ClrDown;
FrameRgn(Handle, MRgn, Brush.Handle, 1, 1);
конец;//холст
НичьяШапе;
НаписатьЗаголовок;
конец;
процедура TDsFancyButton.DrawShape;
вар
ФК, Варна: TColor;
R, G, B: Байт;
AwalR, AwalG, AwalB, AkhirR, AkhirG, AkhirB, n, t, Dia: Целое число;
начинать
если FFrameWidth mod 2=0, то t := FFrameWidth
иначе т: = FFrameWidth + 1;
Предупреждение := ColorToRGB(ButtonColor);
FC := ColorToRGB(Цвет Рамки);
Canvas.Brush.Color := Варна;
AwalR := GetRValue(FC); AkhirR := GetRValue(Варна);
AwalG := GetGValue(FC); AkhirG := GetGValue(Варна);
AwalB := GetBValue(FC); AkhirB := GetBValue(Варна);
ФРгн := 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);
Кисть.Цвет := RGB(R, G, B);
Форма корпуса
shOval: FRgn := CreateEllipticRgn(1 + n, 1 + n, Ширина - n,
Высота - н);
шРаундРект:
начинать
Диаметр := Радиус угла;
если (Dia - n) >0, то
ФРгн :=
CreateRoundRectRgn(1 + n, 1 + n, Ширина - n, Высота -
n, 2*(Диаметр - n), 2*(Диаметр - n))
иначе FRgn := CreateRectRgn( 1 + n, 1 + n, Ширина - n - 1,
Высота - н - 1);
конец;
шКапсула:
начинать
если Ширина < Высота, то Диаметр := Ширина div 2 else Диаметр :=
Высота деления 2;
если (Dia - n) > 0, то
ФРгн:=
CreateRoundRectRgn(1 + n, 1 + n, Ширина - n,
Высота - n, 2*(Диаметр - n), 2*(Диаметр - n))
иначе FRgn := CreateRectRgn(1 + n, 1 + n, Ширина - n -
1, Высота - n - 1);
конец;
иначе FRgn := CreateRectRgn(1 + n, 1 + n, Ширина - n - 1,
Высота - н - 1);
конец;//случай
FrameRgn(Handle, FRgn, Brush.Handle, 1, 1);
конец;
конец;
процедура TDsFancyButton.WriteCaption;
вар
Флаги: Слово;
BtnL, BtnT, BtnR, BtnB: целое число;
Р, ТР: ТРект;
начинать
Р := КлиентРект; ТР := КлиентРект;
Canvas.Font := Self.Font;
Canvas.Brush.Style := bsClear;
Флаги:= DT_CENTER или DT_SINGLELINE;
Canvas.Font := Шрифт;
если FIsDown, то FTextColor:= FrameColor
иначе FTextColor := Self.Font.Color;
с холстом сделать
начинать
BtnT := (Высота - TextHeight(Заголовок)) div 2;
BtnB := BtnT + TextHeight(Заголовок);
BtnL := (Ширина - TextWidth(Заголовок)) div 2;
BtnR := BtnL + TextWidth(Заголовок);
TR := Rect(BtnL, BtnT, BtnR, BtnB);
Р := ТР;
if ((TextStyle = txLowered) и FIsDown ) или
((TextStyle = txRaising), а не FIsDown), тогда
начинать
Font.Color := clBtnHighLight;
OffsetRect(TR, -1 + 1, -1 + 1);
DrawText(Handle, PChar(Заголовок), Длина(Заголовок), TR,
Флаги);
конец
иначе, если ((TextStyle = txLowered), а не FIsDown) или
((TextStyle = txRaising) и FIsDown), затем
начинать
Font.Color := clBtnHighLight;
OffsetRect(TR, + 2, + 2);
DrawText(Handle, PChar(Заголовок), Длина(Заголовок), 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);
DrawText(Дескриптор, PChar(Заголовок),
Длина(Заголовок), TR, Флаги);
конец;
если включено, то Font.Color := FTextColor//self.Font.Color
иначе, если (TextStyle = txShadowed) и не включено, тогда
Font.Color := clBtnFace
иначе Font.Color := clBtnShadow;
если FIsDown, то OffsetRect(R, 1, 1)
еще OffsetRect(R, -1, -1);
DrawText(Handle, PChar(Заголовок), Длина(Заголовок), R, Флаги);
конец;
конец;
процедура TDsFancyButton.SetButtonColor(значение: TColor);
начинать
если значение <> FButtonColor, то
начало FButtonColor: = значение недействительно;
конец;
процедура TDsFancyButton.WMLButtonDown(сообщение var:
TWMLButtonDown);
начинать
если не PtInRegion(MRgn, message.xPos, message.yPos), то Exit;
FIsDown := Истина;
Краска;
унаследованный;
конец;
процедура TDsFancyButton.WMLButtonUp (сообщение var: TWMLButtonUp);
начинать
если не FIsDown, то Выход;
FIsDown := Ложь;
краска;
унаследованный;
конец;
процедура TDsFancyButton.SetShape(значение: TShape);
начинать
если значение <> FShape тогда
начать FShape: = значение недействительно;
конец;
процедура TDsFancyButton.SetTextStyle(значение: TTextStyle);
начинать
если значение<>FTextStyle, то
начало FTextStyle: = значение недействительно;
конец;
процедура TDsFancyButton.SetFrameColor(значение: TColor);
начинать
если Value<>FFrameColor, то
начало FFrameColor: = Значение; конец;
конец;
процедура TDsFancyButton.SetFrameWidth(Значение: целое число);
вар
ш: целое число;
начинать
если Ширина<высота, то w := Ширина иначе w := Высота;
если Value<>FFrameWidth, то FFrameWidth := value;
если FFrameWidth < 4, то FFrameWidth := 4;
если FFrameWidth >(w div 2), то FFrameWidth := (w div 2);
Недействителен;
конец;
процедура TDsFancyButton.SetCornerRadius(Значение: целое число);
вар
ш: целое число;
начинать
если Ширина<Высота, то w := Ширина иначе w := Высота;
если значение<>FCornerRadius, то FCornerRadius := value;
если FCornerRadius<3, то FCornerRadius := 3;
если FCornerRadius>w, то FCornerRadius := w;
Недействителен;
конец;
процедура TDsFancyButton.CMEnabledChanged (сообщение var: Tmessage);
начинать
унаследованный;
признать недействительным;
конец;
процедура TDsFancyButton.CMTextChanged(сообщение var: TMessage);
начинать
Недействителен;
конец;
процедура TDsFancyButton.CMDialogChar(var message:TCMDialogChar);
начинать
С сообщением сделать
если IsAccel (CharCode, Caption) и включено, то
начать Нажмите Результат := 1 ;конец;
остальное унаследовано;
конец;
процедура TDsFancyButton.WMSize(сообщение var: TWMSize);
начинать
унаследованный;
если ширина>300, то ширина := 300;
если Высота>300, то Высота:= 300;
конец;
процедура TDsFancyButton.Click;
начинать
FIsDown := Ложь;
Недействителен;
унаследованный Клик;
конец;
процедура Регистр;
начинать
RegisterComponents('WYM COMPONENT',[TDsFancyButton]);
конец;
конец.
Гэн Байцян.