VCL Message processing mechanism

Tag: IKE registers its selector OCA messages without add offset

When it comes to the message processing in VCL, it is impossible to mention that Tapplication,windows will establish a message queue for each currently running program, which completes the user-to-program interaction through application, which completes the centralized processing of Windows messages!

First, the message is processed by Application.Run into the message loop, where Handlemessage is called.

Procedure Tapplication.handlemessage;var  Msg:tmsg;begin

 //called ProcessMessage processing First, the return value is false call idle, that is, in the idle, that is, Message Queuing without message waiting for processing when the call idle  if Not ProcessMessage (msg) then Idle (msg); End;function Tapplication.processmessage (var msg:tmsg): Boolean;var Handled:  Boolean;begin Result: = False; If PeekMessage (MSG, 0, 0, 0, pm_remove) then//Query Message Queuing has no message waiting to be processed, and the parameter pm_remove causes the message to be deleted when it is finished processing.     begin Result: = True; If Msg.message <> wm_quit then//if it is wm_quit, terminate the process, otherwise execute the following code  begin Handled      : = False;      If Assigned (fonmessage) then Fonmessage (MSG, Handled); If not ishintmsg (msg) and is Handled and not ismdimsg (msg) and not iskeymsg (msg) and not isdlgmsg (msg) then B Egin TranslateMessage (MSG);        //pass the record msg to Windows for conversion  DispatchMessage (MSG);    //will record msg back to Windows  end;  End else fterminate: = True; End;end; 

Then how do the various VCL objects in the program receive Windows messages? This also starts with the creation of the form!
first find the Twincontrol.createwnd in the
Windows.registerclass (Windowclass)//Call registerclass to register a form class
look up.
Windowclass.lpfnwndproc: = @InitWndProc;//The pointer to the message handler function for the window specified here is @initwndproc!
find it again .function Initwndproc (Hwindow:hwnd; Message, WParam, lparam:longint): Longint;
Found a
Creationcontrol.fhandle: = Hwindow;
SetWindowLong (Hwindow, Gwl_wndproc,longint (creationcontrol.fobjectinstance));
No?
The original Initwndproc was first invoked, and the API function was usedSetWindowLongSpecifies that the window procedure for processing messages is fobjectinstance.
Back to Twincontrol.create
Fobjectinstance: = Classes.makeobjectinstance (Mainwndproc);
Find the key, maybe some friends to makeobjectinstance this function is very familiar, its role is to convert a member process into a standard process.
Around a circle? Why is it? Very simplebecause a form member procedure includes an implied parameter that passes the self pointer, it needs to be converted to a standard procedure.

Const

  //This is not difficult to understand, right? 314*13+10=4092, the size of the record tinstanceblock exceeds the pagesize defined below.InstanceCount = 313;type pobjectinstance = ^tobjectinstance;    tobjectinstance = packed record code:byte;    Offset:integer;      Case Integer of 0: (next:pobjectinstance);  1: (Method:twndmethod);  End;type pinstanceblock = ^tinstanceblock;    Tinstanceblock = packed record next:pinstanceblock;    CODE:ARRAY[1..2] of Byte;    Wndprocptr:pointer;  Instances:array[0..instancecount] of tobjectinstance;  End;var Instblocklist:pinstanceblock; Instfreelist:pobjectinstance;function Stdwndproc (Window:hwnd;  Message, Wparam:longint; Lparam:longint): Longint; stdcall;         Assembler;asm XOR eax,eax Push EAX push LParam push WParam push Message MOV Edx,esp//Pass the record tmessage constructed in the stack to the edxMOV EAX,[ECX]. LONGINT[4]//Pass the self pointer to eax, the self pointer in the class that points to the VMT entry addressCall [ECX]. Pointer//Call the Mainwndproc methodADD esp,12 POP eaxend;function calcjmpoffset (SRC, Dest:pointer): longint;begin Result: = Longint (Dest)-    (Longint (SRC) + 5); end;function makeobjectinstance (Method:twndmethod): Pointer;const blockcode:array[1..2] of Byte = (      $59, {POP ECX} $E 9);  {JMP Stdwndproc}  PageSize = 4096;var Block:pinstanceblock; Instance:pobjectinstance;begin if instfreelist = nil THEN begin Block: = VirtualAlloc (Nil, PageSize, Mem_commit, PAG E_execute_readwrite);//Allocate virtual memory and specify that the memory is read-write and executableblock^.    Next: = instblocklist; Move (Blockcode, block^.    Code, SizeOf (Blockcode)); block^. Wndprocptr: = Pointer (Calcjmpoffset (@Block ^.    CODE[2], @StdWndProc)); Instance: = @Block ^.    Instances; Repeat instance^.  Code: = $E 8;      {Call near PTR Offset} instance^. Offset: = Calcjmpoffset (Instance, @Block ^.      Code); instance^.      Next: = instfreelist;      Instfreelist: = Instance;    INC (Longint (Instance), SizeOf (tobjectinstance));    Until Longint (Instance)-Longint (Block) >= SizeOf (Tinstanceblock);  Instblocklist: = Block;  End  Result: = instfreelist;  Instance: = instfreelist; Instfreelist: = instance^.  Next; instance^. Method: = Method;end;

