Перехват сообщений самодельным окном.

← →
Galiaf © (2008-02-18 00:24) [0]

Доброго времени суток! Столкнулся с проблемой перехвата сообщений или событий окном созданным средствами WinAPI.<br>
В общем я создаю класс окна в одном модуле(wnd.pas) и дочерний класс в другом(main.pas), при этом у меня одна локальная процедура WndProc для всех окон. Я пробовал прописывать в дочернем классе процедуру для перехвата сообщений как делал это раньше на VCL
procedure WMPaint(var Msg : TWMPaint); message wm_paint;
Ничего не получилось, наверное я неправильно понимаю как работает такой способ перехвата, может быть надо присваивать каждому классу свой хэндл, ведь сообщения посылаются владельцу хэндла, но я не знаю как такое реализовать. <br>
Теперь пробую сделать события как на VCL (onPaint), но тоже пока безуспешно.
Заранее спасибо!

← →
Бегущий человек © (2008-02-18 03:45) [1]

У Вас должен после CreateWindowEx запускацца цикл обработки сообщений...до Application.Terminate. Советую глянуть примеры на masm32

← →
Сергей М. © (2008-02-18 09:22) [2]

Показывай код

← →
Galiaf © (2008-02-18 10:38) [3]

Цикл обработки сообщений у меня для всех окон один - это
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;//case 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;

← →
Сергей М. © (2008-02-18 11:04) [4]

> Цикл обработки сообщений у меня для всех окон один - это

Это не цикл, не выдумывай.

← →
Galiaf © (2008-02-18 11:33) [5]

ну да, не цикл - обработка сообщений. Цикл здесь и однин для всей программы
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;

← →
Сергей М. © (2008-02-18 12:01) [6]

> Цикл здесь и однин для всей программы

Не для "всей программы", а для для окон, созданных в тек.треде.

> function tFrm.CreateWnd: boolean;

Сравни с

procedure TApplication.CreateHandle;

и сделай выводы.

← →
Galiaf (2008-02-18 12:38) [7]

Сравню, когда окажусь за компьютером, а пока могу только предполагать или ждать прямого ответа на вопрос.

← →
Сергей М. © (2008-02-18 12:49) [8]

А ради чего вся эта жуткая каша из окон и форм тобой заварена ?

← →
Galiaf (2008-02-18 13:45) [9]

Пишу на чистом WinAPI, получаю мелкий размер программы, больший контроль над программой, учусь, получаю удовольствия от программирования больше чем на VCL...

← →
Сергей М. © (2008-02-18 13:58) [10]

> учусь, получаю удовольствия

Похвально)

← →
Leonid Troyanovsky © (2008-02-18 13:59) [11]

> Galiaf (18.02.08 13:45) [9]

> Пишу на чистом WinAPI, получаю мелкий размер программы,

Понятно. Мазохист.
Лучше получи удовольствие от книги.
Например, Чарльз Калверт. Дельфи Х: Энциклопедия пользовавателя.

--
Regards, LVT.

← →
Galiaf (2008-02-18 14:15) [12]

О чем книга? Сколько весит?

← →
Leonid Troyanovsky © (2008-02-18 14:23) [13]

> Galiaf (18.02.08 14:15) [12]

> О чем книга? Сколько весит?

Про дельфи, вестимо.
Кг 1.5 бумаги.

--
Regards, LVT.

← →
Galiaf (2008-02-18 14:38) [14]

А по-подробнее можно?

← →
Leonid Troyanovsky © (2008-02-18 14:53) [15]

> Galiaf (18.02.08 14:38) [14]

> А по-подробнее можно?

Подробнее можно в библиотеке.

--
Regards, LVT.

← →
Galiaf (2008-02-18 15:35) [16]

Вернемся к теме: ближайшие 8-9 часов компьютера я не увижу, а по этому прошу написать мне код процедуры TApplication.CreateHandle; для дальнейшего изучения. Спасибо.

← →
Сергей М. © (2008-02-18 15:38) [17]

