开发学院软件开发Delphi VCL源码分析方法论 阅读

VCL源码分析方法论

 2006-02-04 13:42:28 来源:WEB开发网   
核心提示: 最近一段时间似乎流行源码分析:)我也来谈谈在过去一段时间里对VCL源码的分析方法方面的一点体会,本文将不探讨VCL类库的构架和设计模式方面的东本,VCL源码分析方法论,只是以我们常见的控件属性/方法的实现过程作简单的说明,希望对初学者有所帮助VCL分析方法例:TButton.Caption属性的由来(本文仅以此献给D
 最近一段时间似乎流行源码分析:)我也来谈谈在过去一段时间里对VCL源码的分析方法方面的一点体会,本文将不探讨VCL类库的构架和设计模式方面的东本,只是以我们常见的控件属性/方法的实现过程作简单的说明,希望对初学者有所帮助

VCL分析方法
例:TButton.Caption属性的由来
(本文仅以此献给DELPHI初学者)
  用过一段时间DELPHI的朋友,都会对VCL源码感兴趣。本人也常常在各大论坛见到一些网友研究讨论过关于VCL源码的贴子。不过,很多网友很努力的想看懂,可最后还是半途而废,因为他们总是理不出个头绪、看得云里雾里。笔者我也有看源码的习惯,没事的时候就点点鼠标右键,总是希望得到一些侥幸的收获和开发技巧。
  不过万事都得先有个基本前题,就像人上学的过程一样(这里指正常人)要按部就班的来,一般不可能小学一毕业就直接去念大学,除非他(她)是个天才或经过特别培训。所以各位GGJJDDMM,看VCL源码也是有个基本前题的,首先你得熟悉WIN32 API/SDK,如果你说不知道的话,可以参考书籍《PRogramming Windows》(中文名《WINDOWS 程序设计》)。其次是你应当对Object Pascal比较熟悉,或者你曾经对DELPHI的组件进行过扩展(做过组件开发),那么我相信你对Object Pascal已经熟悉。不熟也不要紧,DELPHI的在线帮助就有对Object Pascal的讲述,如果英文太差也不要紧,网上也有很多热心网友翻译过来的中文帮助和语言参考书。
呵呵,本人写技术文章就像在写散文:)
  言归正传,我们这篇文章的主题是对VCL源码的分析,分析当然有一个分析方法的问题,总不能随便打开一个源程序,逮着一个函数就分析一个函数吧:)所以我们也应该有选择,有目的的分析。
想想我们每天编码时都会遇到的属性有哪些?呵呵,NAME,CAPTION,VISIBLE,还有一些控件的TEXT(如EDIT1.TEXT)。那么我们就以控件的CAPTION来分析吧。
当然不是每个控件都有CAPTION属性的,我们这里就用TButton类的Caption属性进行分析。
  打开每天我们都会使用的DELPHI,在FORM窗体上放一个按钮,得到一个Button1的按钮控件,按F12打天源程序,有没有找到这段代码呢:
Button1: TButton;
对了,在TButton上点击鼠标右键,在弹出的上下文菜单中选择第一项Find Declaration,找到TButton类的定义,如下所示:
 TButton = class(TButtonControl)
 private
  FDefault: Boolean;
  FCancel: Boolean;
  FActive: Boolean;
  FModalResult: TModalResult;
  procedure SetDefault(Value: Boolean);
。。。。。。

  原来TButton继承于TButtonControl类,呵呵:)
