Delphi的对象机制浅探 (100分)

这里也是高手如云呀

01cn上很多都是在这里已成名的高手。
当然现在人气还不够。

昨天只看完了 Windows Callback FObjectInstance 方法的汇编代码。如果 Borland 把 TMessage 设计为 Result 字段在最前面，就不用把 Windows 回调前在堆栈中建立的参数再 PUSH 一遍了，直接把 Windows 传过来的 HWND 设置为 0 后当作 Result 用就行了(因为MainWndProc 并没有使用到 HWND)。这样的话 StdWndProc 就可以设计为只有一段小段代码而不是函数，处理消息的效率可以稍微提高一点。看来 Borland 宁愿降低效率也不愿放弃语法的美感。

下面是从 Windows Callback 开始到 TWinControl.MainWndProc 被调用的汇编代码：

DispatchMessage(&Msg) // Windows 准备回调

Windows 准备回调 TWinControl.FObjectInstance:
push LPARAM
push WPARAM
push UINT
push HWND
push (eip.Next)
把Windows Callback后下一条语句的地址保存在堆栈中
jmp FObjectInstance.Code

FObjectInstance.Code 只有一条 call 语句:
call ObjectInstance.offset
push eip.Next
jmp InstanceBlock.Code ;调用 InstanceBlock.Code

InstanceBlock.Code:
pop ecx ;将 eip.Next 的值存入 ecx, 用于取 @MainWndProc 和 Self
jmp StdWndProc ;跳转至 StdWndProc

StdWndProc 的反汇编代码:
function StdWndProc(Window: HWND
Message, WParam: Longint
LParam: Longint): Longint
stdcall
assembler;
asm
push ebp
mov ebp, esp
XOR EAX,EAX
xor eax, eax
PUSH EAX
push eax
TMessage.Result := 0
PUSH LParam
push dword ptr [ebp+$14]
PUSH WParam
push dword ptr [ebp+$10]
PUSH Message
push dword ptr [ebp+$0c]
MOV EDX,ESP
mov edx, esp
mov edx, var TMessage
MOV EAX,[ECX].Longint[4]
mov eax, [ecx+$04]
mov eax, Self
CALL [ECX].Pointer
call dword ptr [ecx] : call MainWndProc
ADD ESP,12
add esp, $0c
POP EAX
pop eax
end;
pop ebp
ret $0010
mov eax, eax


对于 VCL 消息系统的学习，这只是个开始。在 TWinControl.CreateWnd 方法中设置断点，查看什么时候建立窗口，结果看到的调用堆栈是下面这样：
TWinControl.CreateWnd
TScrollingWinControl.CreateWnd
TCustomForm.CreateWnd
TWinControl.CreateHandle
TWinControl.HandleNeeded
TWinControl.GetHandle
TWinControl.GetDeviceContext(0)
TControlCanvas.CreateHandle
TCanvas.RequiredState([csHandleValid..csFontValid])
TCanvas.TextExtent('0')
TCanvas.TextHeight('0')
TCustomForm.GetTextHeight
TCustomForm.ReadState($9525B4)
TReader.ReadRootComponent($951FA8)
TStream.ReadComponent($951FA8)
InternalReadComponentRes('TForm1',4194304,$951FA8)
InitComponent(TForm1)
InitInheritedComponent($951FA8,TForm)
TCustomForm.Create($9517C8)
TApplication.CreateForm(TForm1,(no value))
Project1

真是太复杂了，除了硬着头皮一行行代码读下去，还有什么好办法呢？

浏览了一个 Application 的执行过程，把过程简单描述一下：

begin
首先调用了一个隐含的过程 _InitExe
_InitExe 初始化了 Module 信息，然后调用 _StartExe
_StartExe 设置异常等，然后调用 InitUnits
InitUnits 调用各个 Units 的 Initialization 段
其中调用到了 Controls.pas 的 Initializaiotn 段
Controls.Initialization 调用 InitControls
InitControls 主要建立 Mouse, Screen和 Application 实例
Application.Create 调用 Application.CreateHandle
Application.CreateHandle 建立一个窗口，并设置 Application.WndProc 为回调函数
Application.WndProc 主要处理一些应用程序级别的消息