(Note: Those 16 binary codes that appear above are actually some 16 binary machine codes $59=pop ECX $E 8=call $E 9=jmp)
The above code looks a bit messy, but a comprehensive look is also very good understanding! Makeobjectinstance is actually building a block list.
Its structure looks at the structure of the recorded tinstanceblock and its structure is as follows:
Next//Next page pointer
Code//pop ECX and JMP
Address offset between wndprocptr//and Stdwndproc
Instances//Next is 314 instance linked list
The instance list is also well understood by recording tobjectinstance.
Code//call
Offset//Address offsets
Method//Pointers to object methods (combined with TMethod good understanding twndmethod Such object method pointers point to the structure of the data)
OK now to review this process, what is Windows callback? In fact, go to and execute a dynamically generated code: first execute call offset, go to execute pop ECX based on offset, of course, because the next command will be in the stack before call, so here is a pointer to the object method. The next step is to execute jmp [Stdwndproc], which assigns the recorded tmessage pointer constructed in the stack to edx, which is easy to understand based on the above explanations, combined with TMethod.
MOV EAX,[ECX]. LONGINT[4]; Pass the self pointer to eax, which is the self pointer in the class that points to the VMT entry address
Call [ECX]. Pointer; Call the Mainwndproc method
Now finally enlightened, the Windows message was passed to the Twincontrol.Mainwndproc, it is much more efficient to retrieve the corresponding object pointer based on the form handle than the callback global function AfxWndProc in MFC! VCL than MFC excellent another corroboration! ^_^
Now we've finally found a way for VCL to receive messagesMainwndproc

Procedure Twincontrol.mainwndproc (var message:tmessage); Begin  Try    try

      //Because Tcontrol has already pointed fwindowproc to WndProc when creating an instance, this is actually called WndProc      WindowProc (Message);    Finally      Freedevicecontexts;      freememorycontexts; //Call freedevicecontexts and freememorycontexts to ensure VCL thread safety    End;  Except    application.handleexception (self);  End;end;

It is also not possible to overlook the twincontrol. WndProc

Procedure Tcontrol.wndproc (var message:tmessage); var  form:tcustomform;  Keystate:tkeyboardstate;    Wheelmsg:tcmmousewheel;begin ...  Omit the above message related processing code, study some specific messages can be self-viewing  ...  Dispatch (Message); //Call dispatch processing end;

Next, don't worry about looking at the code in dispatch. Think about it, forget what?
The above is just a handle-dependent control that inherits from the Twincontrol , and how does the control that inherits the handle from Tgraphiccontrol get and process the message? The following is an example of a mouse message:

Twincontrol. The following code is in the WndProc :

