Как создать окно с кнопкой

← →
Nikfel (2009-01-30 00:21) [0]

Подскажите пожалуйста. Как отловить сообщения нажатия на кнопку(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.

← →
Юрий Зотов © (2009-01-30 04:22) [1]

> Как отловить сообщения нажатия на кнопку

Написать еще одну оконную функцию и назначить ее кнопке.
См. SetWindowLong или SetWindowLongPtr.

← →
KSergey © (2009-01-30 10:00) [2]

> function WindowProc(Hwn,Msg,Wpr,Lpr:Longint):Longint; stdcall;
> WM_COMMAND:begin
> case LoWord( Wpr ) of
> 0: begin
> //это срабатывает только на щелчек мышкой
> и скорее всего надо не так делать

Именно так и надо, если вы хотим просто отловить обычное нажатие на кнопку любым образом (левая мышь и все варинты клавиатуры).

И DefWindowProc надо вызывать только если программа сама не обрабатывает то или иное сообщение, если обрабатывает - то не надо.

← →
Nikfel (2009-01-30 20:33) [3]

Нашел информацию на 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.

Поправьте меня если где есть ошибка.

← →
Nikfel (2009-01-30 21:29) [4]

Так ли добавить 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]
> Поправьте меня если где есть ошибка.

действительно, зачем читать предыдущие сообщения и, тем более, реагировать на них? Лучше выкатить весь свой "шедевр" - пусть остальные в нем разбираются.
чукча не читатеть, чукча - писатель.

← →
Nikfel (2009-01-31 13:03) [6]

Возможно ли когда при нажатии на кнопку когда убираешь курсор, чтобы кнопка оставалась в нажатом состоянии, а при отпускании кнопки мыши кнопка снова возвращалось в обычное состояние? А то у меня как-то не хорошо получилась простенькая программа для получения текста, если известно хандле под курсором мыши.

Пример программы, которая способна получать текст под звездочками:
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.

Как создать окно с кнопкой Найти похожие ветки