然后才是 Project 的第一句： Application.Initialize;
这个过程基本上没有内容，主要是让用户设置一个初始化函数

然后是 Project 的第二句： Application.CreateForm(TForm1, Form1);
新增 Form1的内存实例
调用 Form1.Create -> TCustomForm.Create(Self)
TCustomForm.Create 调用 InitInheritedComponent
InitInheritedComponent 调用 InternalReadComponentRes
InternalReadComponentRes 调用 TStream.ReadComponent
TReader.ReadRootComponent 调用 TCustomForm.ReadState
TCustomForm.ReadState 调用到了 GetTextHeight
TCustomForm.GetTextHeight 调用 TCanvas.TextHeight
TCanvas.TextExtent 调用 TCanvas.RequiredState
这时候才标识出 TControlCanvas.CreateHandle
TControlCanvas.CreateHandle 又调用了 TWinControl.GetDeviceContext
TWinControl.GetDeviceContext 要求使用 Handle 于是调用 TWinControl.GetHandle
TWinControl.GetHandle 需要HWnd，于是调用TWinControl.HandleNeeded
由于没有建立 HWnd，于是调用 TWinControl.CreateHandle
TWinControl.CreateHandle 这才调用 TCustomForm.CreateWnd 建立窗口
TCustomForm.CreateWnd 调用 TScrollingWinControl.CreateWnd
TScrollingWinControl.CreateWnd 调用 TWinControl.CreateWnd这时才真正建立了一个窗口
真是漫漫长路。


最后是：Application.Run;
我还没看代码，估计是建立消息循环之类。


看来不能这样跟踪，相关流操作太多，今天回家单独建立一个 TForm 跟踪一下。
下班了!

最近在看<<windows程序设计>>,对windows编程稍懂了点，下午照vcl抄了一下，只是主要的窗口建立部分，不知对你有没有用，如下

unit MyWindowUnit;

interface

uses Windows, SysUtils, Messages;

type
TMyCreateParams = record
Caption: PChar;
Style: DWORD;
ExStyle: DWORD;
X, Y: Integer;
Width, Height: Integer;
WndParent: HWnd;
Param: Pointer;
WindowClass: TWndClass;
WinClassName: array[0..63] of Char;
end;

TMyMessage = packed record
Msg: Cardinal;
case Integer of
0: (
WParam: Longint;
LParam: Longint;
Result: Longint);
1: (
WParamLo: Word;
WParamHi: Word;
LParamLo: Word;
LParamHi: Word;
ResultLo: Word;
ResultHi: Word);
end;
TMyWndMethod = procedure(var Message: TMyMessage) of object;


TMyWindow = class
private
FHandle: HWnd;
FDefWndProc: Pointer;
FObjectInstance: Pointer;

function GetHandle: HWnd;

protected
procedure CreateWindowHandle(const Params: TMyCreateParams)
virtual;
procedure CreateParams(var Params: TMyCreateParams)
virtual;
procedure CreateHandle
virtual;
procedure CreateWnd
virtual;

procedure WndProc(var Message: TMyMessage)
virtual;
procedure MainWndProc(var Message: TMyMessage);

public
procedure DefaultHandler(var Message)
override;

procedure HandleNeeded;
procedure ShowWindow;
procedure UpdateWindow;

constructor Create
virtual;
property Handle: HWnd read GetHandle;

end;

implementation

{ TMyWindow }
type
PMyObjectInstance = ^TMyObjectInstance;
TMyObjectInstance = packed record
CodeCall: Byte;
Offset: Integer;
Method: TMyWndMethod;
CodeJmp: array[1..2] of Byte;
WndProcPtr: Pointer;
end;

