-
Подскажите пожалуйста. Как отловить сообщения нажатия на кнопку(WM_LBUTTONDOWN)? Вот код программы: program Project1;
uses Windows, Messages, ShellApi;
{$R *.res}
var Instance:Hwnd; WindowClass:TWndClass; Handle, Handle1:Hwnd; Msg:TMsg; icon:Hicon; Procedure DoExit; begin halt; end;
function WindowProc(Hwn,Msg,Wpr,Lpr:Longint):Longint; stdcall; begin Result:=DefWindowProc(Hwn,Msg,Wpr,Lpr); case Msg of wm_destroy:DoExit; WM_COMMAND:begin case LoWord( Wpr ) of 0: begin //это срабатывает только на щелчек мышкой и скорее всего надо не так делать MessageBox( Handle, 'Button', '', MB_OK ); SetFocus(Handle1); end; end; end; end; end;
begin icon:=ExtractIcon(0,pchar(paramstr(0)),0); instance:=GetModuleHandle(nil); WindowClass.style:=CS_HREDRAW or CS_VREDRAW; WindowClass.lpfnWndProc:=@WindowProc; WindowClass.hInstance:=Instance; WindowClass.hbrBackground:=color_btnface; WindowClass.lpszclassname:='DX'; WindowClass.hCursor:=LoadCursor(0,IDC_ARROW); WindowClass.hIcon:=icon;
RegisterClass(WindowClass);
Handle:=CreateWindowEx(0,'DX','Form1',WS_SYSMENU,1,1,200,200,0,0,Instance,nil); Handle1:=CreateWindowEx(0,'Button','Button',BS_ICON or WS_VISIBLE or WS_CHILD,5,5,70,30,Handle,0,Instance,nil); SendMessage( Handle1, BM_SETIMAGE, IMAGE_ICON, Icon ); ShowWindow(Handle,sw_show); ShowWindow(Handle1,sw_show); UpdateWindow(Handle); //SetFocus(Handle1); While (GetMessage(msg,0,0,0)) do begin translatemessage(msg); dispatchmessage(msg); end; end.
-
> Как отловить сообщения нажатия на кнопку
Написать еще одну оконную функцию и назначить ее кнопке. См. SetWindowLong или SetWindowLongPtr.
-
> function WindowProc(Hwn,Msg,Wpr,Lpr:Longint):Longint; stdcall; > WM_COMMAND:begin > case LoWord( Wpr ) of > 0: begin > //это срабатывает только на щелчек мышкой > и скорее всего надо не так делать
Именно так и надо, если вы хотим просто отловить обычное нажатие на кнопку любым образом (левая мышь и все варинты клавиатуры).
И DefWindowProc надо вызывать только если программа сама не обрабатывает то или иное сообщение, если обрабатывает - то не надо.
-
Нашел информацию на http://www.delphikingdom.ru/asp/viewitem.asp?catalogid=169. Теперь проблема в том что я не хочу использовать SetWindowLong, а хочу использовать SetWindowLongPtr. Под скажите как объявить эту функцию, она у меня почему-то отсутствует.Большое спасибо за помощь. Вот код программы для примера: program Project1; uses Windows, Messages; {$R *.res} var Instance:Hwnd; WindowClass:TWndClass; Handle, Handle1:Hwnd; Msg:TMsg; icon:Hicon; OldWndProc: TFNWndProc; Procedure DoExit; begin halt; end; function WindowProc(Hwn,Msg,Wpr,Lpr:Longint):Longint; stdcall; begin Result:=DefWindowProc(Hwn,Msg,Wpr,Lpr); case Msg of wm_destroy:DoExit; WM_MOUSEMOVE:SendMessage(Handle, WM_SETTEXT, 0, Integer(pchar('Window'))); WM_COMMAND:begin case LoWord( Wpr ) of 0: begin MessageBox( Handle, 'Button', '', MB_OK ); SetFocus(Handle1); end; end; end; wm_keydown:begin if wpr=VK_RETURN then DoExit; end; end; end; function WindowProcButton(Hwn,Msg,Wpr,Lpr:Longint): Longint; stdcall; begin if Msg=WM_KillFocus then begin // Обработка события end else begin Result:=CallWindowProc(OldWndProc, Hwn, Msg, Wpr, Lpr); case Msg of //ñîîáùåíèÿ îò êíîïêè WM_MOUSEMOVE:SendMessage(Handle, WM_SETTEXT, 0, Integer(pchar('Мышь над кнопкой'))); end; end; end; begin icon:=LoadImage(hinstance, 'MAINICON', IMAGE_ICON, 0, 0, LR_COLOR); instance:=GetModuleHandle(nil); WindowClass.style:=CS_HREDRAW or CS_VREDRAW; WindowClass.lpfnWndProc:=@WindowProc; WindowClass.hInstance:=Instance; WindowClass.hbrBackground:=color_btnface; WindowClass.lpszclassname:='DX'; WindowClass.hCursor:=LoadCursor(0,IDC_ARROW); WindowClass.hIcon:=icon; RegisterClass(WindowClass); Handle:=CreateWindowEx(0,'DX','Window',WS_SYSMENU,0,0,200,200,0,0,Instance,nil); Handle1:=CreateWindowEx(0,'Button','',BS_ICON or WS_VISIBLE or WS_CHILD,5,5,70,30,Handle,0,Instance,nil); OldWndProc:=TFNWndProc(SetWindowLong(Handle1, GWL_WndProc, Longint(@WindowProcButton))); SendMessage( Handle1, BM_SETIMAGE, IMAGE_ICON, Icon ); ShowWindow(Handle,sw_show); ShowWindow(Handle1,sw_show); UpdateWindow(Handle); SetFocus(Handle1); While (GetMessage(msg,0,0,0)) do begin translatemessage(msg); dispatchmessage(msg); end; end. Поправьте меня если где есть ошибка.
-
Так ли добавить SetWindowLongPtr?
Добавил в Windows.pas вот такой код: function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: LONG_PTR): LONG_PTR; stdcall; function SetWindowLongPtrA(hWnd: HWND; nIndex: Integer; dwNewLong: LONG_PTR): LONG_PTR; stdcall; function SetWindowLongPtrW(hWnd: HWND; nIndex: Integer; dwNewLong: LONG_PTR): LONG_PTR; stdcall;
{$EXTERNALSYM SetWindowLongPtr} function SetWindowLongPtr(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; stdcall; {$EXTERNALSYM SetWindowLongPtrA} function SetWindowLongPtrA(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; stdcall; {$EXTERNALSYM SetWindowLongPtrW} function SetWindowLongPtrW(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; stdcall;
-
> Nikfel (30.01.09 20:33) [3] > Поправьте меня если где есть ошибка.
действительно, зачем читать предыдущие сообщения и, тем более, реагировать на них? Лучше выкатить весь свой "шедевр" - пусть остальные в нем разбираются. чукча не читатеть, чукча - писатель.
-
Возможно ли когда при нажатии на кнопку когда убираешь курсор, чтобы кнопка оставалась в нажатом состоянии, а при отпускании кнопки мыши кнопка снова возвращалось в обычное состояние? А то у меня как-то не хорошо получилась простенькая программа для получения текста, если известно хандле под курсором мыши.
Пример программы, которая способна получать текст под звездочками: program Project1;
uses Windows, Messages;
{$R *.res} const idTimer = 1;
var Instance:Hwnd; WindowClass:TWndClass; Handle, Button1, Edit1:Hwnd; Msg:TMsg; icon:Hicon; OldWndProc: TFNWndProc; Procedure DoExit; begin halt; end;
function GetWindText(AHandle: THandle): String; var cb : DWord; begin cb := SendMessage(AHandle, WM_GETTEXTLENGTH, 0, 0); SetLength(Result, cb); if cb > 0 then SendMessage(AHandle, WM_GETTEXT, cb+1, LParam(@Result[1])); end;
function WindowProc(Hwn,Msg,Wpr,Lpr:Longint):Longint; stdcall; var t:Tpoint; strS:string; begin Result:=DefWindowProc(Hwn,Msg,Wpr,Lpr); case Msg of wm_destroy:DoExit; wm_timer:begin case ( Wpr ) of idTimer:begin GetCursorPos(t); strS:=GetWindText(WindowFromPoint(t)); SendMessage(Edit1, WM_SETTEXT, 0, Integer(strS)); // При отпускании левой кнопки мыши if (getkeystate(VK_LBUTTON)<>-128) and (getkeystate(VK_LBUTTON)<>-127) then begin killtimer( Handle, idTimer ); end; end; end; end; end; end;
function NewWindowProc(Hwn,Msg,Wpr,Lpr:Longint): Longint; stdcall; begin if Msg=WM_KillFocus then begin // Обработка события end else begin Result:=CallWindowProc(OldWndProc, Hwn, Msg, Wpr, Lpr); case Msg of WM_LBUTTONDOWN:begin settimer( Handle, idTimer, 10, nil ); end; end; end; end;
begin icon:=LoadImage(hinstance, 'MAINICON', IMAGE_ICON, 0, 0, LR_COLOR); instance:=GetModuleHandle(nil); WindowClass.style:=CS_HREDRAW or CS_VREDRAW; WindowClass.lpfnWndProc:=@WindowProc; WindowClass.hInstance:=Instance; WindowClass.hbrBackground:=color_btnface; WindowClass.lpszclassname:='DX'; WindowClass.hCursor:=LoadCursor(0,IDC_ARROW); WindowClass.hIcon:=icon;
RegisterClass(WindowClass);
Handle:=CreateWindowEx(0,'DX','Window',WS_SYSMENU,1,1,243,70,0,0,Instance,nil); Button1:=CreateWindowEx(0,'Button','',BS_ICON or WS_VISIBLE or WS_CHILD,200,5,32,32,Handle,0,Instance,nil); Edit1:=CreateWindowEx(WS_EX_CLIENTEDGE,'Edit','',ES_AUTOHSCROLL or WS_VISIBLE or WS_CHILD,5,10,190,20,Handle,0,Instance,nil); OldWndProc:=TFNWndProc(SetWindowLongPtr(button1, GWL_WndProc, Longint(@NewWindowProc)));
SendMessage( button1, BM_SETIMAGE, IMAGE_ICON, Icon ); ShowWindow(Handle,sw_show); ShowWindow(button1,sw_show); ShowWindow(Edit1,sw_show); UpdateWindow(Handle); SetFocus(Edit1); While (GetMessage(msg,0,0,0)) do begin translatemessage(msg); dispatchmessage(msg); end; end.
|