この発言は
#00694　本田勝彦        さんのRE:複数行のキャプション表示ボタン
に対するコメントです

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

#00917　牧原　博司　　　さん　RE:複数行のキャプション表示ボタン






> CM_DIALOGCHAR に応えてやると可能になりますよ(^^)
> StdCtrls.pas の TButton.CMDialogChar が参考になると思います。

対応してみました。(Lines プロパティの1行目のみ)

unit PanelButton;

interface

uses  Classes, Forms,Messages,Controls, ExtCtrls,Graphics,Sysutils;

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);
    procedure CMDialogChar(var Message: TCMDialogChar);
              message CM_DIALOGCHAR;
  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 ac,ys,xs,i,line_count,ww,fh : integer;
    capstr : String;
    ostyle : TFontStyles;
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
    capstr := FLines[i-1];
// アクセラレータキー対応表示
    ac := Ansipos('&',capstr);
    if (i = 1) and (ac > 0) then
      delete(capstr,ac,1);
// キャプション表示位置調整
    ww := Canvas.TextWidth(capstr);
    Case Alignment of
      taCenter : xs := (width - ww) div 2;
      taLeftJustify : xs := Self.BevelWidth + 1;
      taRightJustify : xs := width - ww - Self.BevelWidth - 1;
    end;
    if xs < 0 then
      xs := 0;
    Canvas.TextOut(xs,ys+(i-1)*fh,capstr);
// アクセラレータキー対応表示
    if (i = 1) and (ac > 0) then
    begin
      ostyle := Canvas.Font.Style;
      Canvas.Font.Style :=  Canvas.Font.Style + [fsUnderline];
      ww := Canvas.TextWidth(copy(capstr,1,ac-1));
      Canvas.TextOut(xs+ww,ys+(i-1)*fh,capstr[ac]);
      Canvas.Font.Style := ostyle;
    end;
  end;
end;

// アクセラレータキー対応
procedure TPanelButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Lines[0]) and CanFocus then
    begin
      Click;
      Result := 1;
    end else
      inherited;
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蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。