function MyStdWndProc(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
MOV EAX,[ECX].Longint[4]
CALL [ECX].Pointer
ADD ESP,12
POP EAX
end;

function MyCalcJmpOffset(Src, Dest: Pointer): Longint;
begin
Result := Longint(Dest) - (Longint(Src) + 5);
end;

function MyMakeObjectInstance(Method: TMyWndMethod): Pointer;
const
BlockCode: array[1..2] of Byte = (
$59, { POP ECX }
$E9)
{ JMP MyStdWndProc }
var
PBlock: PMyObjectInstance;
begin
PBlock := VirtualAlloc(nil, SizeOf(TMyObjectInstance), MEM_COMMIT,
PAGE_EXECUTE_READWRITE);
Move(BlockCode, PBlock^.CodeJmp, SizeOf(BlockCode));
PBlock^.WndProcPtr := Pointer(MyCalcJmpOffset(@PBlock^.CodeJmp[2], @MyStdWndProc));
PBlock^.CodeCall := $E8;
PBlock^.Offset := MyCalcJmpOffset(PBlock, @PBlock^.CodeJmp);
PBlock^.Method := Method;
Result := PBlock;
end;

constructor TMyWindow.Create;
begin
FObjectInstance := MyMakeObjectInstance(MainWndProc);
end;

procedure TMyWindow.CreateHandle;
begin
if FHandle = 0 then CreateWnd;
end;

procedure TMyWindow.CreateParams(var Params: TMyCreateParams);
begin
FillChar(Params, SizeOf(Params), 0);
with Params do
begin
Style := WS_OVERLAPPEDWINDOW;
WndParent := 0;
WindowClass.style := CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS;
WindowClass.lpfnWndProc := @DefWindowProc;
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
WindowClass.hbrBackground := COLOR_3DFACE + 1;
WindowClass.hIcon := LoadIcon(0, IDI_APPLICATION);
WindowClass.hInstance := HInstance;
StrPCopy(WinClassName, Self.ClassName);
end;
end;

procedure TMyWindow.CreateWindowHandle(const Params: TMyCreateParams);
begin
with Params do
FHandle := CreateWindow(WinClassName, Caption, Style,
X, Y,
Width, Height,
WndParent, 0, WindowClass.hInstance, Param);
end;

var
MyCreationControl: TMyWindow;

function MyInitWndProc(HWindow: HWnd
Message, WParam,
LParam: Longint): Longint
stdcall;
begin
MyCreationControl.FHandle := HWindow;
SetWindowLong(HWindow, GWL_WNDPROC,
LongInt(MyCreationControl.FObjectInstance));

asm
PUSH LParam
PUSH WParam
PUSH Message
PUSH HWindow
MOV EAX,MyCreationControl
MOV MyCreationControl,0
CALL [EAX].TMyWindow.FObjectInstance
MOV Result,EAX
end;
end;


procedure TMyWindow.CreateWnd;
var
Params: TMyCreateParams;
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
CreateParams(Params);
with Params do
begin
FDefWndProc := WindowClass.lpfnWndProc;
ClassRegistered := GetClassInfo(WindowClass.hInstance, WinClassName, TempClass);
if not ClassRegistered or (TempClass.lpfnWndProc <> @MyInitWndProc) then
begin
if ClassRegistered then Windows.UnregisterClass(WinClassName,
WindowClass.hInstance);
WindowClass.lpfnWndProc := @MyInitWndProc;
WindowClass.lpszClassName := WinClassName;
if Windows.RegisterClass(WindowClass) = 0 then RaiseLastOSError;
end;
MyCreationControl := Self;
CreateWindowHandle(Params);
if FHandle = 0 then RaiseLastOSError;
end;
end;

procedure TMyWindow.DefaultHandler(var Message);
begin
if FHandle <> 0 then
with TMessage(Message) do
Result := CallWindowProc(FDefWndProc, FHandle, Msg, WParam, LParam);
end;


function TMyWindow.GetHandle: HWnd;
begin
HandleNeeded;
Result := FHandle;
end;

procedure TMyWindow.HandleNeeded;
begin
if FHandle = 0 then CreateHandle;
end;

procedure TMyWindow.MainWndProc(var Message: TMyMessage);
begin
WndProc(Message);
end;

procedure TMyWindow.ShowWindow;
begin
Windows.ShowWindow(FHandle, CmdShow);
end;

procedure TMyWindow.UpdateWindow;
begin
Windows.UpdateWindow(FHandle);
end;

procedure TMyWindow.WndProc(var Message: TMyMessage);
begin
if Message.Msg = WM_DESTROY then
PostQuitMessage(0)
else
Dispatch(Message);
end;

end.

dpr文件建立一消息循环，如下:
program Project1;

uses
Windows,
MyWindowUnit in 'MyWindowUnit.pas';

{$R *.res}

var
MyWindow: TMyWindow;
hWindow: HWND;
msg: TMsg;

begin
MyWindow := TMyWindow.Create;
hWindow := MyWindow.Handle;
MyWindow.ShowWindow;
MyWindow.UpdateWindow;

while GetMessage(msg, 0, 0, 0) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end;

MyWindow.Free;
end.

老达：　还有吗？继续。不过有些汇编还是看不懂！

xzgyb,你抄的函数都是比较关键的，不过 TControl.Parent 和 TWinControl.Showing 也是很关键的属性，你跟踪 TControl.SetParent 就知道我为什么这么说了。
昨晚梦见李维在给我讲为什么 TWndMethod 可以指向虚方法，早上一起来就给忘了。只好今天看一下汇编代码了。
我感觉我快要理清 Delphi 的消息机制了，希望周五能做个总结。

老K，没了，就这些，VCL一开始创建窗口的关键就是这些，
savetime:我的意思是VCL首次建窗口的时机就是发生在
GetTextHeight那段

to xzgyb,
>> 我的意思是VCL首次建窗口的时机就是发生在GetTextHeight那段。

我阅读 VCL 代码后的理解是：
TWinControl的 继承类尽可能地推迟 CreateWindowHandle 过程的执行，为了更有效的使用资源。只有在一个控件确实需要 HWnd 时才真正创建窗口。GetTextHeight 是可能导致 CreateWindowHandle 被调用的函数之一。更常见的情况是，如下代码：
var
Panel: TPanel;
begin
Panel := TPanel.Create(Self);
Panel.Parent := Self;
end;
执行完第一条语句，并不会真正创建窗口，因为 Panel 还没有显示，第二条语句执行后，会触发一系列 TControl 和 TWinControl 的事件，这时 CreateWindowHandle 才会被调用。

SaveTime:
哦，明白了你的意思了。
我以前的意思就是找到一个主窗口的在读取dfm后首先建立窗口的时机
其实归根结底就是当访问一个窗口的Handle时，调用HandleNeed，如果没有创建则
创建，也就是一种惰性创建的机制，呵呵，惰性还是以前跟别人学的一个词
祝你今晚还能梦到李维，呵呵

老K:系统装好了吗

　　老达：要常来阿，让我在这里多学习一点。真的又进步了不少！　我
的系统昨天搞定了！就做个覆盖安装，好省事的。其它的东西并没有掉。　

惰性创建，有意思，在找不到更直接的称呼之前可以先用这个词

to savetime:
明天等你的总结啊。
看来李维今晚会梦到你啊。

to book523,
我是希望像上周五一样，一个晚上(通宵)上能够写完总结，只是这两天搬货和一堆杂事浪费了很多时间。我尽力吧。

　TO: savetive 　不是说今天来个总结吗？　我每天都要来看看情况的！
等你的佳音。　

to kk2000,
我正在写，我希望今晚能写完，写完后我会在这里发贴通知你。
我要下班了。

我的总结写完了，欢迎批评指正。你如果有任何疑问，我都非常乐意尽力回答。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2403549

真是很勤奋，savetime.

又是一篇好文章，学习。

多谢各位捧场。