Code: |
unit colorbtn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons;
type
TColorBtn = class(TButton) private FCanvas: TCanvas; IsFocused: Boolean; F3DFrame: boolean; FButtonColor: TColor; procedure Set3DFrame(Value: boolean); procedure SetButtonColor(Value: TColor); procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; procedure DrawButtonText(const Caption: string; TRC: TRect; State: TButtonState; BiDiFlags: Longint); procedure CalcuateTextPosition(const Caption: string; var TRC: TRect; BiDiFlags: Longint); protected procedure CreateParams(var Params: TCreateParams); override; procedure SetButtonStyle(ADefault: Boolean); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property ButtonColor: TColor read FButtonColor write SetButtonColor default clBtnFace; property Frame3D: boolean read F3DFrame write Set3DFrame default False; end;
procedure Register;
implementation
{ TColorBtn }
constructor TColorBtn.Create(AOwner: TComponent); begin inherited Create(AOwner); Height := 21; FCanvas := TCanvas.Create; FButtonColor := clBtnFace; F3DFrame := False; end;
destructor TColorBtn.Destroy; begin FCanvas.Free; inherited Destroy; end;
procedure TColorBtn.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do Style := Style or BS_OWNERDRAW; end;
procedure TColorBtn.Set3DFrame(Value: boolean); begin if F3DFrame <> Value then F3DFrame := Value; end;
procedure TColorBtn.SetButtonColor(Value: TColor); begin if FButtonColor <> Value then begin FButtonColor := Value; Invalidate; end; end;
procedure TColorBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk); begin Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos)); end;
procedure TColorBtn.SetButtonStyle(ADefault: Boolean); begin if IsFocused <> ADefault then IsFocused := ADefault; end;
procedure TColorBtn.CNDrawItem(var Message: TWMDrawItem); var RC: TRect; Flags: Longint; State: TButtonState; IsDown, IsDefault: Boolean; DrawItemStruct: TDrawItemStruct; begin DrawItemStruct := Message.DrawItemStruct^; FCanvas.Handle := DrawItemStruct.HDC; RC := ClientRect; with DrawItemStruct do begin IsDown := ItemState and ODS_SELECTED <> 0; IsDefault := ItemState and ODS_FOCUS <> 0; if not Enabled then State := bsDisabled else if IsDown then State := bsDown else State := bsUp; end; Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT; if IsDown then Flags := Flags or DFCS_PUSHED; if DrawItemStruct.ItemState and ODS_DISABLED <> 0 then Flags := Flags or DFCS_INACTIVE; if IsFocused or IsDefault then begin FCanvas.Pen.Color := clWindowFrame; FCanvas.Pen.Width := 1; FCanvas.Brush.Style := bsClear; FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom); InflateRect(RC, -1, -1); end; if IsDown then begin FCanvas.Pen.Color := clBtnShadow; FCanvas.Pen.Width := 1; FCanvas.Rectangle(RC.Left, RC.Top, RC.Right, RC.Bottom); InflateRect(RC, -1, -1); if F3DFrame then begin FCanvas.Pen.Color := FButtonColor; FCanvas.Pen.Width := 1; DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags); end; end else DrawFrameControl(DrawItemStruct.HDC, RC, DFC_BUTTON, Flags); FCanvas.Brush.Color := FButtonColor; FCanvas.FillRect(RC); InflateRect(RC, 1, 1); if IsFocused then begin RC := ClientRect; InflateRect(RC, -1, -1); end; FCanvas.Font := Self.Font; if IsDown then OffsetRect(RC, 1, 1); DrawButtonText(Caption, RC, State, 0); if IsFocused and IsDefault then begin RC := ClientRect; InflateRect(RC, -4, -4); FCanvas.Pen.Color := clWindowFrame; Windows.DrawFocusRect(FCanvas.Handle, RC); end; FCanvas.Handle := 0; end;
procedure TColorBtn.CalcuateTextPosition(const Caption: string; var TRC: TRect; BiDiFlags: Integer); var TB: TRect; TS, TP: TPoint; begin with FCanvas do begin TB := Rect(0, 0, TRC.Right + TRC.Left, TRC.Top + TRC.Bottom); DrawText(Handle, PChar(Caption), Length(Caption), TB, DT_CALCRECT or BiDiFlags); TS := Point(TB.Right - TB.Left, TB.Bottom - TB.Top); TP.X := ((TRC.Right - TRC.Left) - TS.X + 1) div 2; TP.Y := ((TRC.Bottom - TRC.Top) - TS.Y + 1) div 2; OffsetRect(TB, TP.X + TRC.Left, TP.Y + TRC.Top); TRC := TB; end; end;
procedure TColorBtn.DrawButtonText(const Caption: string; TRC: TRect; State: TButtonState; BiDiFlags: Integer); begin with FCanvas do begin CalcuateTextPosition(Caption, TRC, BiDiFlags); Brush.Style := bsClear; if State = bsDisabled then begin OffsetRect(TRC, 1, 1); Font.Color := clBtnHighlight; DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags); OffsetRect(TRC, -1, -1); Font.Color := clBtnShadow; DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags); end else DrawText(Handle, PChar(Caption), Length(Caption), TRC, DT_CENTER or DT_VCENTER or BiDiFlags); end; end;
procedure Register; begin RegisterComponents('Controls', [TColorBtn]); end;
end. |
Небольшое дополнение. Кнопку по прежнему рисует WINDOWS, а раскрашивает ее ColorBtn. Код компонента на 90% повторяет код BitBtn, ничего необычного здесь нет. Хочется повторить слова Калверта – "Пользуйтесь исходным кодом". Чаще заглядывайте в VCL - можно найти много интересного.
©Drkb::01237
В книгах Калверта, Свана и других авторов можно найти похожий текст. Смысл текста – "Изменить цвет кнопок Button, BitBtn нельзя, т.к. их рисует WINDOWS". Если нельзя, но ОЧЕНЬ НУЖНО, то можно.
Небольшой компонент ColorBtn, дает возможность использовать в кнопках цвет. Кроме того, представлено новое свойство - Frame3D, позволяющее получить более реалистичный вид нажатой кнопки. В отличие от API, при изменении значения свойства Frame3D, не требуется переоткрытие компонента.
Примечание. Кнопку по-прежнему рисует WINDOWS, а раскрашивает ее ColorBtn. Код компонента на 90% повторяет код BitBtn, ничего необычного здесь нет. Чаще заглядывайте в VCL - можно найти много интересного. На рисунке представлены ColorButton и ColorBitBtn.
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!