Case Message.msg of ... Wm_mousefirst. Wm_mouselast://NOTE 1: Explain the paragraph below      If Iscontrolmousemsg (Twmmouse (Message)) THEN begin {Check handleallocated because iscontrolmousemsg mig HT has freed the window if user code executed something like Parent: = nil. } if (Message.result = 0) and handleallocated then DefWindowProc (Handle, Message.msg, Message.wparam, Mess        Age.lparam);      Exit;  End  ... end; Inherited WndProc (Message);  Perform ancestor class WndProc method function Twincontrol.iscontrolmousemsg (var message:twmmouse): Boolean;var Control:tcontrol;    P:tpoint;begin if getcapture = Handle THEN begin Control: = nil;  if (Capturecontrol <> nil) and (capturecontrol.parent = self) then Control: = Capturecontrol;  End Else Control: = Controlatpos (Smallpointtopoint (Message.pos), false);//Here the mouse control is obtained by Controlatpos Result: = False;    If Control <> nil then begin p.x: = Message.xpos-control.left;    P.Y: = Message.ypos-control.top; Message.result: = Control.perform (Message.msg, Message.keys, LoNgint (Pointtosmallpoint (P)));//Call the Perform method to send a message to the corresponding instance Result: = True; End;end;property Windowproc:twndmethod Read Fwindowproc write fwindowproc;function tcontrol.perform (msg:cardinal;  WParam, Lparam:longint): Longint;var message:tmessage;begin message.msg: = MSG;  Message.wparam: = WParam;  Message.lparam: = LParam;  Message.result: = 0; If self <> nil then WindowProc (Message), or//because Tcontrol has fwindowproc point to WndProc when creating an instance, this is actually called WndProc result: Message.result;end;

This is how