在左边的对象窗口(Exploring Unit.pas窗口)中找到TButton的CAPTION属性,如下图:

  双击CAPTION属性,找到定义CAPTION属性的源码,大家可能发现什么都没有,只有一个  
  property Caption;
  呵呵,写过组件的朋友都知道,按理Caption属性应该有读/写文本的方法啊?在哪里去了呢,呵呵,这里没有出现,当然应该在它的父类里了(这里只是申明Caption出来的地方),我们顺着刚才的方法继续在TButtonControl,发现也没有,最终我们在TControl类里找到了这个CAPTION,至于为什么是protected成员,我就不多说了:
 protected
  procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
  procedure AdjustSize; dynamic;
  procedure AssignTo(Dest: TPersistent); override;
  procedure BeginAutoDrag; dynamic;
  function CanResize(var NewWidth, NewHeight: Integer): Boolean; virtual;
  function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual;
  procedure Changed;
  procedure ChangeScale(M, D: Integer); dynamic;
。。。。。。
  property Caption: TCaption read GetText write SetText stored IsCaptionStored;
  看看GetText、SetText就是操作文本属性的函数了,我们找到GetText、SetText定义如下:
function GetText: TCaption;
procedure SetText(const Value: TCaption);
还有TCaption,它的定义居然是一个自定义类型:
TCaption = type string;
  说明GetText返回值和SetText的调用参数本来也就是一个string型的:)

  下面我们来看看GetText源码:
function TControl.GetText: TCaption;
var
 Len: Integer;
begin
 Len := GetTextLen;//得到文本长度
 SetString(Result, PChar(nil), Len);// 设置Result返回以Len指定的长度
 if Len <> 0 then GetTextBuf(Pointer(Result), Len + 1);//长度不为空,Result得到文本数据
end;

  如果不明白GetTextBuf的用法,看看如下的代码:
procedure TForm1.Button1Click(Sender: TObject);
var
 Buffer: PChar;
 Size: Byte;
begin
 Size := Edit1.GetTextLen;  //得到EDIT1的文本长
 Inc(Size);        
 GetMem(Buffer, Size);      //创建EDIT1文本长度大小的缓存空间
 Edit1.GetTextBuf(Buffer,Size);  //由缓存得到文本,Buffer里的值就是Edit1.Text
 Edit2.Text := StrPas(Buffer);  //Buffer转换为PASCAL字符类型数据
 FreeMem(Buffer, Size);    //释放内存
end;
以上程序的行为同以下程序相当:
procedure TForm1.Button1Click(Sender: TObject);
begin
 Edit2.Text := Edit1.Text;
end;

  回到GetText函数,其中GetTextLen的作用是得到文本长度,GetTextBuf得到文本数据。
  SetText就更简单了,定义如下:
procedure TControl.SetText(const Value: TCaption);
begin
 if GetText <> Value then SetTextBuf(PChar(Value));
end;
  意思是如果设定的Value与原来的不同,则重新设置缓存文本。



  为了更深入VCL底部,我们再看看GetTextLen如何实现的(其实SetTextBuf和GetTextLen的实现过程相似):
function TControl.GetTextLen: Integer;
begin
 Result := Perform(WM_GETTEXTLENGTH, 0, 0);//WM_派发的是WINDOWS标准消息
end;
  看到这里想必大家都明白了,如果还不明白(没用过Perform),我看再看看Perform,它到底做了什么:
function TControl.Perform(Msg: Cardinal; WParam, LParam: Longint): Longint;
var
 Message: TMessage;
Begin
{你的消息赋予TMessage }
 Message.Msg := Msg; ;
 Message.WParam := WParam;
 Message.LParam := LParam;
Message.Result := 0;//0表示返回不处理
 if Self <> nil then WindowProc(Message);//不为空,将消息交给TControl的窗口过程WindowProc处理
 Result := Message.Result;//返回结果
end;
  这里主要再看看WindowProc做了什么,TControl里面WindowProc是这样定义的:
property WindowProc: TWndMethod read FWindowProc write FWindowProc;
在TControl的Create函数中:
constructor TControl.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FWindowProc := WndProc;
。。。。。。
  可见我们还要找到TControl 的WndProc过程才能明白究竟,
WndProc过程定义如下:
procedure WndProc(var Message: TMessage); override;
  实现:
