この発言に対し以下のコメントが寄せられています

#00692　風の鳩サブレー  さん　複数行のキャプション表示ボタン






コンポセミナーにもいったことだし、TPanelから発生した
ボタンコンポーネントを作ってみました。
これだとボタンやキャプションの色、べベルの幅も変えられます。


unit PanelButton;

interface

uses
  Classes, Controls, ExtCtrls;

type
  TPanelButton = class(TPanel)
  private
    paneldown : boolean;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  end;

procedure Register;

implementation


constructor TPanelButton.Create (AOwner : TComponent);
begin
  inherited Create(AOwner);
end;

destructor TPanelButton.Destroy;
begin
  inherited Destroy;
  paneldown := false;
end;


procedure TPanelButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Self.BevelOuter := bvLowered;
  paneldown := true;
  inherited;
end;

procedure TPanelButton.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Self.BevelOuter := bvRaised;
  paneldown := false;
  inherited;
end;

procedure TPanelButton.MouseMove(Shift: TShiftState; X,Y: Integer);
begin
// ボタン上にカーソルが無いときは押されていない状態にする
  if ((x < 0) or (y < 0) or (x > Self.width) or (y > Self.height)) then
  begin
    if Self.BevelOuter = bvLowered then
      Self.BevelOuter := bvRaised;
  end
// ボタン上にカーソルが有り押されている場合はへこませる
  else if paneldown and (Self.BevelOuter = bvRaised) then
      Self.BevelOuter := bvLowered;
    inherited;
end;


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

end.

Original document by 風の鳩サブレー  氏 ID:(JBG03220)

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