Главная » Delphi » Компоненты » Собственная отрисовка TButton

Собственная отрисовка TButton

12:45
y-soft © (06.04.05 12:14) [8]
Вот пример пользовательской отрисовки кнопки (написан Марко Канту)
[http://www.delphimaster.ru/cgi-bin/forum.pl?id=1112686152&n=0]

unit DdhRound;
 
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
 
type
TDdhRoundBtn = class(TButton)
private
IsFocused: Boolean;
FCanvas: TCanvas;
procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
message WM_LBUTTONDBLCLK;
protected
procedure SetBounds (ALeft, ATop, AWidth, AHeight: Integer); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure SetButtonStyle(ADefault: Boolean); override;
public
constructor Create (AOwner: TComponent); override;
destructor Destroy; override;
published
property Color;
property Width default 100;
property Height default 50;
property ParentShowHint;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnEnter;
property OnExit;
end;
 
procedure Register;
 
implementation
 
constructor TDdhRoundBtn.Create (AOwner: TComponent);
begin
inherited Create (AOwner);
SetBounds (Left, Top, 100, 50);
FCanvas := TCanvas.Create;
end;
 
destructor TDdhRoundBtn.Destroy;
begin
inherited Destroy;
FCanvas.Free;
end;
 
procedure TDdhRoundBtn.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params
do Style := Style or bs_OwnerDraw;
end;
 
procedure TDdhRoundBtn.CreateWnd;
var
hRegion: THandle;
begin
inherited CreateWnd;
hRegion := CreateEllipticRgn (0, 0, Width, Height);
SetWindowRgn (Handle, hRegion, True);
end;
 
procedure TDdhRoundBtn.SetBounds (ALeft, ATop,
AWidth, AHeight: Integer);
var
hRegion: THandle;
begin
inherited SetBounds (ALeft, ATop, AWidth, AHeight);
if HandleAllocated then
begin
hRegion := CreateEllipticRgn (0, 0, AWidth, AHeight);
SetWindowRgn (Handle, hRegion, True);
end;
end;
 
procedure TDdhRoundBtn.CNDrawItem(var Msg: TWMDrawItem);
var
OdsDown, OdsFocus, ActionFocus: Boolean;
Rect: TRect;
begin
// initialize
FCanvas.Handle := Msg.DrawItemStruct^.hDC;
Rect := ClientRect;
Dec (Rect.Right);
Dec (Rect.Bottom);
with Msg.DrawItemStruct^ do
begin
OdsDown := itemState and ODS_SELECTED <> 0;
OdsFocus := itemState and ODS_FOCUS <> 0;
ActionFocus := ItemAction = oda_Focus
end;
 
with FCanvas do
begin
Brush.Color := Color;
if not ActionFocus then
begin
// fill with current color
Brush.Style := bsSolid;
FillRect (Rect);
end;
// do not fill any more
Brush.Style := bsClear;
// draw border if default
if Default or OdsFocus then
begin
Pen.Color := clWindowFrame;
if not ActionFocus then
Ellipse (Rect.Left, Rect.Top,
Rect.Right, Rect.Bottom);
// reduce the area for further operations
InflateRect (Rect, -1, -1);
end;
 
if OdsDown then
begin
// draw gray border all around
Pen.Color := clBtnShadow;
if not ActionFocus then
Ellipse (Rect.Left, Rect.Top,
Rect.Right, Rect.Bottom);
end
else if not ActionFocus then
begin
// gray border (bottom-right)
Pen.Color := clWindowFrame;
Arc (Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
Rect.Left, Rect.Bottom, // start
Rect.Right, Rect.Top); // end
// white border (top-left)
Pen.Color := clWhite;
Arc (Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
Rect.Right, Rect.Top, // start
Rect.Left, Rect.Bottom); // end
// gray border (bottom-right, internal)
Pen.Color := clBtnShadow;
InflateRect (Rect, -1, -1);
Arc (Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, // ellipse
Rect.Left, Rect.Bottom, // start
Rect.Right, Rect.Top); // end
end;
// draw the caption
InflateRect (Rect, - Width div 5, - Height div 5);
if OdsDown then
begin
Inc (Rect.Left, 2);
Inc (Rect.Top, 2);
end;
Font := Self.Font;
if not ActionFocus then
DrawText (FCanvas.Handle, PChar (Caption), -1,
Rect, dt_SingleLine or dt_Center or dt_VCenter);
 
// draw the focus rect around the text
Brush.Style := bsSolid;
Pen.Color:= clBlack;
Brush.Color := clWhite;
if IsFocused or OdsFocus or ActionFocus then
DrawFocusRect (Rect);
end; // with FCanvas and if DrawEntire
FCanvas.Handle := 0;
Msg.Result := 1; // message handled
end;
 
procedure TDdhRoundBtn.CMFontChanged(var Msg: TMessage);
begin
inherited;
Invalidate;
end;
 
procedure TDdhRoundBtn.CMEnabledChanged(var Msg: TMessage);
begin
inherited;
Invalidate;
end;
 
procedure TDdhRoundBtn.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;
 
procedure TDdhRoundBtn.SetButtonStyle (ADefault: Boolean);
begin
if ADefault <> IsFocused then
begin
IsFocused := ADefault;
Invalidate;
end;
end;
 
procedure Register;
begin
RegisterComponents('DDHB', [TDdhRoundBtn]);
end;
 
end.