?
Solved

Event handled by any parent

Posted on 1998-01-22
29
Medium Priority
?
282 Views
Last Modified: 2010-04-04
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.
0
Comment
Question by:fsanchez
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 16
  • 9
  • 2
  • +1
29 Comments
 
LVL 2

Expert Comment

by:Felixin
ID: 1357262
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
0
 
LVL 5

Expert Comment

by:julio011597
ID: 1357263
 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
0
 
LVL 5

Expert Comment

by:inter
ID: 1357264
!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.

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 5

Expert Comment

by:inter
ID: 1357265
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
0
 
LVL 2

Expert Comment

by:Felixin
ID: 1357266
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.

0
 
LVL 5

Expert Comment

by:julio011597
ID: 1357267
> Eagerly waiting for your comment

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

-julio
0
 
LVL 5

Expert Comment

by:inter
ID: 1357268
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
0
 
LVL 1

Author Comment

by:fsanchez
ID: 1357269
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
0
 
LVL 5

Expert Comment

by:inter
ID: 1357270
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
0
 
LVL 1

Author Comment

by:fsanchez
ID: 1357271
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.
0
 
LVL 5

Expert Comment

by:inter
ID: 1357272
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

0
 
LVL 5

Expert Comment

by:inter
ID: 1357273
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
0
 
LVL 1

Author Comment

by:fsanchez
ID: 1357274
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;

0
 
LVL 5

Expert Comment

by:inter
ID: 1357275
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
0
 
LVL 1

Author Comment

by:fsanchez
ID: 1357276
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.
0
 
LVL 5

Expert Comment

by:inter
ID: 1357277
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;

0
 
LVL 1

Author Comment

by:fsanchez
ID: 1357278
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.
0
 
LVL 5

Expert Comment

by:inter
ID: 1357279
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
0
 
LVL 1

Author Comment

by:fsanchez
ID: 1357280
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.
0
 
LVL 5

Expert Comment

by:inter
ID: 1357281
Sorry, I should went somewhere. I am back now.

Igor
inter@kosgeb.tekmer.gov.tr
0
 
LVL 5

Expert Comment

by:inter
ID: 1357282
I should leave urgent, be here in Sunday 8.

Igor
0
 
LVL 5

Expert Comment

by:inter
ID: 1357283
Ok fran,

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

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



0
 
LVL 5

Expert Comment

by:inter
ID: 1357284
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
0
 
LVL 1

Author Comment

by:fsanchez
ID: 1357285
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
0
 
LVL 5

Expert Comment

by:inter
ID: 1357286
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;

0
 
LVL 1

Author Comment

by:fsanchez
ID: 1357287
Great! It works fine. Very good job, Igor. Mark an answer and I'll grade it.
0
 
LVL 5

Accepted Solution

by:
inter earned 1800 total points
ID: 1357288
 :-) :-) :-) :-) :-) :-) :-) :-) :-)
:-) :-) I am very, very happy  :-) :-)
  :-) :-) :-) :-) :-) :-) :-) :-) :-)

Thanks, I now sure know about Delphi 3.0 class internal structure by means of your aids. (You make me blush friend, no need to increase the points!)

Thanks again, (You know my email, contact whenever you want/need please - lifetime waranty to code for friends)
Igor
0
 
LVL 5

Expert Comment

by:inter
ID: 1357289
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
0
 
LVL 1

Author Comment

by:fsanchez
ID: 1357290
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
0

Featured Post

Want to be a Web Developer? Get Certified Today!

Enroll in the Certified Web Development Professional course package to learn HTML, Javascript, and PHP. Build a solid foundation to work toward your dream job!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
NetCrunch network monitor is a highly extensive platform for network monitoring and alert generation. In this video you'll see a live demo of NetCrunch with most notable features explained in a walk-through manner. You'll also get to know the philos…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
Suggested Courses

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question