Форум: "WinAPI";
Текущий архив: 2010.01.24;
Скачать: [xml.tar.bz2];
ВнизЗаюзать метод класса как WindowProc Найти похожие ветки
← →
SpellCaster (2008-03-26 13:47) [0]Возникла такая надобность: создать окошко для приёма сообщений для каждого экземпляра класса. По определённым причинам пользоваться 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;
но толку с нее, очевидно, нету.
Что тут за грабли могут быть?
← →
SpellCaster (2008-03-26 13:52) [1]А, и самое странное в том, что если я это делаю в главном модуле, то все прекрасно действует
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
form1.Memo1.Lines.Add((SysErrorMessage(GetLastError)))
else
tform1(pointer(res)).Somemethod(0);
end;
procedure wnd;
var WndClass: TWndClass;
ClassRegistered: Boolean;
ClName: string;
w: TWndMethod;
fHwnd: HWND;
begin
FillChar(WndClass,SizeOf(WndClass),0);
ClName:="qwe";
ClassRegistered := GetClassInfo(HInstance,PChar(ClName),WndClass);
if not ClassRegistered then
begin
WndClass.hInstance := HInstance;
WndClass.lpfnWndProc := @InnerWndProc;
WndClass.lpszClassName := PChar(ClName);
if windows.RegisterClass(WndClass)=0 then
raise exception.Create(SysErrorMessage(GetLastError));
end;
fHwnd:=CreateWindowEx(WS_EX_TOOLWINDOW, WndClass.lpszClassName,"", WS_MINIMIZE,
0, 0, 0, 0, 0, 0, HInstance, nil);
if fHwnd=0 then
raise exception.Create(SysErrorMessage(GetLastError));
SetWindowLong(fHwnd,GWL_USERDATA,Integer(form1));
sendmessage(fhwnd,WM_MOVE,0,0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
wnd;
end;
← →
Игорь Шевченко © (2008-03-26 14:13) [2]Уж сколько раз твердили миру:
MyWnd := CreateWindow ("myclass", "mycaption",
WS_OVERLAPPEDWINDOW,
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
HWND_DESKTOP, 0,
HInstance, Self);
в оконной процедуре:
function MyWndProc (Window: HWND; Message, WParam: Cardinal;
LParam: Cardinal): Longint; stdcall;
var
MainClass : TMainWindow;
...
begin
MainClass := TMainWindow(GetWindowLong (Window, GWL_USERDATA));
case Message of
WM_CREATE:
begin
MainClass := TMainWindow(PCreateStruct(LParam)^.lpCreateParams);
SetWindowLong (Window, GWL_USERDATA, Integer(MainClass));
Result := 0;
end;
...........
end;
← →
Reindeer Moss Eater © (2008-03-26 14:19) [3]AllocateHWnd
← →
guav © (2008-03-26 14:47) [4]Вот почему разрабочики Delphi не пошли по такому пути, а создают код оконного метода динамически ?
← →
Игорь Шевченко © (2008-03-26 15:35) [5]
> Вот почему разрабочики Delphi не пошли по такому пути, а
> создают код оконного метода динамически ?
А им uses Classes незазорно втыкать
← →
DVM © (2008-03-26 16:20) [6]function TSCMPBaseClient.AllocWnd: HWND;
var
wc: TWndClassEx;
WndClassName: string;
begin
result := 0;
FObjectInstance := VirtualAlloc(nil, 12, MEM_RESERVE or MEM_COMMIT, PAGE_EXECUTE_READWRITE);
asm
mov EAX, Self
mov ECX, [EAX].TSCMPBaseClient.FObjectInstance
mov word ptr [ECX+0], $6858
mov dword ptr [ECX+2], EAX
mov word ptr [ECX+6], $E950
mov EAX, OFFSET(TSCMPBaseClient.WndProc)
sub EAX, ECX
sub EAX, 12
mov dword ptr [ECX+8], EAX
end;
Str(DWord(Self), WndClassName);
WndClassName := ClassName + ":" + WndClassName;
ZeroMemory(@wc, SizeOf(wc));
wc.cbSize := SizeOf(Wc);
wc.style := CS_HREDRAW or CS_VREDRAW;
wc.hInstance := hInstance;
wc.lpfnWndProc := FObjectInstance;
wc.lpszClassName := pchar(WndClassName);
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
if Windows.RegisterClassEx(wc) = 0 then exit;
result := CreateWindowEx(WS_EX_TOOLWINDOW, pchar(WndClassName), "clientwnd", WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);
end;
← →
DVM © (2008-03-26 16:21) [7]procedure TSCMPBaseClient.DeAllocWnd;
begin
if FWindowHandle <> 0 then DestroyWindow(FWindowHandle);
VirtualFree(FObjectInstance, 0, MEM_RELEASE);
end;
function WndProc(Wnd: THandle; Msg: Cardinal; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
← →
DVM © (2008-03-26 16:22) [8]WndProc - метод класса TSCMPBaseClient в моем случае
← →
guav © (2008-03-26 16:38) [9]> [5] Игорь Шевченко © (26.03.08 15:35)
Я не про то, где это реализовано, я про саму реализацию.
Чем реализация вроде [6] оказалась лучше реализации вроде [2] ?
Я только вижу добавленую проблему пре переходе на другую архитектру процессора.
← →
DVM © (2008-03-26 16:50) [10]
> Я только вижу добавленую проблему пре переходе на другую
> архитектру процессора.
А какая еще может быть другая архитектура у связки Windows + Delphi, кроме x86-32 и x86-64 ?
← →
SpellCaster (2008-03-26 17:03) [11]> [2] Игорь Шевченко © (26.03.08 14:13)
Спасибо, не додумался до такого! Сейчас попробую
> [3] Reindeer Moss Eater © (26.03.08 14:19)
Это как раз то, от чего я хочу уйти
> [6] DVM © (26.03.08 16:20)
У тебя, насколько я понимаю, некий аналог AllocateWnd - то же выделение объекта и тот же хак с подменой адресов. Благодарю, однако хочется без читов :)
----
Блин, я балбес :( совсем забыл WinAPI, там ведь надо дефолтную процедуру вызывать, если мессага не обработана. Конечно, мне приходила WM_NCCREATE, а я на нее ничего не возвращал (т.е. 0 по дефолту), вот окно и удалялось
← →
guav © (2008-03-26 17:17) [12]> [10] DVM © (26.03.08 16:50)
Мало ли, может реализуют копиляцию 64разрядных бинарников для x86-64.
Меня больше интересует какие недостатки у более прямого пути, без asm кода.
← →
SpellCaster (2008-03-26 17:37) [13]> [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 отлично пашет.
← →
SpellCaster (2008-03-26 18:01) [14]И еще одно решение - промежуточная функция внутри класса. Сделано через статический метод класса, поэтому только для БДС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;
Удобно, что процедура внутри класса. Неудобно, что все равно приходится передавать указатель на экземпляр объекта - т.к. из статического метода можно обращаться только к статическим же полям и методам.
← →
Игорь Шевченко © (2008-03-26 20:08) [15]
> 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
← →
DVM © (2008-03-26 21:08) [16]
> SpellCaster
При создании нескольких экземпляров класса проблем нету никаких?
← →
han_malign © (2008-03-27 11:40) [17]
> Вот почему разрабочики Delphi не пошли по такому пути, а создают код оконного метода динамически ?
- потому, что кому-то GWL_USERDATA может понадобиться для других целей...
← →
SpellCaster (2008-03-27 11:41) [18]> [15] Игорь Шевченко © (26.03.08 20:08)
А почему именно так, скажи пожалуйста. Почему нельзя ставить после создания окна?
> [16] DVM © (26.03.08 21:08)
Сейчас сделал 100 штук, вроде работают
← →
SpellCaster (2008-03-27 11:43) [19]> потому, что кому-то GWL_USERDATA может понадобиться для
> других целей...
Так в том-то и фишка, что они и так туда пихают указатель! Только теперь уже на некий фейковый объект.
← →
Игорь Шевченко © (2008-03-27 11:48) [20]
> А почему именно так, скажи пожалуйста. Почему нельзя ставить
> после создания окна?
потому что от момента вызова CreateWindow(Ex) до момента возврата из нее, в оконную процедуру приходит масса сообщений. И вполне вероятно, что некоторые потребуется обработать, уже имея указатель на класс, связанный с окном.
← →
han_malign © (2008-03-27 12:17) [21]
> Так в том-то и фишка, что они и так туда пихают указатель! Только теперь уже на некий фейковый объект.
Да ну? А кусок кода слабо привести где они GWL_USERDATA используют? В D7 и BDS2006 я что-то не нашел...
← →
SpellCaster (2008-03-27 12:48) [22]> [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;
← →
SpellCaster (2008-03-27 12:52) [23]> [20] Игорь Шевченко © (27.03.08 11:48)
В общем случае - согласен, разумно. Однако в моём случае нужное сообщение только одно, и до определенного момента оно просто не приходит.
← →
SpellCaster (2008-03-27 12:53) [24]> [22] SpellCaster (27.03.08 12:48)
А, ну да, они там GWL_WNDPROC подменяют, прошу прощения.
← →
han_malign © (2008-03-27 13:20) [25]
> Уж сколько раз твердили миру:
>
> 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;
- потому как не исключено, что это дело нацеливалось на копирование пользовательских данных... скорее всего, конечно, для валидации, но если в очередном сервис-паке Висты все нагнется - я сильно не удивлюсь.
← →
Игорь Шевченко © (2008-03-27 15:11) [26]han_malign © (27.03.08 13:20) [25]
Не, оно не копируется. Внутре указатель передается.
← →
SpellCaster (2008-11-19 13:35) [27]Набрел на еще один способ: случайно узнал о таких полезных функциях, как 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);
← →
Leonid Troyanovsky © (2008-11-19 19:20) [28]
> guav © (26.03.08 17:17) [12]
> Меня больше интересует какие недостатки у более прямого
> пути, без asm кода.
Не понял, что есть "прямой", но GetWindowLong - медленней.
Как, впрочем, и GetProp.
--
Regards, LVT.
← →
Leonid Troyanovsky © (2008-11-19 19:29) [29]
> SpellCaster (26.03.08 17:03) [11]
> У тебя, насколько я понимаю, некий аналог AllocateWnd -
> то же выделение объекта и тот же хак с подменой адресов.
> Благодарю, однако хочется без читов :)
Сам ты хак и чит.
AllocateWnd выделяет память честно - for execute.
И не подмена, а выделение функции ок. проц. для каждого экз. класса.
Вот, те кто реализовывал ок. проц. на стеке - тот пострадал.
Может даже MFC or SWL, не упомню уж.
--
Regards, LVT.
← →
Leonid Troyanovsky © (2008-11-19 19:36) [30]
> Leonid Troyanovsky © (19.11.08 19:29) [29]
> AllocateWnd выделяет память честно - for execute.
В смысле MakeObjectInstance, или как его, sorry.
--
Regards, LVT.
← →
GrayFace © (2008-11-23 04:08) [31]Leonid Troyanovsky © (19.11.08 19:29) [29]
Вот, те кто реализовывал ок. проц. на стеке - тот пострадал.
Например я :) Я еще недоумевал, зачем они делают так сложно, когда можно хранить процедуру в самом объекте :)
Страницы: 1 вся ветка
Форум: "WinAPI";
Текущий архив: 2010.01.24;
Скачать: [xml.tar.bz2];
Память: 0.54 MB
Время: 0.008 c