-
Доброго времени суток! Столкнулся с проблемой перехвата сообщений или событий окном созданным средствами WinAPI.<br> В общем я создаю класс окна в одном модуле(wnd.pas) и дочерний класс в другом(main.pas), при этом у меня одна локальная процедура WndProc для всех окон. Я пробовал прописывать в дочернем классе процедуру для перехвата сообщений как делал это раньше на VCL procedure WMPaint(var Msg : TWMPaint); message wm_paint; Ничего не получилось, наверное я неправильно понимаю как работает такой способ перехвата, может быть надо присваивать каждому классу свой хэндл, ведь сообщения посылаются владельцу хэндла, но я не знаю как такое реализовать. <br> Теперь пробую сделать события как на VCL (onPaint), но тоже пока безуспешно. Заранее спасибо!
-
У Вас должен после CreateWindowEx запускацца цикл обработки сообщений...до Application.Terminate. Советую глянуть примеры на masm32
-
Показывай код
-
Цикл обработки сообщений у меня для всех окон один - это
function WndProc(wnd: HWND; msg: integer; wParam: wParam; lParam: lParam): lResult; stdCall;
begin
result:=0;
case msg of
wm_Destroy:
begin
PostQuitMessage(0);
Exit
end;
else Result:=DefWindowProc(wnd,msg,wparam,lparam)
end;
end;
Прописывать обработку сообщений здесь не получиться т.к. окон может быть много, да и доступа к модулю main.pas из модуля wnd.pas нет и быть не должно(пишу с расчетом на то, что в будующем буду пользоваться этим модулем и в других программах). Единственный вариант - это прописать там события класса tApp, который создается в модуле wnd.pas и тот в свою очередь будет обрабатывать события главного окна, а оно обрабатывать события дочернего окна и т.д.
tFormClass = class of tFrm;
tApp = class
private
MainForm: tFrm;
public
constructor Create;
destructor Destroy; override;
procedure CreateForm(FormClass: tFormClass; var FormName);
procedure Run;
end;
И по этому я хотел прописать перехват только нужных сообщений в дочернем классе формы который описывается в main.pas
tMainForm = class(tFrm)
procedure FormCreate;
private
procedure Load;
procedure Draw;
protected
procedure WMPaint(var Msg : TWMPaint); message wm_paint;
end;
Но процедура WMPaint не выполняется даже если в WndProc отсылать сообщение о перересовке. Так же покажу процедуру для создания формы в классе tApp, потому, что этот код мне не полностью понятен, я его переписывал из forms.pas, может быть я тут допустил ошибку, но он работает, форма создается.
procedure tApp.CreateForm(FormClass: tFormClass; var FormName);
var
Form: tFrm;
begin
Form:=tFrm(FormClass.NewInstance);
tFrm(FormName):=Form;
try
Form.Create;
except
tFrm(FormName) := nil;
raise;
end;
if MainForm = nil then begin
MainForm := TFrm(Form);
end;
end;
-
> Цикл обработки сообщений у меня для всех окон один - это
Это не цикл, не выдумывай.
-
ну да, не цикл - обработка сообщений. Цикл здесь и однин для всей программы
procedure tApp.Run;
var
Msg: tMsg;
begin
if not MainForm.CreateWnd then exit;
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end
end;
или его для каждой формы свой нужно создавать??? создание формы выглядит так
function tFrm.CreateWnd: boolean;
var
wc: tWndClassEx;
begin
result:=true;
zeromemory(@wc,sizeof(wc));
with wc do begin
cbSize:=sizeof(wc);
style:=cs_hredraw or cs_vredraw;
wc.cbClsExtra:=0;
wc.cbWndExtra:=0;
lpfnWndProc:=@WndProc;
wc.hInstance:=HInstance;
wc.hIcon:=LoadIcon(0,idi_application);
hCursor:=LoadCursor(0, idc_Arrow);
wc.hbrBackground:=COLOR_BTNFACE+1;
wc.lpszMenuName:=nil;
lpszClassName:=cName;
end;
if RegisterClassEx(wc)=0 then
result:=false
else
handle:=CreateWindowEx(WS_EX_TOPMOST or WS_EX_TOOLWINDOW, cName, capt, WS_POPUP, left, top, width, height, 0, 0, HInstance, nil);
if handle=0 then begin
result:=false;
exit
end;
show
end;
-
> Цикл здесь и однин для всей программы
Не для "всей программы", а для для окон, созданных в тек.треде.
> function tFrm.CreateWnd: boolean;
Сравни с
procedure TApplication.CreateHandle;
и сделай выводы.
-
Сравню, когда окажусь за компьютером, а пока могу только предполагать или ждать прямого ответа на вопрос.
-
А ради чего вся эта жуткая каша из окон и форм тобой заварена ?
-
Пишу на чистом WinAPI, получаю мелкий размер программы, больший контроль над программой, учусь, получаю удовольствия от программирования больше чем на VCL...
-
> учусь, получаю удовольствия
Похвально)
-
> Galiaf (18.02.08 13:45) [9]
> Пишу на чистом WinAPI, получаю мелкий размер программы,
Понятно. Мазохист.
Лучше получи удовольствие от книги.
Например, Чарльз Калверт. Дельфи Х: Энциклопедия пользовавателя.
--
Regards, LVT.
-
О чем книга? Сколько весит?
-
> Galiaf (18.02.08 14:15) [12]
> О чем книга? Сколько весит?
Про дельфи, вестимо.
Кг 1.5 бумаги.
--
Regards, LVT.
-
А по-подробнее можно?
-
> Galiaf (18.02.08 14:38) [14]
> А по-подробнее можно?
Подробнее можно в библиотеке.
--
Regards, LVT.
-
Вернемся к теме: ближайшие 8-9 часов компьютера я не увижу, а по этому прошу написать мне код процедуры TApplication.CreateHandle; для дальнейшего изучения. Спасибо.
-
procedure TApplication.CreateHandle;
var
TempClass: TWndClass;
SysMenu: HMenu;
begin
if not FHandleCreated
and not IsConsole then
then
begin
FObjectInstance := WinUtils.MakeObjectInstance(WndProc);
FObjectInstance := Classes.MakeObjectInstance(WndProc);
WindowClass.lpfnWndProc := @DefWindowProc;
if not GetClassInfo(HInstance, WindowClass.lpszClassName, TempClass) then
begin
WindowClass.hInstance := HInstance;
if Windows.RegisterClass(WindowClass) = 0 then
raise EOutOfResources.Create(SWindowClass);
end;
FHandle := CreateWindow(WindowClass.lpszClassName, PChar(FTitle),
WS_POPUP or WS_CAPTION or WS_CLIPSIBLINGS or WS_SYSMENU
or WS_MINIMIZEBOX,
GetSystemMetrics(SM_CXSCREEN) div 2,
GetSystemMetrics(SM_CYSCREEN) div 2,
0, 0, 0, 0, HInstance, nil);
FTitle := '';
FHandleCreated := True;
SetWindowLong(FHandle, GWL_WNDPROC, Longint(FObjectInstance));
if NewStyleControls then
begin
SendMessage(FHandle, WM_SETICON, 1, GetIconHandle);
SetClassLong(FHandle, GCL_HICON, GetIconHandle);
end;
SysMenu := GetSystemMenu(FHandle, False);
DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND);
DeleteMenu(SysMenu, SC_SIZE, MF_BYCOMMAND);
if NewStyleControls then DeleteMenu(SysMenu, SC_MOVE, MF_BYCOMMAND);
end;
end;
-
Это мазохизм? Зачем пытаться повторять VCl, в API принято писать несколько по другому.
-
С этого места по-подробнее
|
Есть новые 
Нет новых [134431 +15][b:0][p:0.003]