procedure TApplication.CreateHandle; var TempClass: TWndClass; SysMenu: HMenu; begin if not FHandleCreated {$IFDEF MSWINDOWS} and not IsConsole then {$ENDIF} {$IFDEF LINUX} then {$ENDIF} begin {$IFDEF LINUX} FObjectInstance := WinUtils.MakeObjectInstance(WndProc); {$ENDIF} {$IFDEF MSWINDOWS} FObjectInstance := Classes.MakeObjectInstance(WndProc); {$ENDIF} 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;

← →
dsoft © (2008-02-19 01:13) [18]

Это мазохизм? Зачем пытаться повторять VCl, в API принято писать несколько по другому.

← →
Galiaf (2008-02-19 01:26) [19]

С этого места по-подробнее

← →
Сергей М. © (2008-02-19 10:01) [20]

> Galiaf (19.02.08 01:26) [19]

Ключевой момент во всей этой бодяге, что ты затеял, - ф-ция MakeObjectInstance().

← →
Galiaf © (2008-02-19 10:42) [21]

> Сергей М. © (19.02.08 10:01) [20]

Щас копну в этом направлении, хотя как приспособить его у меня пока не знаю

← →
Galiaf © (2008-02-19 10:54) [22]

function MakeObjectInstance(Method: TWndMethod): Pointer; - кучка непонятного кода, буду разбираться...

← →
Galiaf © (2008-02-19 11:22) [23]

Полностью переписал процедуру CreateHandle, все равно не форма не хочет перехватывать сообщения. Не исключаю тот вариант, что я сделал это неправильно.

← →
Сергей М. © (2008-02-19 11:24) [24]

> Не исключаю тот вариант, что я сделал это неправильно

Как ни странно, я тоже не исключаю)

← →
Galiaf © (2008-02-19 11:40) [25]

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

← →
Сергей М. © (2008-02-19 12:57) [26]

Скопируй этот код к себе в проект:

const InstanceCount = 313; { Object instance management } type PObjectInstance = ^TObjectInstance; TObjectInstance = packed record Code: Byte; Offset: Integer; case Integer of 0: (Next: PObjectInstance); 1: (Method: TWndMethod); end; type PInstanceBlock = ^TInstanceBlock; TInstanceBlock = packed record Next: PInstanceBlock; Code: array[1..2] of Byte; WndProcPtr: Pointer; Instances: array[0..InstanceCount] of TObjectInstance; end; var InstBlockList: PInstanceBlock; InstFreeList: PObjectInstance; { Standard window procedure } { In ECX = Address of method pointer } { Out EAX = Result } function StdWndProc(Window: HWND; Message, WParam: Longint; LParam: Longint): Longint; stdcall; assembler; asm XOR EAX,EAX PUSH EAX PUSH LParam PUSH WParam PUSH Message MOV EDX,ESP MOV EAX,[ECX].Longint[4] CALL [ECX].Pointer ADD ESP,12 POP EAX end; { Allocate an object instance } function CalcJmpOffset(Src, Dest: Pointer): Longint; begin Result := Longint(Dest) - (Longint(Src) + 5); end; function MakeObjectInstance(Method: TWndMethod): Pointer; const BlockCode: array[1..2] of Byte = ( $59, { POP ECX } $E9); { JMP StdWndProc } PageSize = 4096; var Block: PInstanceBlock; Instance: PObjectInstance; begin if InstFreeList = nil then begin Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE); Block^.Next := InstBlockList; Move(BlockCode, Block^.Code, SizeOf(BlockCode)); Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc)); Instance := @Block^.Instances; repeat Instance^.Code := $E8; { CALL NEAR PTR Offset } Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code); Instance^.Next := InstFreeList; InstFreeList := Instance; Inc(Longint(Instance), SizeOf(TObjectInstance)); until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock); InstBlockList := Block; end; Result := InstFreeList; Instance := InstFreeList; InstFreeList := Instance^.Next; Instance^.Method := Method; end; { Free an object instance } procedure FreeObjectInstance(ObjectInstance: Pointer); begin if ObjectInstance <> nil then begin PObjectInstance(ObjectInstance)^.Next := InstFreeList; InstFreeList := ObjectInstance; end; end;
..

Теперь смотри внимательно, как этот код используется:

TFrm = class(..) .. hWnd: THandle; FDefWndProc: Pointer; .. procedure DefaultHandler(var Message); override; //!!!! .. procedure WndProc(var Message: TMessage); .. function CreateWnd: boolean; function DestroyWnd: boolean; .. end; function TFrm.CreateWnd: boolean; begin .. hWnd:=CreateWindowEx(..); .. SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(WndProc))); .. end; function TFrm.DestroyWnd: boolean; var Instance: Pointer; begin .. Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC)); DestroyWindow(Wnd); if Instance <> @DefWindowProc then FreeObjectInstance(Instance); .. end; procedure TFrm.WndProc(var Message: TMessage); begin with Message do case Msg of ... else Dispatch(Msg); end end; procedure TFrm.DefaultHandler(var Message); begin with TMessage(Message) do begin .. Result := CallWindowProc(@WndProc, FHandle, Msg, WParam, LParam); .. end; end;

← →
Galiaf (2008-02-19 15:53) [27]

Благодарю. До завтра компьютера мне не видеть, а по этому буду изучать вышеизложенный код на экране мобильного телефона.
А откуда этот код взят? Личные наработки, взятый откуда-то или только что собранный?

← →
Сергей М. © (2008-02-19 15:58) [28]

> откуда этот код взят?

Тот что до "смотри внимательно" - из classes.pas, один в один.

Тот что ниже - "только что собранный", считай что это "экстракт" из кучи VCL-кода, который ты не понимаешь, но от которой ты желаешь избавиться.

> Galiaf (19.02.08 01:26) [19]
> С этого места по-подробнее

Ну объясни, на кой этот огород. Что из этого должно получится? Пытаешься создать свой велосипед (VCL)? Ну для начала посмотри хотя бы не исходники, которые тебе предлагают мазохисты, а "С"-шные. Перевести их на Pascal небольшой труд, но зато поймешь стратегию написания программ на API. Но если же упрямо будешь городить то, что здесь предлагаешь, то очень скоро твои программы перестанут быть "маленькими".

← →
Galiaf (2008-02-20 00:21) [30]

И чем же исходники "мазахистов" хуже исходников на сях? Если я пишу на API в первую очередь для того, чтобы столкнуться со сложностями и преодалив их положить что-либо в свою копилку опыта, то почему бы не перелопатить тот же VCL?

← →
Galiaf (2008-02-20 00:33) [31]

А про стратегию написания программ на API хотелось бы почитать по-подробнее

А какой смысл городить всю эту конструкция классов? Можно и проще и быстрее.

Ну уж, если так сильно прижало, воспользуйтесь библиотекой KOL.

← →
Galiaf (2008-02-20 11:46) [34]

Пользовался - не интересно.
Как можно сделать проще и быстрее?

> Сергей М. © (19.02.08 12:57) [26]

Огромное спасибо! Все работает, теперь моя форма умеет рисовать кружок, при этом весит 17 920 kb, понял не все по этому мне еще предстоит по сидеть, по изучать вышеприведенный код. Есть там пару ошибок но незначительные (путанница с именами переменных).
Буду рад если мне объяснят что такое и для чего используется Instance и что за hInstance, читал про это в книгах, хэлпах но от человека нормального объяснения не слышал, по этому могу только думать о нем только как о каком-то описателе приложения, который зачем-то нужен.

> что такое и для чего используется Instance и что за hInstance

Instance - в общем случае экземпляр чего-либо.

Префикс h обычно означает handle.

Означает и используется по-разному, в зависимости от тек.контекста.

Разницу между регулярной функцией/процедурой и функциональным/процедурным методом Делфи-объекта понимаешь ?

Как представлен метод любого объекта в памяти Делфи-приложения понимаешь ?

нет

Вот с этого и начни.

регулярная функция/процедура, имеется в виду цикл?

Перехват сообщений самодельным окном. Найти похожие ветки