K210.ORG

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.