Start Free Trial

asked on

Event handled by any parent

How can I know at runtime if any parent (in the hierarquical tree) of a component is handling one event?.

For example, lets suppose I have a component named MyComponent derived from TEdit and I want to know at runtime if some of its parents (TEdit, TCustomEdit, and so on) is handling the WM_PAINT event itself.

You could make something like this (I tried with properties that I have defined in a class that I created):

Let's say we have a event OnSomething.

function TCpVoz.TellMeWhere : TComponent;
begin
if Assigned (OnSomething) then
TellMeWhere := TComponent (Self)
else
begin
if (Owner <> nil) then
TellMeWhere := MyOriginClass(Owner).TellMeWhere
else
TellMeWhere := nil;
end;
end;

The function is recursive and should stop when it finds a that the event is Assigned or when it cannot find a valid Owner.

I just made the function up as an example. I did not compile it nor check it.

In any case, the keywords are:
1.-The owner property of the TComponent class
2.-The Assigned function of the unit System

function Assigned(var P): Boolean;

This function is use to avoid empty handlers to produce unexpected results.

Look in the Help for more information. It's kind of puzzling, but you can get it at the end.

Tell me something.

Felixin

I'm afraid this doesn't answer the question; with this method not only a parent should have defined a event exactly named "OnSomething", but this OnSomething should be assigned as well; moreover, said that you found it, how could you tell if this event (so a property) is anyway related to a message handler of any sort?

IMHO, at least under the programming point of view, it is not possible to check if a component is handling a message, unless to component writer had decided to public, or publish, or (for children) to protect the message handler.
This seems a consequence of the OO concept of incapsulation itself.

Maybe a Windows/OO-Programming Wizard would know a way to track an event route up the component hierarchy?

Regards

!HARD QUESTOIN!

I can not find the regular normal function or method calling method for this but, by modifying System.pas source able to achieve the goal. Here is the unit. You should add your component a method I declared below. The method returns the class pointer for the class so you can even retrieve the name.

Please, test the source (I have tested it)
Eagerly waiting for your comment

IGOR

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TXEdit = class(TEdit)
public
function DoesAchestorsHandle(var Message):TClass;
end;
var
Form1: TForm1;

implementation

{$R *.DFM}

const
vtInitTable = -48;
vtTypeInfo = -44;
vtFieldTable = -40;
vtMethodTable = -36;
vtDynamicTable = -32;
vtClassName = -28;
vtInstanceSize = -24;
vtParent = -20;
vtDefaultHandler = -16;
vtNewInstance = -12;
vtFreeInstance = -8;
vtDestroy = -4;
clVTable = 0;

// I also should modify this
procedure GetDynaMethodX;
asm
{ -> EAX vmt of class }
{ BX dynamic method index }
{ <- EBX pointer to routine }
{ ZF = 0 if found }
{ trashes: EAX, ECX }
PUSH EDI
XCHG EAX,EBX
@@outerLoop:
MOV EDI,[EBX].vtDynamicTable
TEST EDI,EDI
JE @@parent
MOVZX ECX,word ptr [EDI]
PUSH ECX
ADD EDI,2
REPNE SCASW
JE @@found
POP ECX
@@parent:
MOV EBX,[EBX].vtParent
TEST EBX,EBX
JNE @@outerLoop
JMP @@exit
@@found:
POP EAX
ADD EAX,EAX
SUB EAX,ECX { this will always clear the Z-flag ! }
{...return EBX as reference to class}
@@exit:
POP EDI
end;

function TXEdit.DoesAchestorsHandle(var Message):TClass;
asm
PUSH EBX
MOV BX,[EDX] {Check if message valid}
OR      BX,BX
JE      @@bypass
CMP      BX,0C000H
JAE      @@bypass
PUSH EAX {Prepare stack}
MOV EAX,[EAX]
CALL GetDynaMethodX {try to obtain parents method}
POP EAX
JE @@bypass {not found so return false}
MOV EAX, EBX {found so return class}
JMP @@exit
@@bypass:
MOV EBX,0
@@exit:
POP EBX
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Ms : TMessage;
ClassP : TClass;
MyComponent : TXEdit;
begin
MyComponent := TXEdit.Create(nil);
try
Ms.Msg := WM_PAINT;
Ms.WParam := 0;
Ms.LParam := 0;
Ms.Result := 0;
ClassP := MyComponent.DoesAchestorsHandle(Ms);
if ClassP <> nil then
ShowMessage(ClassP.ClassName + ' Anchestors handles this message');
finally
MyComponent.Free;
end;
end;

end.

Sorry,
I made a inocent mistake in a comment. To not mislead you:

