说到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的大小就超过了下面定义的pagesize
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 ;将堆栈中构造的记录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接收消息的方法mainwndproc
procedure 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.wndproc
procedure tcontrol.wndproc(var message: tmessage)
var
form: tcustomform
keystate: tkeyboardstate
wheelmsg: tcmmousewheel
begin
...
//省略以上的消息相关处理代码,研究某些特定消息时可自行查看
...
dispatch(message);//调用dispatch处理
end;