Solved

Event handled by any parent

Posted on 1998-01-22
29
257 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
  • 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
 
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
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
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 450 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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Master Detail with TADODataset 4 97
PDF files into SQL 2008 Varbinary(Max) 3 81
Sending Gmail through Delphi 3 69
Working with hours 3 31
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
This video demonstrates how to create an example email signature rule for a department in a company using CodeTwo Exchange Rules. The signature will be inserted beneath users' latest emails in conversations and will be displayed in users' Sent Items…

746 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now