in GetDynaMethodX EBX returns the pointer to the classVMT itself. so that I can extract the name of class.

Sincerely,
Igor

Certainly I missed the point, but I realized it too late, once I pushed the buttom to submit the answer.

My answer is based in a Use relation, and not in Inheritance.

I'll have another thought on it.

> Eagerly waiting for your comment

i'd like i could give a comment on it! :)

-julio

Friends,
Please test my solution above, I have given the complete unit code, you do not need to do anything just copy and paste it over unit1.

Waiting for your comments!
Igor

ASKER

Thank you for your comments, specially to Igor for its great work. If I don't receive a better answer I'll give him the points. By now the problem still persists, because I can't modify any source code of the VCL (I am writing a component and it has to work in any installation of Delphi 3). I can't force other programmers to modify the system.pas

If I receive a perfect solution I am disposed to increase the points to 400

Dear fsanchez,
You do not need to modify system.pas. Just add your components unit those two asm functions and the other one. It will be hidden in the implementation part of your component. And I do not think Borland could change the VMT structure. However, you are right, I try to find a regular way also!(The problem is that we can obtain the pulished property and methods of any object but they restrict the way to the private and protected ones)

Thanks,
Igor

ASKER

Igor, sorry for the mistake, but it still does not work for me. I need to know if any windowed component of one window has redefined determinated events, so I can't rely on methods added by me to that components, because they can be third party ones.

I should have explained this before, sorry.

No problem, friend,

By the aid of your problem, I have a chance to learn the real physical layout of the Virtual Methods Tables and class of Delphi.

You are so kind
Thanks,
Igor

Dear fsanchez,

I still could not find a normal method of this problem, but I extend the code so that you do not have to override the component and add it a method. This method works with any component(other than OLE components,i.e. OCX-actually they return nil), here is the source(again note that this is a practice for me):

const
vtDynamicTable = -32;
vtParent = -20;
// Finds the parent of input vmt instance that handles the message in BX
procedure GetDynaMethodX;
asm
{ -> EAX vmt of class }
{ BX dynamic method index }
{ <- EBX pointer to vmt of parent or self}
{ ZF = 0 if found }
{ trashes: EAX, ECX }
PUSH EDI
XCHG EAX,EBX
@@outerLoop:
MOV EDI,[EBX].vtDynamicTable
TEST EDI,EDI
JE @@parent
MOVZX ECX,word ptr [EDI]
PUSH ECX
ADD EDI,2
REPNE SCASW
JE @@found
POP ECX
@@parent:
MOV EBX,[EBX].vtParent
TEST EBX,EBX
JNE @@outerLoop
JMP @@exit
@@found:
POP EAX
ADD EAX,EAX
SUB EAX,ECX { this will always clear the Z-flag ! }
{...return EBX as reference to class}
@@exit:
POP EDI
end;
// returns the class pointer of self or ancestors that handles the Message
function DoesAchestorsHandle(Instance : Pointer; var Message):TClass;
asm
PUSH EBX
MOV BX,[EDX] {Check if message valid}
OR      BX,BX
JE      @@bypass
CMP      BX,0C000H
JAE      @@bypass
PUSH EAX {Prepare stack}
MOV EAX,[EAX]
CALL GetDynaMethodX {try to obtain parents method}
POP EAX
JE @@bypass {not found so return false}
MOV EAX, EBX {found so return class}
JMP @@exit
@@bypass:
MOV EBX,0
@@exit:
POP EBX
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Ms : TMessage;
ClassP : TClass;
MyComponent : TEdit;
begin
MyComponent := TEdit.Create(nil);
try
{Simply create your component and feed it!}
Ms.Msg := WM_PAINT;
ClassP := DoesAchestorsHandle(MyComponent, Ms);
if ClassP <> nil then
ShowMessage(ClassP.ClassName + ' handles this message');
finally
MyComponent.Free;
end;
end;

Regards,
Igor

ASKER

I am trying this code in my Delphi3 and it gives me an access violation. The WM_NCPAINT event is crucial for me. It is handled by TToolWindow, for example, but not by TEdit.

procedure MyProcedure;
var
Ms : TMessage;
ClassP : TClass;
MyComponent : TEdit;
begin
MyComponent := TEdit.Create(nil);
try
{Simply create your component and feed it!}
Ms.Msg := WM_NCPAINT;
ClassP := DoesAchestorsHandle(MyComponent, Ms);
if ClassP <> nil then
ShowMessage(ClassP.ClassName + ' handles this message');
finally
MyComponent.Free;
end;
end;

fsanchez FORGIVE please,

change the last lines of DoesAnchestorsHandle as

....
@@bypass:
POP EBX
MOV EAX,0
RET
@@exit:
POP EBX
end;

