• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 290
  • Last Modified:

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.
0
fsanchez
Asked:
fsanchez
  • 16
  • 9
  • 2
  • +1
1 Solution
 
FelixinCommented:
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
 
julio011597Commented:
 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
 
interCommented:
!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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
interCommented:
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
 
FelixinCommented:
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
 
julio011597Commented:
> Eagerly waiting for your comment

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

-julio
0
 
interCommented:
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
 
fsanchezAuthor Commented:
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
 
interCommented:
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
 
fsanchezAuthor Commented:
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
 
interCommented:
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
 
interCommented:
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
 
fsanchezAuthor Commented:
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
 
interCommented:
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
 
fsanchezAuthor Commented:
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
 
interCommented:
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
 
fsanchezAuthor Commented:
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
 
interCommented:
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
 
fsanchezAuthor Commented:
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
 
interCommented:
Sorry, I should went somewhere. I am back now.

Igor
inter@kosgeb.tekmer.gov.tr
0
 
interCommented:
I should leave urgent, be here in Sunday 8.

Igor
0
 
interCommented:
Ok fran,

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

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



0
 
interCommented:
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
 
fsanchezAuthor Commented:
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
 
interCommented:
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
 
fsanchezAuthor Commented:
Great! It works fine. Very good job, Igor. Mark an answer and I'll grade it.
0
 
interCommented:
 :-) :-) :-) :-) :-) :-) :-) :-) :-)
:-) :-) 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
 
interCommented:
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
 
fsanchezAuthor Commented:
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

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

  • 16
  • 9
  • 2
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now