procedure TControl.WndProc(var Message: TMessage);
var
 Form: TCustomForm;
 KeyState: TKeyboardState; 
 WheelMsg: TCMMouseWheel;
begin
 if (csDesigning in ComponentState) then
 begin
  Form := GetParentForm(Self);
  if (Form <> nil) and (Form.Designer <> nil) and
   Form.Designer.IsDesignMsg(Self, Message) then Exit
 end;
 if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
 begin
  Form := GetParentForm(Self);
  if (Form <> nil) and Form.WantChildKey(Self, Message) then Exit;
 end
 else if (Message.Msg >= WM_MOUSEFIRST) and (Message.Msg <= WM_MOUSELAST) then
 begin
  if not (csDoubleClicks in ControlStyle) then
   case Message.Msg of
    WM_LBUTTONDBLCLK, WM_RBUTTONDBLCLK, WM_MBUTTONDBLCLK:
     Dec(Message.Msg, WM_LBUTTONDBLCLK - WM_LBUTTONDOWN);
   end;
  case Message.Msg of
   WM_MOUSEMOVE: application.HintMouseMessage(Self, Message);
   WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
    begin
     if FDragMode = dmAutomatic then
     begin
      BeginAutoDrag;
      Exit;
     end;
     Include(FControlState, csLButtonDown);
    end;
   WM_LBUTTONUP:
    Exclude(FControlState, csLButtonDown);
  else
   with Mouse do
    if WheelPresent and (RegWheelMessage <> 0) and
     (Message.Msg = RegWheelMessage) then
    begin
     GetKeyboardState(KeyState);
     with WheelMsg do
     begin
      Msg := Message.Msg;
      ShiftState := KeyboardStateToShiftState(KeyState);
      WheelDelta := Message.WParam;
      Pos := TSmallPoint(Message.LParam);
     end;
     MouseWheelHandler(TMessage(WheelMsg));
     Exit;
    end;
  end;
 end
 else if Message.Msg = CM_VISIBLECHANGED then
  with Message do
   SendDockNotification(Msg, WParam, LParam);
 Dispatch(Message);//派发消息
end;
  这里主要讲讲Dispatch方法,它根据传入的消息调用消息的句柄方法,如果在组件类和它的父类都没有找到消息的处理句柄,Dispatch方法便会调用Defaulthandler(默认的消息处理方法),如下:
procedure TObject.Dispatch(var Message);
asm
  PUSH   ESI
  MOV   SI,[EDX]
  OR    SI,SI
  JE    @@default
  CMP   SI,0C000H
  JAE   @@default
  PUSH   EAX
  MOV   EAX,[EAX]
  CALL   GetDynaMethod
  POP   EAX
  JE    @@default
  MOV   ECX,ESI
  POP   ESI
  JMP   ECX

@@default:
  POP   ESI
  MOV   ECX,[EAX]
  JMP   DWord PTR [ECX] + VMTOFFSET TObject.DefaultHandler//调用默认的消息处理方法
end;
  而默认的消息处理如下,在SYSTEM.PAS单元里:
procedure TObject.DefaultHandler(var Message);
begin
end;
   由以上代码看好像是没有任何处理过程,跟踪Object.DefaultHandler的汇编执行动作call dword ptr[ecx-$10],即调用Object.DefaultHandle,看看做何处理:
{Object.DefaultHandle}
Ret
Lea eax,[eax+$00]
即一个返回处理!

从最表面的Button.caption,我们走到了编译器层,可见所有东西都能找到它固有的原点!以caption的分析为基础,我们可以继续分析name属性和其它一些方法/函数。
希望我这篇‘散文’能给大家理出点头绪:)

Tags:VCL 源码 分析

编辑录入:爽爽 [复制链接] [打 印]
[]
  • 好
  • 好的评价 如果觉得好,就请您
      0%(0)
  • 差
  • 差的评价 如果觉得差,就请您
      0%(0)
赞助商链接