TButtonを継承した新たなコンポーネントを作ってもいいが,いちいちコンポーネントを 作るのも面倒なので,既存のTButtonをサブクラス化してみる. サブクラス化とは,元のウィンドウプロシージャ(WP)を別のものに置き換えて, 元のウィンドウには無い動作を実現するものである.
WPを置き換えるにはSetWindowLongを用いる.
使い方は以下の通り.
SetWindowLong( hwnd, GWL_WNDPROC, DWORD( @NewProc );
新しい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;
このプログラムを実行すると,右ボタンをクリックしたときもボタンがへこんでOnClickイベントが 発生し,「こんにちは」のメッセージが表示される.
SEO | [PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送 | ||