この発言は
#00691　風の鳩サブレー  さんのパネルから発生させたボタンコンポーネント
に対するコメントです

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

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

#00694　本田勝彦        さん　RE:複数行のキャプション表示ボタン






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

ボタンに複数行のキャプション表示を追加しました。
Lines プロパティに設定した文字列リストがボタン表面に表示されます。
Captionプロパティは無視します(^^;

フォントの横幅を取得する方法がわからなかったので
うまくボタンの中心に表示されないこともあります。(^^;

欠点としては
１．フォーカスをもてない。
２．アクセラレータキーが使えない。
でしょうか。

unit PanelButton;

interface

uses
  Classes, Controls, ExtCtrls;

type
  TPanelButton = class(TPanel)
  private
    Fpaneldown : boolean;
    FLines : TStrings;
    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;
    procedure Click; override;
    procedure paint;override;
    function  GetLines : TStrings;
    procedure SetLines(Value: TStrings);
  public
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    property Lines : TStrings read GetLines write SetLines;
  end;

procedure Register;

implementation


constructor TPanelButton.Create (AOwner : TComponent);
begin
  inherited Create(AOwner);
  width := 75;
  height := 25;
  Fpaneldown := false;
  Flines := TStringList.create;
end;

destructor TPanelButton.Destroy;
begin
  Flines.Free;
  inherited Destroy;
end;


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

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

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

procedure TPanelButton.Click;
begin
  BevelOuter := bvRaised;
  Fpaneldown := false;
  inherited;
end;

//再描画処理　
procedure TPanelButton.paint;
var ys,xs,i,line_count,wh,ww,fh : integer;
begin
  caption := '';
  line_count := Lines.Count;
  if line_count = 0 then
    FLines.add(name);
  inherited;
  line_count := Lines.Count;
  fh := abs(Font.Height);
  ys := (height - (fh * line_count)) div 2;
  if ys < 0 then
    ys := 0;
  for i := 1 to line_count do
  begin
    xs := (width - length(FLines[i-1])*(fh div 2)) div 2;
    if xs < 0 then
      xs := 0;
    canvas.TextOut(xs,ys+(i-1)*fh,Flines[i-1]);
  end;
end;


procedure TPanelButton.SetLines(Value : TStrings);
begin
  FLines.Assign(Value);
  paint;
end;

function TPanelButton.GetLines : TStrings;
begin
  result := FLines;
end;


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

end.

風の鳩サブレー (JBG03220)

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

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