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

#898の同名タイトルの私の発言の一部修正版です。
（解説に誤りがありました）

　下記のサンプルコードの TSampleButton.DoDrawButton を書き換えるか、
オーバーライドして必要な‘ボタン描画’を実装してください。
（参照：DrawFrameControl、DrawEdge などのＡＰＩ）


// ここから 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;
  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 - [csDoubleClicks];
  // ActiveX 化する場合に必要なようです
  ControlStyle := ControlStyle + [csReflector];
end;

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

// 継承元の procedure がオーナードロースタイルを解除するのを防止
procedure TSampleButton.SetButtonStyle(ADefault: Boolean);
begin
  Repaint;
end;

// オーナーが受け取った WM_MEASUREITEM に対応するメッセージ
// 大きさを指定します。
procedure TSampleButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth := Width;
    itemHeight := Height;
  end;
end;

// オーナーが受け取った WM_DRAWITEM に対応するメッセージ
// 渡されたデバイスコンテキストを使って描画します。
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;

// ボタン描画の実装例... と言うにはあまりにショボイですが、
// ボタンの状態は 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 ここまで //===============================

　このサンプルコードは Delphi4 にコンポーネントとしてインストール
して動作テストをしました。


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

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

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