Текущий архив: 2010.08.27;
Скачать: CL | DM;

Вниз

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

← →
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;

---

← →
KSergey ©   (2009-01-31 06:39) [5]

> 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.

---

Страницы: 1 вся ветка

Текущий архив: 2010.08.27;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.15 c