Sorry Again, the function DoesAnchestorHandles must return nil, so I should set EAX to 0 for it be return nil.

Igor

ASKER

Igor, thanks for your fast responses, but it is still giving an access violation when I try it with the message WM_NCPAINT and TEdit, for example.

Fran.

Its weird friend,
I try it with tform, tedit, tlistbox and it only returns nil as classP. Here is the final code:(the other procedure is same)

function DoesAchestorsHandle(Instance : Pointer; var Message):TClass;
asm
PUSH EBX
MOV BX,[EDX] {Check if message valid}
OR      BX,BX
JE      @@bypass
CMP      BX,0C000H
JAE      @@bypass
PUSH EAX {Prepare stack}
MOV EAX,[EAX]
CALL GetDynaMethodX {try to obtain parents method}
POP EAX
JE @@bypass {not found so return false}
MOV EAX, EBX {found so return class}
JMP @@exit
@@bypass:
POP EBX
MOV EAX,0
RET
@@exit:
POP EBX
end;

ASKER

It doesn't work in my computer. I'll try it in others.
Which version of Delphi are you using?.

The points are yours. Please still follow the thread and maybe I'll give you more points. Check your next comment as an answer and I'll grade you.

Dear friend,

I am using Delphi 2.00(with 2.01 update) Client Server. So I have all the source code for components and delphi. If this piece of code works for example TEdit with WM_PAINT the Virtual Method Tables are same for Delphi 2.0 or 3.0. If you have Delphi 3.0 source, you may send me the system.pas so that I can check if there is anything different in VMT(I do not suppose). This should not be a copyright problem for borland since I have delphi client server which is the most expensive delphi version.

Thanks, but need to more points friend. Some one may find a better solution. Discussing such things are quite satifying for me.

Now due to the access viloation.

1 - Is it something like ...Read of address 00000000?
2 - Did you trace the code and upon exit of DoesAnchestor.. EAX contains 0?(just place a watch EAX, EBX etc.)

Thanks for you kindness.
Igor

ASKER

The code breaks at the following line of GetDynaMethodX
MOVZX ECX,word ptr [EDI]

The error is: "Access violation at address 0045C34D in module 'DEMO.EXE'. Read of address FFFF0D0C."

I could e-mail you the system.pas if you give your direction.

Fran.

Sorry, I should went somewhere. I am back now.

Igor
inter@kosgeb.tekmer.gov.tr

I should leave urgent, be here in Sunday 8.

Igor

Ok fran,

If possible, please send me system.pas. I am here from nowon.

Regards,
Igor
inter@kosgeb.tekmer.gov.tr

Thanks fran,

Please just change the following in your sample code

const
vtDynamicTable = -36;
vtParent = -24;

If you there please let me know immediately,(or waiting for any comment)
Igor

ASKER

Igor, I tried it and it gives me an access violation at

MOV EDI,[EBX].vtDynamicTable

in the GetDynaMethodX, exactly at the third pass.

Fran

Fran,

Preserving the change made to the constants, the GetDynaMethodX for Delphi 3.0 should be the following:(sorry I can not study it well in office hours, I wish I have Delphi 3)

NOTE : If this does not work, I try to findout the cause, excuse me if something goes wrong again, you know I cannot debug it with Delphi 2.0.

procedure GetDynaMethodX;
asm
{ -> EAX vmt of class }
{ BX dynamic method index }
{ <- EBX pointer to vmt of parent or self}
{ ZF = 0 if found }
{ trashes: EAX, ECX }
PUSH EDI
XCHG EAX,EBX
JMP @@haveVMT
@@outerLoop:
MOV EBX,[EBX]
@@haveVMT:
MOV EDI,[EBX].vtDynamicTable
TEST EDI,EDI
JE @@parent
MOVZX ECX,word ptr [EDI]
PUSH ECX
ADD EDI,2
REPNE SCASW
JE @@found
POP ECX
@@parent:
MOV EBX,[EBX].vtParent
TEST EBX,EBX
JNE @@outerLoop
JMP @@exit
@@found:
POP EAX
ADD EAX,EAX
SUB EAX,ECX { this will always clear the Z-flag ! }
{...return EBX as reference to class}
@@exit:
POP EDI
end;

ASKER

Great! It works fine. Very good job, Igor. Mark an answer and I'll grade it.

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Sorry,
I think you readjusted the points. I realy do not want that. Do not misinterpret the answer wrong, (it feels like that when i read after posting really sorry)

Igor

ASKER

Accept the extra points, you have earned them. There's no problem with your answer. Sorry for my bad english, I can't express myself like I would. I speak spanish very well, do you too? ;-)

Fran