【タイトル】オーナードロー‘だけ’のボタンです。

　DoDrawButton を書き換えるか、オーバーライドして必要な描画内容を
実装してください（参照：DrawFrameControl ＡＰＩ）。
　また、リソースの保護やマルチスレッド間の排他処理などのコードは、
必要に応じて追加してください。

// ここから SampleButton.pas //===============================
unit SampleButton;

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms, StdCtrls;

type
  TDrawByIndexEvent = procedure (Sender: TObject; Canvas: TCanvas;
    itemState: Integer) of object;

  TSampleButton = class(TButton)
  private
    FOnDraw: TDrawByIndexEvent;
  private
    procedure CNMeasureItem(var Message: TWMMeasureItem);
      message CN_MEASUREITEM;
    procedure CNDrawItem(var Message: TWMDrawItem);
      message CN_DRAWITEM;
    procedure CMEnabledChanged(var Message: TMessage);
      message CM_ENABLEDCHANGED;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(ADefault: Boolean); override;
    procedure DoDrawButton(Canvas: TCanvas; State: Integer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Color;
    property OnDraw: TDrawByIndexEvent read FOnDraw write FOnDraw;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TSampleButton]);
end;

constructor TSampleButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // オーナードローメッセージをオーナーから返してもらいます。
  ControlStyle := ControlStyle + [csReflector];
end;

procedure TSampleButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  // オーナードローメッセージがオーナーに渡るようにします。
  with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TSampleButton.SetButtonStyle(ADefault: Boolean);
begin
  Refresh;
end;

procedure TSampleButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth := Width;
    itemHeight := Height;
  end;
end;

// オーナーから返されたオーナードローメッセージを処理する
procedure TSampleButton.CNDrawItem(var Message: TWMDrawItem);
var
  Canvas: TCanvas;
begin
  with Message.DrawItemStruct^ do
  begin
    Canvas := TCanvas.Create;
    Canvas.Handle := hDC;
    // 描画の実装は仮想関数に任せます。
    DoDrawButton(Canvas, itemState);
    Canvas.Handle := 0;
    Canvas.Free;
  end;
end;

procedure TSampleButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TSampleButton.WMLButtonDblClk(var Message: 
TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;

// ボタン描画の実装例... と言うにはあまりにショボイですが、
// ボタンの状態は State で取得します。
// （Win32ヘルプの DRAWITEMSTRUCT の項の itemState を参照）
procedure TSampleButton.DoDrawButton(Canvas: TCanvas; State: Integer);
begin
  if Assigned(FOnDraw) then
    // イベントハンドラに任せる場合です
    FOnDraw(Self, Canvas, State)
  else
  begin
    // 下地を塗る
    Canvas.Brush.Color := Color;
    Canvas.FillRect(ClientRect);
    // 外枠が見えないと配置を設計しにくいので
    if csDesigning in ComponentState then
    begin
      Canvas.Pen.Style := psDot;
      Canvas.Pen.Color := clBlack;
      Canvas.Brush.Style := bsClear;
      Canvas.Rectangle(0, 0, Width, Height);
    end;
    // フォーカスがある場合
    if (State and ODS_FOCUS) <> 0 then
    begin
      Canvas.Pen.Color := clWindowFrame;
      Canvas.Brush.Color := clBtnFace;
      DrawFocusRect(Canvas.Handle, ClientRect);
    end;
    // 押されている場合
    if (State and ODS_SELECTED) <> 0 then
      Canvas.TextOut(2, 2, 'DOWN');
  end;
end;

end.
// SampleButton.pas ここまで //===============================


1999/06/29、河邦 正（GCC02240@nifty.ne.jp）
（http://member.nifty.ne.jp/kht0000/ 自作ComponentのNifty外へ公開用）

Original document by 河邦 正         氏 ID:(GCC02240)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。