Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Заюзать метод класса как WindowProc


Страницы:   1 2

SpellCaster ©   (2008-03-26 13:47:00) 

Возникла такая надобность: создать окошко для приёма сообщений для каждого экземпляра класса. По определённым причинам пользоваться AllocateWnd не хочется. Решил воплотить такую схему:
1) При создании объекта создается окно с WindowProc, указывающим на
function InnerWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall;
2) После этого в пользовательскую инфу окна заносится Self
3) При поступлении мессаги в InnerWndProc из польз. инфы окна извлекается Self и вызывается Self.WndProc

ИМХО, вполне неплохое и удобное решение. Проблема в том, что окно создаваться не желает, причём как-то хаотически. Код создания окна:

constructor TMyClass.Create;
var WndClass: TWndClass;
   ClName: string;
begin
 inherited;

 FillChar(WndClass,SizeOf(WndClass),0);
 ClName:=ClassName;
 if not GetClassInfo(HInstance,PChar(ClName),WndClass) then
 begin
   WndClass.hInstance := HInstance;
   WndClass.lpfnWndProc := @InnerWndProc;
   WndClass.lpszClassName := PChar(ClName);
   if windows.RegisterClass(WndClass)=0 then Error(SysErrorMessage(GetLastError));
 end;
 fHwnd:=CreateWindowEx(WS_EX_TOOLWINDOW,WndClass.lpszClassName,'',WS_POPUP,
                       0,0,0,0,0,0,HInstance,nil);
 if fHwnd=0 then Error(SysErrorMessage(GetLastError));
 SetWindowLong(fHwnd,GWL_USERDATA,Integer(Self));
end;


Вот такая процедура работает

function InnerWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall;
var m: TMessage;
   res: Integer;
begin
 m.Msg:=msg; m.WParam:=wParam; m.LParam:=lParam;
 res:=GetWindowLong(wnd,GWL_USERDATA);
 if res=0 then
 begin
   res:=GetLastError;
   MessageBox(0,pchar(SysErrorMessage(res)),'',mb_ok);
 end
 else TMyClass(pointer(res)).WndProc(m);
end;

но стоит закомментить строки с MessageBox - CreateWindowEx возвращает 0, причем код ошибки - тоже 0!
Вот такая конструкция тоже работает
function InnerWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall;
var m: TMessage;
   res: Integer;
begin
 m.Msg:=msg; m.WParam:=wParam; m.LParam:=lParam;
end;
но толку с нее, очевидно, нету.

Что тут за грабли могут быть?

GrayFace   (2008-11-23 04:08:00) [1]

Leonid Troyanovsky ©   (19.11.08 19:29) [29]
Вот, те кто реализовывал ок. проц. на стеке - тот пострадал.
Например я :) Я еще недоумевал, зачем они делают так сложно, когда можно хранить процедуру в самом объекте :)

Leonid Troyanovsky   (2008-11-19 19:36:00) [2]


> Leonid Troyanovsky ©   (19.11.08 19:29) [29]

> AllocateWnd выделяет память честно - for execute.

В смысле MakeObjectInstance, или как его, sorry.

--
Regards, LVT.

Leonid Troyanovsky   (2008-11-19 19:29:00) [3]


> SpellCaster   (26.03.08 17:03) [11]

> У тебя, насколько я понимаю, некий аналог AllocateWnd -
> то же выделение объекта и тот же хак с подменой адресов.
>  Благодарю, однако хочется без читов :)

Сам ты хак и чит.
AllocateWnd выделяет память честно - for execute.
И не подмена, а выделение функции ок. проц. для каждого экз. класса.

Вот, те кто реализовывал ок. проц. на стеке - тот пострадал.
Может даже MFC or SWL, не упомню уж.

--
Regards, LVT.

Leonid Troyanovsky   (2008-11-19 19:20:00) [4]


> guav ©   (26.03.08 17:17) [12]

> Меня больше интересует какие недостатки у более прямого
> пути, без asm кода.

Не понял, что есть "прямой", но GetWindowLong - медленней.
Как, впрочем, и GetProp.

--
Regards, LVT.

SpellCaster   (2008-11-19 13:35:00) [5]

