Delphi,一个非常优秀的开发工具,拥有强大的可视化开发环境、面向组件的快速开发模式、优秀的VCL类库、快速的代码编译器、强大的数据库和WEB开发能力、还有众多的第三方控件支持...(此处省略x千字,既然大家都知道了,不浪费口水了 ^_^)说到VCL的优秀就不能不提到其对Windows消息及API的较全面和完美的封装,正因为如此开发者在大多数情况下甚至不需理会Windows消息处理的细节,而只需要写几行事件驱动代码即可!但如果做为开发人员你还是想对此做些了解的话,那么就继续,通过VCL代码本身来体会VCL中的消息处理机制。(以下代码取自Delphi 6)说到VCL中的消息处理就不能不提到TApplication,Windows会为每一个当前运行的程序建立一个消息队列,用来完成用户与程序的交互,正是通过Application完成了对Windows消息的集中处理!首先通过Application.Run进入消息循环进行消息的处理,其中调用了HandleMessage。procedure TApplication.HandleMessage;
var
Msg: TMsg;
begin
if not ProcessMessage(Msg) then Idle(Msg);//这里先调用ProcessMessage处理,返回值为False调用Idle,就是在空闲时,即消息队列中无消息等待处理时调用Idle。
end;function TApplication.ProcessMessage(var Msg: TMsg): Boolean;
var
Handled: Boolean;
begin
Result := False;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then//查询消息队列中有无消息等待处理,参数PM_REMOVE使消息在处理完后会被删除。
begin
Result := True;
if Msg.Message <> WM_QUIT then//如果是WM_QUIT,终止进程,否则执行下面的代码
begin
Handled := False;
if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and
not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
begin
TranslateMessage(Msg);//将记录Msg传递给Windows进行转换
DispatchMessage(Msg);//将记录Msg回传给Windows
end;
end
else
FTerminate := True;
end;
end;然后程序中的各个VCL对象又是如何接收到Windows消息的呢?这还要从窗体的创建开始!首先找到TWinControl.CreateWnd中的
Windows.RegisterClass(WindowClass)//调用RegisterClass注册一个窗体类向上看
WindowClass.lpfnWndProc := @InitWndProc;//这里指定了窗口的消息处理函数的指针为@InitWndProc!再找到function InitWndProc(HWindow: HWnd; Message, WParam, LParam: Longint): Longint;发现了
CreationControl.FHandle := HWindow;
SetWindowLong(HWindow, GWL_WNDPROC,Longint(CreationControl.FObjectInstance));
没有?原来InitWndProc初次被调用时候,又使用API函数SetWindowLong指定处理消息的窗口过程为FObjectInstance。回到TWinControl.Create
FObjectInstance := Classes.MakeObjectInstance(MainWndProc);
找到关键所在了,也许有些朋友对MakeObjectInstance这个函数很熟了,它的作用就是将一个成员过程转换为标准过程。绕了个圈子?为什么呢?很简单,因为窗体成员过程包括一隐含参数传递Self指针,所以需要转化为标准过程。const
InstanceCount = 313;//这个不难理解吧?314*13+10=4092,再大的话,记录TInstanceBlock的大小就超过了下面定义的PageSizetype
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 ;将堆栈中构造的记录TMessage指针赋给EDX
MOV EAX,[ECX].Longint[4] ;传递Self指针给EAX,类中的Self指针也就是指向VMT入口地址
CALL [ECX].Pointer ;调用MainWndProc方法
ADD ESP,12
POP EAX
end;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 }
$E9); { JMP StdWndProc }
PageSize = 4096;
var
Block: PInstanceBlock;
Instance: PObjectInstance;
begin
if InstFreeList = nil then
begin
Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);//分配虚拟内存,并指定这块内存为可读写并可执行
Block^.Next := InstBlockList;
Move(BlockCode, Block^.Code, SizeOf(BlockCode));
Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc));
Instance := @Block^.Instances;
repeat
Instance^.Code := $E8; { 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;(注:上面出现的那些16进制代码其实就是些16进制的机器代码 $59=Pop ECX $E8=Call $E9=Jmp)以上代码看起来有点乱,但综合起来看也很好理解!MakeObjectInstance实际上就是构建了一个Block链表其结构看看记录TInstanceBlock的结构可知其结构如下:Next//下一页指针
Code//Pop ECX和Jmp
WndProcPtr//和StdWndProc间的地址偏移
Instances//接下来是314个Instance链表Instance链表通过记录TObjectInstance也很好理解其内容Code//Call
Offset//地址偏移
Method//指向对象方法的指针(结合TMethod很好理解TWndMethod这类对象方法指针指向数据的结构)好现在来把这个流程回顾一遍,Windows回调的是什么呢?其实是转到并执行一段动态生成的代码:先是执行Call offset ,根据偏移量转去执行Pop ECX,当然由于在Call这之前会将下一条指令入栈,所以这里弹出的就是指向对象方法的指针。接下来就是执行jmp [StdWndProc],其中将堆栈中构造的记录TMessage指针赋给了EDX,而根据上面的解释结合TMethod去理解,很容易理解
MOV EAX,[ECX].Longint[4] ;传递Self指针给EAX,类中的Self指针也就是指向VMT入口地址
CALL [ECX].Pointer ;调用MainWndProc方法现在终于豁然开朗了,Windows消息就是这样被传递到了TWinControl.MainWndProc,相比MFC中的回调全局函数AfxWndProc来根据窗体句柄检索对应的对象指针的方法效率要高的多!VCL比MFC优秀的又一佐证! ^_^现在终于找到了VCL接收消息的方法MainWndProcprocedure TWinControl.MainWndProc(var Message: TMessage);
begin
try
try
WindowProc(Message);//由于TControl创建实例时已经将FWindowProc指向WndProc,所以这里实际也就是调用WndProc
finally
FreeDeviceContexts;
FreeMemoryContexts;//调用FreeDeviceContexts和FreeMemoryContexts是为了保证VCL线程安全
end;
except
Application.HandleException(Self);
end;
end;这里也不能忽略了TWinControl.WndProcprocedure TControl.WndProc(var Message: TMessage);
var
Form: TCustomForm;
KeyState: TKeyboardState;
WheelMsg: TCMMouseWheel;
begin
...
//省略以上的消息相关处理代码,研究某些特定消息时可自行查看
...
Dispatch(Message);//调用Dispatch处理
end;
var
Msg: TMsg;
begin
if not ProcessMessage(Msg) then Idle(Msg);//这里先调用ProcessMessage处理,返回值为False调用Idle,就是在空闲时,即消息队列中无消息等待处理时调用Idle。
end;function TApplication.ProcessMessage(var Msg: TMsg): Boolean;
var
Handled: Boolean;
begin
Result := False;
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then//查询消息队列中有无消息等待处理,参数PM_REMOVE使消息在处理完后会被删除。
begin
Result := True;
if Msg.Message <> WM_QUIT then//如果是WM_QUIT,终止进程,否则执行下面的代码
begin
Handled := False;
if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and
not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
begin
TranslateMessage(Msg);//将记录Msg传递给Windows进行转换
DispatchMessage(Msg);//将记录Msg回传给Windows
end;
end
else
FTerminate := True;
end;
end;然后程序中的各个VCL对象又是如何接收到Windows消息的呢?这还要从窗体的创建开始!首先找到TWinControl.CreateWnd中的
Windows.RegisterClass(WindowClass)//调用RegisterClass注册一个窗体类向上看
WindowClass.lpfnWndProc := @InitWndProc;//这里指定了窗口的消息处理函数的指针为@InitWndProc!再找到function InitWndProc(HWindow: HWnd; Message, WParam, LParam: Longint): Longint;发现了
CreationControl.FHandle := HWindow;
SetWindowLong(HWindow, GWL_WNDPROC,Longint(CreationControl.FObjectInstance));
没有?原来InitWndProc初次被调用时候,又使用API函数SetWindowLong指定处理消息的窗口过程为FObjectInstance。回到TWinControl.Create
FObjectInstance := Classes.MakeObjectInstance(MainWndProc);
找到关键所在了,也许有些朋友对MakeObjectInstance这个函数很熟了,它的作用就是将一个成员过程转换为标准过程。绕了个圈子?为什么呢?很简单,因为窗体成员过程包括一隐含参数传递Self指针,所以需要转化为标准过程。const
InstanceCount = 313;//这个不难理解吧?314*13+10=4092,再大的话,记录TInstanceBlock的大小就超过了下面定义的PageSizetype
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 ;将堆栈中构造的记录TMessage指针赋给EDX
MOV EAX,[ECX].Longint[4] ;传递Self指针给EAX,类中的Self指针也就是指向VMT入口地址
CALL [ECX].Pointer ;调用MainWndProc方法
ADD ESP,12
POP EAX
end;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 }
$E9); { JMP StdWndProc }
PageSize = 4096;
var
Block: PInstanceBlock;
Instance: PObjectInstance;
begin
if InstFreeList = nil then
begin
Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);//分配虚拟内存,并指定这块内存为可读写并可执行
Block^.Next := InstBlockList;
Move(BlockCode, Block^.Code, SizeOf(BlockCode));
Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc));
Instance := @Block^.Instances;
repeat
Instance^.Code := $E8; { 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;(注:上面出现的那些16进制代码其实就是些16进制的机器代码 $59=Pop ECX $E8=Call $E9=Jmp)以上代码看起来有点乱,但综合起来看也很好理解!MakeObjectInstance实际上就是构建了一个Block链表其结构看看记录TInstanceBlock的结构可知其结构如下:Next//下一页指针
Code//Pop ECX和Jmp
WndProcPtr//和StdWndProc间的地址偏移
Instances//接下来是314个Instance链表Instance链表通过记录TObjectInstance也很好理解其内容Code//Call
Offset//地址偏移
Method//指向对象方法的指针(结合TMethod很好理解TWndMethod这类对象方法指针指向数据的结构)好现在来把这个流程回顾一遍,Windows回调的是什么呢?其实是转到并执行一段动态生成的代码:先是执行Call offset ,根据偏移量转去执行Pop ECX,当然由于在Call这之前会将下一条指令入栈,所以这里弹出的就是指向对象方法的指针。接下来就是执行jmp [StdWndProc],其中将堆栈中构造的记录TMessage指针赋给了EDX,而根据上面的解释结合TMethod去理解,很容易理解
MOV EAX,[ECX].Longint[4] ;传递Self指针给EAX,类中的Self指针也就是指向VMT入口地址
CALL [ECX].Pointer ;调用MainWndProc方法现在终于豁然开朗了,Windows消息就是这样被传递到了TWinControl.MainWndProc,相比MFC中的回调全局函数AfxWndProc来根据窗体句柄检索对应的对象指针的方法效率要高的多!VCL比MFC优秀的又一佐证! ^_^现在终于找到了VCL接收消息的方法MainWndProcprocedure TWinControl.MainWndProc(var Message: TMessage);
begin
try
try
WindowProc(Message);//由于TControl创建实例时已经将FWindowProc指向WndProc,所以这里实际也就是调用WndProc
finally
FreeDeviceContexts;
FreeMemoryContexts;//调用FreeDeviceContexts和FreeMemoryContexts是为了保证VCL线程安全
end;
except
Application.HandleException(Self);
end;
end;这里也不能忽略了TWinControl.WndProcprocedure TControl.WndProc(var Message: TMessage);
var
Form: TCustomForm;
KeyState: TKeyboardState;
WheelMsg: TCMMouseWheel;
begin
...
//省略以上的消息相关处理代码,研究某些特定消息时可自行查看
...
Dispatch(Message);//调用Dispatch处理
end;
解决方案 »
- excel_tlb.pas,office_tlb.pas,vbide_tlb.pas从什么地方可以免费下载啊?
- 郁闷死了,程序加到启动里,启动时报错!!!
- INDY的IdUDPServer长时间运行后不能接收到数据
- 關於RICHEDIT的使用問題,各位仁兄請進~!
- 如何在设计期间让form2继承form1,继承后form2在设计是就和form1一样了?
- ADO-Connect的用法
- DBE数据库发布经验谈。大家聊聊吧!
- 100分求delphi开发定制格式生成可变格式文件的程序
- 如何把delphi编写的程序做成安装程序?
- 我希望做个启动画面,但如果在formcreate里show另一个form,就会出错,为什么?
- delphi的exe 如何接收参数?
- 请问画完一幅图后如何檫掉画另外一幅图呢??????????
...
WM_MOUSEFIRST..WM_MOUSELAST://注1:下面再解释这段
if IsControlMouseMsg(TWMMouse(Message)) then
begin
{ Check HandleAllocated because IsControlMouseMsg might have freed the
window if user code executed something like Parent := nil. }
if (Message.Result = 0) and HandleAllocated then
DefWindowProc(Handle, Message.Msg, Message.wParam, Message.lParam);
Exit;
end;
...
end;
inherited WndProc(Message);//执行祖先类的WndProc方法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);//这里通过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)));//调用Perform方法发送消息给对应的实例
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);//由于TControl创建实例时已经将FWindowProc指向WndProc,所以这里实际也就是调用WndProc
Result := Message.Result;
end;VCL中就是这样将消息分发给了那些继承于TGraphicControl的没有句柄的图形控件。上面说的都是Windows消息(Windows Messages),似乎还应该说说两条经常用到的VCL中自定义消息:CM_MOUSEENTER,CM_MOUSELEAVE(CM = Short of Control Message)它们是如何被处理的呢?还是看上面的(if not ProcessMessage(Msg) then Idle(Msg);),这两条不是Windows消息,所以会触发Idleprocedure TApplication.Idle(const Msg: TMsg);
var
Control: TControl;
Done: Boolean;
begin
Control := DoMouseIdle;//调用DoMouseIdle方法
...
end;function TApplication.DoMouseIdle: TControl;
var
CaptureControl: TControl;
P: TPoint;
begin
GetCursorPos(P);
Result := FindDragTarget(P, True);//获取当前鼠标所停留在的控件
if (Result <> nil) and (csDesigning in Result.ComponentState) then
Result := nil;
CaptureControl := GetCaptureControl;
if FMouseControl <> Result then//判断以前记录的鼠标指针所指向的控件和现在所指向的控件是否相同
begin
if ((FMouseControl <> nil) and (CaptureControl = nil)) or
((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
FMouseControl.Perform(CM_MOUSELEAVE, 0, 0);//发送消息CM_MOUSELEAVE给以前记录的鼠标指针所指向的控件
FMouseControl := Result;//记录当前鼠标指针所指向的控件
if ((FMouseControl <> nil) and (CaptureControl = nil)) or
((CaptureControl <> nil) and (FMouseControl = CaptureControl)) then
FMouseControl.Perform(CM_MOUSEENTER, 0, 0);//发送消息CM_MOUSEENTER给鼠标指针现在所在的控件
end;
end;function FindDragTarget(const Pos: TPoint; AllowDisabled: Boolean): TControl;
var
Window: TWinControl;
Control: TControl;
begin
Result := nil;
Window := FindVCLWindow(Pos);//这里返回的是TWinControl,是一个有句柄的控件
if Window <> nil then
begin
Result := Window;
Control := Window.ControlAtPos(Window.ScreenToClient(Pos), AllowDisabled);//鼠标所指向处可能还存在一继承于TGraphicControl的图形控件,而上面返回的只是其容器控件
if Control <> nil then Result := Control;//如果存在就返回用ControlAtPos所得到的控件
end;
end;于是又转到了上面的TControl.Perform现在所有的问题又都集中到了Dispatch的身上,消息是如何触发事件的处理方法的呢?首先看条消息处理方法的申明:
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;这实际可以认为是申明了一个动态方法,调用Dispatch实际上就是通过消息号在DMT(动态方法表)中找到相应的动态方法指针,然后执行//上面已经提到了,寄存器EAX中是类的Self指针,即VMT入口地址,寄存器EDX中是指向记录Message的指针
procedure TObject.Dispatch(var Message);
asm
PUSH ESI
MOV SI,[EDX] ;消息号,也就是记录TMessage中Msg的值,对应CM_MOUSEENTER就是$B013(45075)
OR SI,SI
JE @@default
CMP SI,0C000H
JAE @@default
PUSH EAX
MOV EAX,[EAX] ;VMT入口地址
CALL GetDynaMethod ;调用GetDynaMethod查找
POP EAX
JE @@default ;在GetDynaMethod中如果找到会将标志位寄存器的值置为0,如果是1,表示未找到,执行跳转
MOV ECX,ESI ;传递指针给ECX
POP ESI
JMP ECX ;跳转到ECX所指向的位置,也就完成了通过消息号调用CMMouseEnter的过程@@default:
POP ESI
MOV ECX,[EAX]
JMP dword ptr [ECX].vmtDefaultHandler ;如果此构件和它的祖先类中都没有对应此消息的处理句柄,调用Defaulthandler方法
end;procedure GetDynaMethod;
{ 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 ;交换EAX和ESI的值,这之后ESI中为VMT入口地址,EAX为消息号,即对应动态方法的代号
JMP @@haveVMT
@@outerLoop:
MOV ESI,[ESI]
@@haveVMT:
MOV EDI,[ESI].vmtDynamicTable ;尝试着将DMT的入口地址传递给EDI TEST EDI,EDI ;通过EDI是否为0来判断是否存在DMT
JE @@parent ;不存在跳转到父类继续
MOVZX ECX,word ptr [EDI] ;取[EDI],即DMT的头两个字节的值传递给ECX,即动态方法的个数
PUSH ECX
ADD EDI,2 ;地址加2,即跳过DMT中存储动态方法的个数的部分
REPNE SCASW ;EAX与EDI指向的数据按字依次比较,直到找到(ZF=1)或ECX=0为止
JE @@found
POP ECX
@@parent:
MOV ESI,[ESI].vmtParent ;尝试获得父类
TEST ESI,ESI ;通过EDI是否为0来判断是否存在父类
JNE @@outerLoop ;存在就跳转到@@outerLoop进行查找
JMP @@exit ;退出@@found:
POP EAX
ADD EAX,EAX
SUB EAX,ECX { this will always clear the Z-flag ! } ;这句的用途就上上面说到的将标志位ZF置0
MOV ESI,[EDI+EAX*2-4] ;将获得的方法指针传递给ESI,理解这句先要对DMT结构的内容做些了解@@exit:
POP EDI
end;在VCL中,DMT的结构是这样的,前2个字节储存了DMT中动态方法的个数n,然后是方法代号,共4*n字节,最后是方法指针,也是4*n字节!这样就很好理解了,EDI-4就是当前方法代号所在地址,EDI-4+4*n=EDI+EAX*2-4(因为已经执行了一句ADD EAX,EAX,所以EAX=2*n)所以,[EDI+EAX*2-4]就是所找到了相应方法指针。结合下面的TNotifyEvent = procedure(Sender: TObject) of object;FOnMouseEnter: TNotifyEvent;property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;procedure TXXX.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;在跳转到CMMouseEnter执行后,判断方法指针FOnMouseEnter是否是nil,如果不为空,就执行相应的事件处理方法!通过以上的一个看似复杂的过程,我们这些用Delphi的开发人员只需要很简单的在类似
procedure TFormX.XXXMouseEnter(Sender: TObject);
begin
//
end;(XXX.OnMouseEnter:=XXXMouseEnter;)的过程中写两行简单的代码,就能很容易的实现所谓的事件驱动!很多人也许只看中结果,并不在乎过程,从这不能简单评论谁对谁错,对于这些知识的了解是否有用,我们每个人都可以自己去体会~~~
《delphi高手突破》书店有售
那么知道了这些,究竟VCL是怎样调用CreateWnd呢
我从
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
一开始调试
记录一下主要的过程
当Application.CreateForm时
执行到
constructor TCustomForm.Create(AOwner: TComponent);
begin
GlobalNameSpace.BeginWrite;
try
CreateNew(AOwner);
if (ClassType <> TForm) and not (csDesigning in ComponentState) then
begin
Include(FFormState, fsCreating);
try
if not InitInheritedComponent(Self, TForm) then
raise EResNotFound.CreateFmt(SResNotFound, [ClassName]);
finally
Exclude(FFormState, fsCreating);
end;
if OldCreateOrder then DoCreate;
end;
finally
GlobalNameSpace.EndWrite;
end;
end;关键一处
InitInheritedComponent
由调试看出的调用顺序,关键的部分InitInheritedComponent
InternalReadComponentRes //读取窗体资源,也就是准备根据DFM描述建立窗体控件
TResourceStream.ReadComponent
TReader.ReadRootComponent
TCustomForm.ReadState
TComponent.ReadState
TReader.ReadData
TReader.ReadDataInner
这个比较让人感兴趣的
procedure TReader.ReadDataInner(Instance: TComponent);
var
OldParent, OldOwner: TComponent;
begin
while not EndOfList do ReadProperty(Instance);
ReadListEnd;
OldParent := Parent;
OldOwner := Owner;
Parent := Instance.GetChildParent;
try
Owner := Instance.GetChildOwner;
if not Assigned(Owner) then Owner := Root;
while not EndOfList do ReadComponent(nil);
ReadListEnd;
finally
Parent := OldParent;
Owner := OldOwner;
end;
end;
这句ReadProperty(Instance);就是读取MainForm上的属性并设置属性值
ReadComponent就是读取MainForm上的控件描述并建立之并设置相应的控件属性值
这些操作做完之后,回到
procedure TCustomForm.ReadState(Reader: TReader);
var
NewTextHeight: Integer;
Scaled: Boolean;
begin
DisableAlign;
try
FClientWidth := 0;
FClientHeight := 0;
FTextHeight := 0;
Scaled := False;
FOldCreateOrder := not ModuleIsCpp;
inherited ReadState(Reader); //回到这 if (FPixelsPerInch <> 0) and (FTextHeight > 0) then
begin
if (sfFont in ScalingFlags) and (FPixelsPerInch <> Screen.PixelsPerInch) then
Font.Height := MulDiv(Font.Height, Screen.PixelsPerInch, FPixelsPerInch);
FPixelsPerInch := Screen.PixelsPerInch;
NewTextHeight := GetTextHeight;
if FTextHeight <> NewTextHeight then
begin
Scaled := True;
ScaleScrollBars(NewTextHeight, FTextHeight);
ScaleControls(NewTextHeight, FTextHeight);
if sfWidth in ScalingFlags then
FClientWidth := MulDiv(FClientWidth, NewTextHeight, FTextHeight);
if sfHeight in ScalingFlags then
FClientHeight := MulDiv(FClientHeight, NewTextHeight, FTextHeight);
if sfDesignSize in ScalingFlags then
begin
FDesignSize.X := MulDiv(FDesignSize.X, NewTextHeight, FTextHeight);
FDesignSize.Y := MulDiv(FDesignSize.Y, NewTextHeight, FTextHeight);
end;
end;
end;
if FClientWidth > 0 then inherited ClientWidth := FClientWidth;
if FClientHeight > 0 then inherited ClientHeight := FClientHeight;
ScalingFlags := [];
if not Scaled then
begin
{ Forces all ScalingFlags to [] }
ScaleScrollBars(1, 1);
ScaleControls(1, 1);
end;
Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
finally
EnableAlign;
end;
end;注意:我这边调试了好几遍窗体的创建就在这个属性设置
NewTextHeight := GetTextHeight;调用GetTextHeight,跟踪
function TCustomForm.GetTextHeight: Integer;
begin
Result := Canvas.TextHeight('0');
end;
到达
function TCanvas.TextHeight(const Text: string): Integer;
begin
Result := TextExtent(Text).cY;
end;function TCanvas.TextExtent(const Text: string): TSize;
begin
RequiredState([csHandleValid, csFontValid]);
Result.cX := 0;
Result.cY := 0;
Windows.GetTextExtentPoint32(FHandle, PChar(Text), Length(Text), Result);
end;procedure TCanvas.RequiredState(ReqState: TCanvasState);
var
NeededState: TCanvasState;
begin
NeededState := ReqState - State;
if NeededState <> [] then
begin
if csHandleValid in NeededState then
begin
CreateHandle;
if FHandle = 0 then
raise EInvalidOperation.CreateRes(@SNoCanvasHandle);
end;
if csFontValid in NeededState then CreateFont;
if csPenValid in NeededState then CreatePen;
if csBrushValid in NeededState then CreateBrush;
State := State + NeededState;
end;
end;好了,主角慢慢快出来了
由于NeededState包含csHandleValid一句所以
procedure TControlCanvas.CreateHandle;
begin
if FControl = nil then inherited CreateHandle else
begin
if FDeviceContext = 0 then
begin
with CanvasList.LockList do
try
if Count >= CanvasListCacheSize then FreeDeviceContext;
FDeviceContext := FControl.GetDeviceContext(FWindowHandle);
Add(Self);
finally
CanvasList.UnlockList;
end;
end;
Handle := FDeviceContext;
UpdateTextFlags;
end;
end;
继续执行到了
function TWinControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
begin
if csDesigning in ComponentState then
Result := GetDCEx(Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS)
else
Result := GetDC(Handle);
if Result = 0 then raise EOutOfResources.CreateRes(@SWindowDCError);
WindowHandle := FHandle;
end;执行到了
Result := GetDC(Handle);
Handle为TWinControl的属性
这样定义的
property Handle: HWnd read GetHandle;
所以
function TWinControl.GetHandle: HWnd;
begin
HandleNeeded;
Result := FHandle;
end;procedure TWinControl.HandleNeeded;
begin
if FHandle = 0 then
begin
if Parent <> nil then Parent.HandleNeeded;
CreateHandle;
end;
end;而这时窗体没有创建FHandle = 0;
执行到CreateHandleprocedure TWinControl.CreateHandle;
var
I: Integer;
begin
if FHandle = 0 then
begin
CreateWnd;
SetProp(FHandle, MakeIntAtom(ControlAtom), THandle(Self));
SetProp(FHandle, MakeIntAtom(WindowAtom), THandle(Self));
if Parent <> nil then
SetWindowPos(FHandle, Parent.PrecedingWindow(Self), 0, 0, 0, 0,
SWP_NOMOVE + SWP_NOSIZE + SWP_NOACTIVATE);
for I := 0 to ControlCount - 1 do
Controls[I].UpdateAnchorRules;
end;
end;可以看到CreateWnd这句,这就连上了ehom介绍的了
由于中间的过程挺复杂
我描述不清,大家有时间可以按照上面的大概描述调试一下
就会知道
哪位文笔好,可以总结一下,写一个Delphi窗体的诞生过程,呵呵
1.安装delphi.
2.打开delphi.
3.安下F9
4.一个Delphi窗体的诞生了!!!!!!!!!!!!!!!!!!!!!
的vcl控件对象,但这时一些Windows控件还没有真正建立,也就是说它们的窗口Handle这时还为0,真正建立这些控件Handle发生在Application.Run,
跟踪
procedure TApplication.Run;
begin
FRunning := True;
try
AddExitProc(DoneApplication);
if FMainForm <> nil then
begin
case CmdShow of
SW_SHOWMINNOACTIVE: FMainForm.FWindowState := wsMinimized;
SW_SHOWMAXIMIZED: MainForm.WindowState := wsMaximized;
end;
if FShowMainForm then
if FMainForm.FWindowState = wsMinimized then
Minimize else
FMainForm.Visible := True;
repeat
try
HandleMessage;
except
HandleException(Self);
end;
until Terminated;
end;
finally
FRunning := False;
end;
end;由FMainForm.Visible := True,进入procedure TCustomForm.SetVisible(Value: Boolean);
begin
if fsCreating in FFormState then
if Value then
Include(FFormState, fsVisible) else
Exclude(FFormState, fsVisible)
else
begin
if Value and (Visible <> Value) then SetWindowToMonitor;
inherited Visible := Value;
end;
end;procedure TControl.SetVisible(Value: Boolean);
begin
if FVisible <> Value then
begin
VisibleChanging;
FVisible := Value;
Perform(CM_VISIBLECHANGED, Ord(Value), 0);
RequestAlign;
end;
end;
这样FMainForm会发送一个CM_VISIBLECHANGED内部消息,经过了窗口过程,然后Dispatch,派发到TWinControl.CMVisibleChanged
procedure TWinControl.CMVisibleChanged(var Message: TMessage);
begin
if not FVisible and (Parent <> nil) then RemoveFocus(False);
if not (csDesigning in ComponentState) or
(csNoDesignVisible in ControlStyle) then UpdateControlState;
end;procedure TWinControl.UpdateControlState;
var
Control: TWinControl;
begin
Control := Self;
while Control.Parent <> nil do
begin
Control := Control.Parent;
if not Control.Showing then Exit;
end;
if (Control is TCustomForm) or (Control.FParentWindow <> 0) then UpdateShowing;
end;procedure TWinControl.UpdateShowing;
var
ShowControl: Boolean;
I: Integer;
begin
ShowControl := (FVisible or (csDesigning in ComponentState) and
not (csNoDesignVisible in ControlStyle)) and
not (csReadingState in ControlState);
if ShowControl then
begin
if FHandle = 0 then CreateHandle;
if FWinControls <> nil then
for I := 0 to FWinControls.Count - 1 do
TWinControl(FWinControls[I]).UpdateShowing;
end;
if FHandle <> 0 then
if FShowing <> ShowControl then
begin
FShowing := ShowControl;
try
Perform(CM_SHOWINGCHANGED, 0, 0);
except
FShowing := not ShowControl;
raise;
end;
end;
end;其中下句,遍历MainForm的窗口上的Windows控件并调用UpdateShowing;
if FWinControls <> nil then
for I := 0 to FWinControls.Count - 1 do
TWinControl(FWinControls[I]).UpdateShowing;
为了便于跟踪,窗体上我只放了TButton,
这时F7,就到了TButton.UpdateShowing,还是上面的代码
因为在Watch窗口里这时显示的Self.Name就为Button1;
执行到
if FHandle = 0 then CreateHandle;
由于这时Button1的FHandle为0,所以调用CreateHandle创建,其他动作类似
到这里一个窗体及窗体上的控件就已建立完毕
Charles Petzold写的
在调试的时候,我怎样才能对Application.CreateForm(TMainForm, MainForm);进行调试呢?
怎样设置BreakPoint?才能让我看到FORM的创建过程呢?
这个问题困扰我很长时间了:(,还忘各位给出答案。谢谢了。
Application.CreateForm(TMainForm, MainForm);
上设置断点也可
朱镕基也会感谢你的..呵呵..
"delphi把什么东西都封装的那么好我们如何才能学到更深入的东西呢?"
____下个企业版delphi然后自己去看源代码,你就会了解如何从TObject对象逐渐派生到各种各样的组件