右クリックでも押せるボタン(ボタンのサブクラス化)


普通のボタンは右クリックには反応しない. ここでは右クリックでも押せる(へこむ)ボタンを作る.

TButtonを継承した新たなコンポーネントを作ってもいいが,いちいちコンポーネントを 作るのも面倒なので,既存のTButtonをサブクラス化してみる. サブクラス化とは,元のウィンドウプロシージャ(WP)を別のものに置き換えて, 元のウィンドウには無い動作を実現するものである.

WPを置き換えるにはSetWindowLongを用いる. 使い方は以下の通り.

SetWindowLong( hwnd, GWL_WNDPROC, DWORD( @NewProc );

hwndは対象となるウィンドウである. 2番目の引数にはGWL_WNDPROCを指定し, 3番目の引数には新たなWPのアドレスをDWORDにキャストして渡す.

新しいWPでは,特定のメッセージだけを処理し,それ以外は元のWPに渡すようにする. SetWindowLongはWPの置き換えに成功すると, 元のWPのアドレスを返すので,これをどこかに保存しておいて新しいWPの中で使う.

以下にプログラム例を示す.

var
  OrgProc: Pointer;

function NewProc( hwnd: HWND; iMsg: UINT;
                  wParam: WPARAM; lParam: LPARAM ): LRESULT; stdcall;
begin
   case iMsg of
    WM_RBUTTONDOWN: iMsg := WM_LBUTTONDOWN;
    WM_RBUTTONUP:   iMsg := WM_LBUTTONUP;
   end;
   Result := CallWindowProc( OrgProc, hwnd, iMsg, wParam, lParam );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   OrgProc := Pointer( SetWindowLong( Button1.Handle ,
                GWL_WNDPROC, DWORD( @NewProc ) ) );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ShowMessage( 'こんにちは' );
end;

この例では,新たなWPの中でWM_RBUTTONDOWNおよびWM_RBUTTONUPを それぞれWM_LBUTTONDOWNおよびWM_LBUTTONUPにすりかえたのち,元のWPに渡している. WPは必ずstdcallで宣言しなければならない.

このプログラムを実行すると,右ボタンをクリックしたときもボタンがへこんでOnClickイベントが 発生し,「こんにちは」のメッセージが表示される.


お問い合わせはメールにて: akasaka@klc.ac.jp

戻る
SEO [PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送