Набрел на еще один способ: случайно узнал о таких полезных функциях, как Get/SetProp. Теперь можно присваивать так:
   SetProp(wnd,PropName,LParam(Self));
и извлекать
 obj := TMyObject(Pointer(GetProp(wnd,PropName)));
 if obj = nil
   then Result := False
   else Result := obj.DialogProc(wnd, msg, wParam, lParam);

Игорь Шевченко   (2008-03-27 15:11:00) [6]

han_malign ©   (27.03.08 13:20) [25]

Не, оно не копируется. Внутре указатель передается.

han_malign   (2008-03-27 13:20:00) [7]


> Уж сколько раз твердили миру:
>
>  MyWnd := CreateWindow ('myclass', 'mycaption',
>                                     WS_OVERLAPPEDWINDOW,
>                                     Integer(CW_USEDEFAULT),
>                                     Integer(CW_USEDEFAULT),
>                                     Integer(CW_USEDEFAULT),
>                                     Integer(CW_USEDEFAULT),
>                                     HWND_DESKTOP, 0,
>                                     HInstance, Self);

- вообще, почитав MSDN, тут лучше перестраховаться и передавать указатель на структуру
packed record
   size: word;
   _self: TObject;
   ....
end;
- потому как не исключено, что это дело нацеливалось на копирование пользовательских данных... скорее всего, конечно, для валидации, но если в очередном сервис-паке Висты все нагнется - я сильно не удивлюсь.

SpellCaster   (2008-03-27 12:53:00) [8]

> [22] SpellCaster   (27.03.08 12:48)

А, ну да, они там GWL_WNDPROC подменяют, прошу прощения.

SpellCaster   (2008-03-27 12:52:00) [9]

> [20] Игорь Шевченко ©   (27.03.08 11:48)

В общем случае - согласен, разумно. Однако в моём случае нужное сообщение только одно, и до определенного момента оно просто не приходит.

SpellCaster   (2008-03-27 12:48:00) [10]

> [21] han_malign ©   (27.03.08 12:17)

RTFM...
function AllocateHWnd(Method: TWndMethod): HWND;
var
 TempClass: TWndClass;
 ClassRegistered: Boolean;
begin
 UtilWindowClass.hInstance := HInstance;
{$IFDEF PIC}
 UtilWindowClass.lpfnWndProc := @DefWindowProc;
{$ENDIF}
 ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
   TempClass);
 if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
 begin
   if ClassRegistered then
     Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
   Windows.RegisterClass(UtilWindowClass);
 end;
 Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
   '', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
 if Assigned(Method) then
   SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

han_malign   (2008-03-27 12:17:00) [11]


> Так в том-то и фишка, что они и так туда пихают указатель!  Только теперь уже на некий фейковый объект.

Да ну? А кусок кода слабо привести где они GWL_USERDATA используют? В D7 и BDS2006 я что-то не нашел...

Игорь Шевченко   (2008-03-27 11:48:00) [12]


> А почему именно так, скажи пожалуйста. Почему нельзя ставить
> после создания окна?


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

SpellCaster   (2008-03-27 11:43:00) [13]

> потому, что кому-то GWL_USERDATA может понадобиться для
> других целей...

Так в том-то и фишка, что они и так туда пихают указатель! Только теперь уже на некий фейковый объект.

SpellCaster   (2008-03-27 11:41:00) [14]

> [15] Игорь Шевченко ©   (26.03.08 20:08)

А почему именно так, скажи пожалуйста. Почему нельзя ставить после создания окна?
> [16] DVM ©   (26.03.08 21:08)

Сейчас сделал 100 штук, вроде работают

han_malign   (2008-03-27 11:40:00) [15]


> Вот почему разрабочики Delphi не пошли по такому пути, а создают код оконного метода динамически ?

- потому, что кому-то GWL_USERDATA может понадобиться для других целей...

DVM   (2008-03-26 21:08:00) [16]


> SpellCaster

При создании нескольких экземпляров класса проблем нету никаких?

Игорь Шевченко   (2008-03-26 20:08:00) [17]


> fHwnd:=CreateWindow(PChar(ClName),'',WS_OVERLAPPEDWINDOW,
>
>                      CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,
> CW_USEDEFAULT,
>                      HWND_DESKTOP, 0, HInstance, nil);
>  if fHwnd=0 then Error(SysErrorMessage(GetLastError));
>  SetWindowLong(fHwnd,GWL_USERDATA,Integer(Self));


