TToolButtonを下げたままにしたい

解決

なべ 2013-05-26 22:12:34 No: 44579

TToolButtonのスタイルをtbsdropdownにするとDownが利かなくなるんですが、回避方法をご存じの方は教えて下さい。
環境はDelphi2007+Win7です。

Mr.XRAY 2013-05-27 22:52:15 No: 44580

>TToolButtonのスタイルをtbsdropdownにするとDownが利かなくなるんですが

「利く」とか「利かない」と言われても，具体的なことが分かりませんので，
勝手に Down プロパティが機能しないと解釈します．
私のところでは，「利いて」いるようです．
動作確認は，Windows 7 U64(SP1) + Delphi 2007-R2 Pro です．

procedure TForm1.FormCreate(Sender: TObject);
begin
ToolButton1.Style := tbsDropDown;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ToolButton1.Down := not ToolButton1.Down;
end;

D 2013-05-27 22:58:32 No: 44581

type
  TForm2 = class(TForm)
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    procedure ToolButton1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure WMApp(var Msg: TMessage); message WM_APP;
  public
    { Public 宣言 }
  end;

procedure TForm1.WMApp(var Msg: TMessage);
//ツールバーがtbsDropDownでもDownが効くように
var
l_ToolButton : TToolButton;
begin
l_ToolButton := TToolButton(Msg.LParam);

  if (l_ToolButton <> nil) and (l_ToolButton.Style = tbsDropDown) then
  begin
    l_ToolButton.Down := l_ToolButton.Tag <> 0;
  end;
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
  if (ToolButton1.Tag <> 0) then
  begin
    ToolButton1.Tag := 0;
  end
  else
  begin
    ToolButton1.Tag := 1;
  end;

//SendMessageではうまくいかない
PostMessage(Handle, WM_APP, 0, LPARAM(ToolButton1));
end;

ToolButton1のTagを利用してDownのOn/Offを切り替えています。

なべ 2013-05-28 01:40:54 No: 44582

Clickイベント内でやってもVCL内部で強制的にボタンが上げられているようです。
XE4でも同じなので、仕様なのかもしれません。
苦し紛れにタイマーを使った時間差攻撃を行っていたんですが、エレガントでないですね。

procedure TForm1.ToolButton3Click(Sender: TObject);
begin
Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
ToolButton3.Down := true;
Timer1.Enabled := false;
end;

お教え頂いたPostMessage()方式に変えさせて頂きます。
ありがとうございました。

なべ 2013-05-28 01:47:04 No: 44583

解決とさせて頂きます。

なべ 2013-05-28 01:47:59 No: 44584

チェック忘れ