VCL distributes messages to graphical controls that inherit from the tgraphiccontrol with no handles.  
It says Windows messages (Windows Messages), and it seems to say that two of the frequently used VCL custom messages: Cm_mouseenter,cm_mouseleave (CM = short of Control Message)  
How are they handled? Or look at the above (if not ProcessMessage (msg) then Idle (msg), these two are not Windows messages, so the Idle

is triggered.

Procedure Tapplication.idle (const msg:tmsg); var Control:tcontrol; Done:boolean;begin Control: = domouseidle;//Call Domouseidle method ... end;function tapplication.domouseidle:tcontrol;var Ca  Pturecontrol:tcontrol;  P:tpoint;begin GetCursorPos (P); Result: = Finddragtarget (P, True);//Gets the control that the current mouse is resting on if (Result <> nil) and (csdesigning in Result.componentstate) the  N Result: = nil;  Capturecontrol: = Getcapturecontrol; If Fmousecontrol <> Result then//Determines whether the control previously recorded by the mouse pointer is the same as the control that is now pointing to the same begin if ((Fmousecontrol <> nil) and (Capt Urecontrol = nil) or ((Capturecontrol <> nil) and (Fmousecontrol = Capturecontrol)) then fmousecontrol.pe Rform (cm_mouseleave, 0, 0);//sends a message cm_mouseleave the control that the previously recorded mouse pointer points to Fmousecontrol: = result;//records the control that the current mouse pointer points to if (fmousec Ontrol <> Nil) and (Capturecontrol = nil) or ((Capturecontrol <> nil) and (Fmousecontrol = Capturecontro L) then Fmousecontrol.perform (cm_mouseenter, 0, 0);//Send message cm_mouseenter to mouseThe pin now resides in the control end;end;function finddragtarget (const pos:tpoint;  Allowdisabled:boolean): Tcontrol;var Window:twincontrol;  Control:tcontrol;begin Result: = nil; window: = Findvclwindow (Pos);//The return is Twincontrol, a control with a handle if window <> nil then begin Result: = window;

    //The mouse may also have a graphical control that inherits from the Tgraphiccontrol, and the above returns only its container control    Control: = Window.controlatpos (Window.screentoclient (Pos), allowdisabled);    If control <> nil then Result: = control;//Returns the control end;end obtained with Controlatpos if present  ;

Then he turned to the tcontrol above. Perform
Now all the questions are focused on dispatch, how does the message trigger the handling of the event?
First look at the declaration of the message processing method:

message Cm_mouseenter;

This can actually be considered as declaring a dynamic method, and invoking dispatch is actually finding the corresponding dynamic method pointer in the DMT (dynamic Method table) via the message number, and then executing

As mentioned above, the register eax is the self pointer of the class, that is, the VMT entry address, which is a pointer to the record message in the register edx

procedureTobject.dispatch (var Message);
ASM
PUSH ESI
MOV Si,[edx]//message number, which is the value of MSG in Tmessage, corresponds to Cm_mouseenter is $b013 (45075)
OR Si,si
JE @ @default
CMP si,0c000h
JAE @ @default
PUSH EAX
MOV Eax,[eax]//VMT Entry Address
Call Getdynamethod//Call Getdynamethod Find
POP EAX
JE @ @default//In Getdynamethod if found, the value of the flag bit register will be set to 0, if it is 1, it is not found, execution jumps
MOV Ecx,esi//Pass pointer to ECX
POP ESI
JMP ECX//Jump to the location pointed to by ECX, and complete the process of calling Cmmouseenter with the message number
@ @default:
POP ESI
MOV Ecx,[eax]
JMP DWORD ptr [Ecx].vmtdefaulthandlerif this control and its ancestor classes do not have a processing method that corresponds to this message number, call DefaultHandler
end;

procedureGetdynamethod;
{function Getdynamethod (vmt:tclass; selector:smallint): Pointer; }
Asm
{-EAX VMT of Class}
{SI dynamic Method index}
{<-ESI pointer to routine}
{ZF = 0 if found}
{trashes:eax, ECX}
PUSH EDI
XCHG Eax,esi//Exchange eax and ESI values, after which the VMT entry address in ESI, EAX is the message number, i.e. the code of the corresponding dynamic method
JMP @ @haveVMT
@ @outerLoop:
MOV Esi,[esi]
@ @haveVMT:
MOV edi,[esi].vmtdynamictable//Try to pass DMT's ingress address to EDI
TEST Edi,edi//Whether the presence of DMT is determined by EDI
JE @ @parent//Does not exist jump to parent class to continue
Movzx ecx,word ptr [EDI]//Fetch [EDI], which is the value of the first two bytes of DMT passed to ECX, that is, the number of dynamic methods
PUSH ECX
ADD edi,2//Address plus 2, which is the section that skips the number of dynamic methods stored in DMT
Repne SCASW//eax The data pointed to by the EDI is compared by word, until it is found (zf=1) or ecx=0
JE @ @found
POP ECX
@ @parent:
MOV esi,[esi].vmtparent//Try to get the parent class
TEST Esi,esi//Whether the parent class is determined by EDI
JNE @ @outerLoop//exist to jump to @ @outerLoop to find
JMP @ @exit//exit
@ @found:
POP EAX
ADD Eax,eax
SUB EAX,ECX{This'll always clear the Z-flag!} The use of this sentence is mentioned above will mark the ZF 0
MOV Esi,[edi+eax*2-4]//Pass the obtained method pointer to ESI, understand this sentence first to understand the content of the DMT structure
@ @exit:
POP EDI
End

In VCL, the structure of DMT is such that the first 2 bytes store the number of dynamic methods in DMT N, then the method code, total 4*n bytes, and finally the method pointer, also 4*n bytes!
This is a good understanding, EDI-4 is the current method code address, edi-4+4*n=edi+eax*2-4 (because already executed an add eax,eax, so eax=2*n) so, [edi+eax*2-4] is found the corresponding method pointer.
Combine the following

Tnotifyevent = procedure (sender:tobject) of object; Fonmouseenter:tnotifyevent;  Property Read Write Fonmouseenter;procedure TXXX. Cmmouseenter (var message:tmessage); Begin  inherited;  If Assigned (fonmouseenter) then    fonmouseenter (self); end;

After jumping to cmmouseenter execution, judge whether the method pointer Fonmouseenter is nil, if not empty, execute the corresponding event handling Method!
Through a seemingly complex process above, we use Delphi developers only need to be very simple in a similar
procedure Tformx.xxxmouseenter (Sender:tobject);
begin
  //
end;
(XXX. Onmouseenter:=xxxmouseenter;)
In the process of writing two lines of simple code, it is easy to implement the so-called event-driven!

VCL Message processing mechanism