В обработке WM_CREATE надо ставить данные в GWL_USERDATA

SpellCaster   (2008-03-26 18:01:00) [18]

И еще одно решение - промежуточная функция внутри класса. Сделано через статический метод класса, поэтому только для БДС2006 и выше.

class TMyClass
...
  class function WndProcSt(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall; static;
...
end

constructor TMyClass.Create(TimOut, sckt: Integer; pAddr: PSockAddrIn);
type Twndproc = function (wnd: hWnd; msg, wParam, lParam: Longint): Longint of object; stdcall;

var WndClass: TWndClass;
   ClName: string;
   w: Twndproc;
begin
   ...
   WndClass.hInstance := HInstance;
   w:=wndprocst;
   WndClass.lpfnWndProc := @w;
   ...
end;

class function TMyClass.WndProcSt(wnd: hWnd; msg, wParam, lParam: Integer): Longint;
var m: TMessage;
   res: Integer;
begin
 if msg = WM_MYMSG then
 begin
   Result:=0;        
   m.Msg:=msg; m.WParam:=wParam; m.LParam:=lParam;
   res:=GetWindowLong(wnd,GWL_USERDATA);
   if res<>0 then //Result:=
   TMyClass(Pointer(res)).WndProc(m);
 end
 else
   Result:=DefWindowProc(wnd,msg,wparam,lparam);
end;

Удобно, что процедура внутри класса. Неудобно, что все равно приходится передавать указатель на экземпляр объекта - т.к. из статического метода можно обращаться только к статическим же полям и методам.

SpellCaster   (2008-03-26 17:37:00) [19]

> [12] guav ©   (26.03.08 17:17)

Ну кроме того, что в принципе любой может затереть эти данные - я недостатков не вижу, кроме того, и VCL-ный способ тоже ведь юзает польз. инфу в окне

Итак, вся трабла действительно была в отсутствии дефолтной оконной процедуры! Вот работающий кусок кода:

function InnerWndProc(wnd: hWnd; msg, wParam, lParam: Longint): Longint; stdcall;
var m: TMessage;
   res: Integer;
begin
 if msg = WM_MYMSG then
 begin
   Result:=0;
   m.Msg:=msg; m.WParam:=wParam; m.LParam:=lParam;
   res:=GetWindowLong(wnd,GWL_USERDATA);
   if res<>0 then
   TMyClass(Pointer(res)).WndProc(m);
 end
 else
   Result:=DefWindowProc(wnd,msg,wparam,lparam);
end;

constructor TMyClass.Create;
var WndClass: TWndClass;
   ClName: string;
begin
 inherited;

 // создаём окно, куда будут приходить все мессаги
 FillChar(WndClass,SizeOf(WndClass),0);
 ClName:=ClassName;
 if not GetClassInfo(HInstance,PChar(ClName),WndClass) then
 begin
   windows.UnregisterClass(PChar(ClName),HInstance);
   WndClass.hInstance := HInstance;
   WndClass.lpfnWndProc := @InnerWndProc;
   WndClass.lpszClassName := PChar(ClName);
   if windows.RegisterClass(WndClass)=0 then Error(SysErrorMessage(GetLastError));
 end;
 fHwnd:=CreateWindow(PChar(ClName),'',WS_OVERLAPPEDWINDOW,
                     CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,
                     HWND_DESKTOP, 0, HInstance, nil);
 if fHwnd=0 then Error(SysErrorMessage(GetLastError));
 SetWindowLong(fHwnd,GWL_USERDATA,Integer(Self));
 SendMessage(fhwnd,WM_MYMSG,123,123); // проверка!
end;


Единственная странность, что при использовании CreateWindowEx c абсолютно теми же параметрами я получал ошибку "Не могу найти указанный файл". Но разбираться не хочется, раз CreateWindow отлично пашет.

guav   (2008-03-26 17:17:00) [20]

> [10] DVM ©   (26.03.08 16:50)

Мало ли, может реализуют копиляцию 64разрядных бинарников для x86-64.

Меня больше интересует какие недостатки у более прямого пути, без asm кода.

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо