Форум: "WinAPI";
Текущий архив: 2005.03.13;
Скачать: [xml.tar.bz2];
Вниздеректива message Найти похожие ветки
← →
JaDS © (2005-01-28 17:22) [0]Опишу задачу:
Хочу создать свою библиотеку на подобии VCL (тортами не кидаться, знаю что идея попсовая, но мне надо не аналог VCL, а лишь несколько компонентов часто мною используемые).
Как я это делаю (пример):
TForm = object
public
Create...
Destroy...
end;
Ну вобщем форма создаётся и разрушается. А теперь я хочу чтобы форма обрабатывала допустим WM_PAINT. На текущий момент мне приходится для каждого типа писать отдельную оконную процедуру, причём независимую от класса, что очень не удобно и никак не вяжется с ООП. Но в то же время сама делфи очень легко это обходит используя дерективу message.
Теперь сам ворос:
если я допишу в своё определение типа строчку:
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
то как заставить её вызываться???
Наблюдения:
Если ту же самую строчку добавить в VCL"овский тип TForm, то вызов этой процедуры происходит из процедуры TControl.WndProc >>> TObject.Dispatch
PS:
вообще кто нибудь представляет механизм работы дерективы message???
← →
Digitman © (2005-01-28 17:28) [1]
> тортами не кидаться
чей-то сразу "тортами" ? а навозом в торцевую часть репы не желаете ли ?) .. гораздо ощутимей, скажу я Вам )..
> вообще кто нибудь представляет механизм работы дерективы
> message
а как же !
и, думаю, оч многие ув.коллеги оч даже четко себе сей механизм предствляют ..
и сводится он к call [РОН + оффсет]
← →
JaDS © (2005-01-28 17:36) [2]2Digitman:
вообще то вопрос был "как заставить её вызываться???" а не про торты...
уточню проблему:
procedure TForm.Create;
var
wc: TWndClassExW;
...
begin
...
wc.lpfnWndProc:=???
...
end;
Так вот что именно тогда присваивать этому полю? Как уже писал на текущий момент приходится для каждого класса писать свою оконную процедуру и присваивать этому полю её адрес, но тогда про перекрытие метода в потомках можно забыть, а мне нужно чтобы именно была возможность переопределения.
>оч многие ув.коллеги оч даже четко себе сей механизм предствляют
и они даже смогут привести рабочий пример?
← →
PVOzerski © (2005-01-28 18:08) [3]>и они даже смогут привести рабочий пример?
Кидания тортом в репу? :^)
Если серьезно, посмотри описание tObject.Dispatch и tObject.DefaultHandler.
← →
PVOzerski © (2005-01-28 18:22) [4]Уточняю: если вызвать Dispatch и передать ему tMessage, будет вызван соответствующий метод этого объекта. Когда я пытался написать сабж для FreePascal (где-то дома нечто недоделанное так и валяется), я вызывал Dispatch из WndProc своих винконтролов, а этот WndProc вызывал из оконного callback"а. Чтобы добраться до адреса объекта, загонял его в класс окошка через SetWindowLong по смещению GWL_USERDATA а при вызове CallBack"а извлекал обратно через GetWindowLong. Замечу, что в настоящей VCL это всё сделано не так. Но работал и такой способ. Правда, стОит подумать, как избежать возможных проблем с разными нитями в моменты "прикрепления" объекта к окну.
← →
PVOzerski © (2005-01-28 18:24) [5]В догонку: забыл, как называется ветка, аоэтому под "сабжем" имел в виду "свою библиотеку наподобие VCL".
← →
JaDS © (2005-01-29 03:08) [6]>Чтобы добраться до адреса объекта, загонял его в класс окошка
>через SetWindowLong по смещению GWL_USERDATA а при вызове
>CallBack"а извлекал обратно через GetWindowLong.
я сам хотел делать что-то похожее, только это как-то всё неправильно чтоли, не лежит "душа" к такому, вот поэтому и назрел вопрос - как тоже самое делается с помощью дерективы message - никак не пойму что она делает. Верней я понимаю что если добавить её к потомку TControl, то она попадёт в цикл обработки оконных сообщений, но как их туда делфи вставляет - непонимаю, если можно - механизм работы этой дерективы?!
← →
JaDS © (2005-01-29 03:33) [7]хмммм, опять как то не так спросил:
вобщем код:
...
T_Form = object
public
procedure Create;
end;
...
function T_Form_WndProc(hWnd: THandle; Msg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall;
begin
end;
...
procedure T_Form.Create;
var
wc: TWndClassEx;
begin
wc.lpfnWndProc:=T_Form_WndProc;
end;
...
Вобщем проблема относительно этого кода:
Как сделать (и можно ли это вообще, а если нельзя то как это обойти с наименьшими "жертвами") функцию T_Form_WndProc методом класса T_Form?
По всей видимости этого не добиться, тогда:
function T_Form_WndProc(hWnd: THandle; Msg: UINT; wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall;
begin
...
// каким то образом идентифицируем объект
// например с помощью той же GetWindowLong
...
case Msg of
WM_CREATE: T_Form(obj).OnCreate(hWnd);
else Result:= DefWindowProcW(hWnd, Msg, wParam, lParam);
end;
end;
Но тогда сразу вопросы - а есть ли другие варианты сделать тоже самое? А как ещё можно идентифицировать объект? А если потом это переопределять, то заодно и как сразу идентифицировать класс? ...
PS:
вобщем хотелось бы увидеть или реально работающий код по сабжу, или более менее дельные рекомендации, чтобы я (довольно тупой человек%) понял как это всё заставить работать.
← →
Набережных С. © (2005-01-29 09:56) [8]Я уже недавно тут выкладывал это в урезанном виде, и был обруган и обозван хакером:) Рискну однако еще раз. Может, у кого возникнет конструктивная критика, будет очень кстати.
unit MakeInstance;
interface
uses
Windows, Messages;
function MakeInstanceStdCall(Obj: TObject; MethodAddr: Pointer): Pointer;
procedure FreeInstanceStdCall(Inst: Pointer);
type
TMessageEvent =
procedure(Sender: TObject; var Message: TMessage; var Handled: boolean) of Object;
TWndObject = class
private
FHandle: HWND;
FOnMessage: TMessageEvent;
function ObjWindowProc(Wnd: HWND; AMsg: UINT; wPrm: WPARAM; lPrm: LPARAM): LRESULT; stdcall;
function GetWindowName: string;
procedure SetWindowName(const Value: string);
protected
procedure GetClassParams(var WndClass: TWndClass); virtual;
procedure GetStyles(var Style, ExStyle: DWORD); virtual;
procedure DoMessage(var Message: TMessage); virtual;
public
constructor Create(const AName: string = ""); virtual;
destructor Destroy; override;
property Handle: HWND read FHandle;
property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
property WindowName: string read GetWindowName write SetWindowName;
end;
implementation
var
FCS: TRTLCriticalSection;
{ TWndObject }
const
WndClassTemplate: TWndClass = (
style: 0;
lpfnWndProc: @DefWindowProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: "TSNUtilWindow");
constructor TWndObject.Create(const AName: string = "");
var
WndClass, TempClass: TWndClass;
Style, ExStyle: DWORD;
ClassRegistered: Boolean;
begin
GetClassParams(WndClass);
GetStyles(Style, ExStyle);
EnterCriticalSection(FCS);
try
ClassRegistered := GetClassInfo(HInstance, WndClass.lpszClassName,
TempClass);
if ClassRegistered then UnregisterClass(WndClass.lpszClassName, HInstance);
RegisterClass(WndClass);
FHandle := CreateWindowEx(ExStyle, WndClass.lpszClassName,
"", Style, 0, 0, 0, 0, 0, 0, HInstance, nil);
if WndClass.lpfnWndProc = @DefWindowProc then
SetWindowLong(FHandle, GWL_WNDPROC,
Longint(MakeInstanceStdCall(Self, @TWndObject.ObjWindowProc)));
finally
LeaveCriticalSection(FCS);
end;
end;
destructor TWndObject.Destroy;
var
Instance: Pointer;
begin
Instance := Pointer(GetWindowLong(FHandle, GWL_WNDPROC));
DestroyWindow(FHandle);
if Instance <> @DefWindowProc then FreeInstanceStdCall(Instance);
inherited;
end;
procedure TWndObject.DoMessage(var Message: TMessage);
var
Handled: boolean;
begin
Handled:=false;
if Assigned(FOnMessage) then FOnMessage(Self, Message, Handled);
if not Handled then with Message do
Result:=DefWindowProc(FHandle, Msg, WParam, LParam);
end;
procedure TWndObject.GetClassParams(var WndClass: TWndClass);
begin
WndClass:=WndClassTemplate;
WndClass.hInstance:=HInstance;
end;
procedure TWndObject.GetStyles(var Style, ExStyle: DWORD);
begin
Style:=WS_POPUP;
ExStyle:=WS_EX_TOOLWINDOW;
end;
function TWndObject.GetWindowName: string;
var
n: DWORD;
begin
n:=GetWindowTextLength(FHandle);
if n = 0 then Exit;
SetLength(Result, n);
GetWindowText(FHandle, @Result[1], n);
end;
function TWndObject.ObjWindowProc(Wnd: HWND; AMsg: UINT; wPrm: WPARAM;
lPrm: LPARAM): LRESULT;
var
Message: TMessage;
begin
{
WM_CREATE = $0001;
WM_NCCREATE = $0081;
WM_NCCALCSIZE = $0083;
}
with Message do
begin
Msg:=AMsg;
WParam:=wPrm;
LParam:=lPrm;
Result:=0;
end;
DoMessage(Message);
Result:=Message.Result;
end;
procedure TWndObject.SetWindowName(const Value: string);
begin
SetWindowText(FHandle, PChar(Value));
end;
{ /TWndObject }
type
PInstanceBlock = ^TInstanceBlock;
TInstanceBlock = packed record
Code: array[0..31 - SizeOf(PInstanceBlock)] of Byte;
Next: PInstanceBlock;
end;
var
BlockList: PInstanceBlock = nil;
Region: Pointer = nil;
NextPage: pointer = nil;
BlockCount: integer = 0;
const
Page_Size = 4096;
BlocksOnPage = Page_Size div SizeOf(TInstanceBlock);
type
TBlockList = array[0..BlocksOnPage - 1] of TInstanceBlock;
PBlockList = ^TBlockList;
function GetAllocGran: DWORD;
var
Info: TSystemInfo;
begin
GetSystemInfo(Info);
Result:=Info.dwAllocationGranularity;
end;
procedure FreeInstanceStdCall(Inst: Pointer);
begin
if Inst = nil then Exit;
EnterCriticalSection(FCS);
PInstanceBlock(Inst).Next:=BlockList;
BlockList:=Inst;
Dec(BlockCount);
if BlockCount = 0 then
begin
VirtualFree(Region, 0, MEM_RELEASE);
Region:=nil;
NextPage:=nil;
BlockList:=nil;
end;
LeaveCriticalSection(FCS);
end;
function MakeInstanceStdCall(Obj: TObject; MethodAddr: Pointer): Pointer;
const
CodeBlock: array [0..12] of Byte =
(
$58, // POP EAX
$68, // PUSH DWORD_Const <= Obj
0, 0, 0, 0,
$50, // PUSH EAX
$68, // PUSH DWORD_Const <= MethodAddr
0, 0, 0, 0,
$C3 // RET
);
type
PCodeBlock = ^TCodeBlock;
TCodeBlock = packed record
Code1: Word;
Self: TObject;
Code2: Word;
MtdAddr: Pointer;
Code3: Byte;
end;
var
n: integer;
begin
EnterCriticalSection(FCS);
if BlockList = nil then
begin
if Region = nil then
begin
Region:=VirtualAlloc(nil, GetAllocGran, MEM_RESERVE or MEM_TOP_DOWN,
PAGE_EXECUTE_READWRITE);
NextPage:=Region;
end;
BlockList:=VirtualAlloc(NextPage, Page_Size, MEM_COMMIT,
PAGE_EXECUTE_READWRITE);
Inc(Cardinal(NextPage), Page_Size);
for n:=0 to BlocksOnPage - 2 do
PBlockList(BlockList)[n].Next:=@PBlockList(BlockList)[n + 1];
PBlockList(BlockList)[BlocksOnPage - 1].Next:=nil;
end;
Result:=BlockList;
BlockList:=BlockList.Next;
Inc(BlockCount);
LeaveCriticalSection(FCS);
Move(CodeBlock, Result^, SizeOf(CodeBlock));
with PCodeBlock(Result)^ do
begin
Self:=Obj;
MtdAddr:=MethodAddr;
end;
end;
procedure InitProc;
begin
InitializeCriticalSection(FCS);
end;
procedure FinalProc;
begin
DeleteCriticalSection(FCS);
end;
initialization
InitProc;
finalization
FinalProc;
end.
← →
JaDS © (2005-01-29 19:26) [9]>был обруган и обозван хакером:)
а те кто ругали и обзывали вообще видели функцию Classes.MakeObjectInstance???
а вообще - давольно занятный код, уже почти что я хотел, только я хочу сделать не на базе class а на базе object - так ресурсов меньше требуется (вроде) и ГЛАВНОЕ - я хочу чтобы деректива message работала так же как и при использовании VCL (если это вообще возможно).
← →
JaDS © (2005-01-29 23:34) [10]а, всё, догнал - спарить message и object не удасться... обидно... прийдётся искать обходные пути...
← →
i-s-v © (2005-01-30 01:53) [11]
> а, всё, догнал - спарить message и object не удасться...
> обидно... прийдётся искать обходные пути...
А хотелось спарить? А что в результате получилось-бы? Мутант?:)
← →
GrayFace © (2005-01-30 05:05) [12]А за что был обруган и обозван?
← →
Набережных С. © (2005-01-30 10:23) [13]GrayFace © (30.01.05 05:05) [12]
А кто его знает? Он не уточнил, а спрашивать не стал. Да не стоит на это внимание обращать, зря я упомянул.
← →
Набережных С. © (2005-01-30 10:37) [14]>JaDS ©
Если требуется, можно вызвать Dispatch в обработчике OnMessage. Просто мне это чаще не требуется.
← →
jack128 © (2005-01-30 12:19) [15]JaDS © (29.01.05 19:26) [9]
а на базе object - так ресурсов меньше требуется (вроде)
Ну если создашь объект в стеке, то действительно меньше. А если в дин памяти, то ИМХО без разницы. А для чего создовать оконные объекты с стеке я себе слабо представляю..
← →
Набережных С. © (2005-01-30 13:04) [16]>jack128 © (30.01.05 12:19) [15]
Сюда заглядывал?
http://delphimaster.net/view/1-1106921084/
← →
default © (2005-01-30 13:06) [17]Набережных С. © (30.01.05 13:04) [16]
это всё хорошо, но пример надуманный
представьте что компиллер не включает в код бессмысленные конструкции типа A := A
пример бы реальный
← →
Набережных С. © (2005-01-30 13:21) [18]>default © (30.01.05 13:06) [17]
>представьте что компиллер не включает
Не могу представить:) Обязательно включит. Компилятор не может не включать этот код именно в силу автоматического подсчета ссылок. Но об этом лучше в той ветке.
← →
GrayFace © (2005-01-31 19:46) [19]jack128 © (30.01.05 12:19) [15]
А как создавать объекты в стеке?
← →
jack128 © (2005-01-31 22:23) [20]GrayFace © (31.01.05 19:46) [19]
type
TSameObj = object
i: Integer;
end;
procedure Test;
var
o: TSameObj; // Объект создается в стеке
begin
end;
← →
GrayFace © (2005-02-01 02:05) [21]jack128 © (31.01.05 22:23) [20]
Круто. Вот только почему "Object types are supported for backward compatibility only. Their use is not recommended."? Чем это Borland"у такая хорошая фича не понравилась?...
← →
GuAV © (2005-02-01 13:13) [22]GrayFace © (01.02.05 2:05) [21]
У объектов по умолчанию нет никаких конструкторов/деструкторов и классовых методов, что оказалось не очень хорошо.
В стеке особого смысла размещать нет, всё равно поля других объектов - не объекты а указатели на них, всё равно неплохо бы вызвать конструктор...
Или вот в случае исключения в конструкторе последует вызов деструктора, а если объект в стеке, или там часть массива, то что ?
Короче, ничего хорошего в них не вижу.
← →
GrayFace © (2005-02-01 17:13) [23]Их можно использовать, например, для реализации комплексных чисел и т.п.
← →
GuAV © (2005-02-01 20:15) [24]Согласен, лучший пример - TRect раньше был объектом.
Однако решили что морочится с ними не стоит.
А комплескные числа - VarCmplx рулит.
Страницы: 1 вся ветка
Форум: "WinAPI";
Текущий архив: 2005.03.13;
Скачать: [xml.tar.bz2];
Память: 0.57 MB
Время: 0.045 c