核心库类之TControl

TControl作为控件类的根类提供的服务：
1）TControl控件基本信息
TControl开始加入控件的基本信息并使用持久化机制保存信息。TControl声明的Left、Top等控件信息并使用Published关键字输出以便让客户端存取。这些控件信息会自动被持久化。

 TControl  =  class(TComponent)
   private
    FParent: TWinControl;
    FWindowProc: TWndMethod;
    FLeft:  Integer ;
    FTop:  Integer ;
    FWidth:  Integer ;
    FHeight:  Integer ;
    FControlStyle: TControlStyle;
    FControlState: TControlState;
    
 published
     property   Left :  Integer  read FLeft write SetLeft;
     property  Top:  Integer  read FTop write SetTop;
     property  Width:  Integer  read FWidth write SetWidth;
     property  Height:  Integer  read FHeight write SetHeight;
     property  Cursor: TCursor read FCursor write SetCursor default crDefault;
     property  Hint:  string  read FHint write FHint stored IsHintStored;
     property  HelpType: THelpType read FHelpType write FHelpType default htContext;
     property  HelpKeyword:  String  read FHelpKeyword write SetHelpKeyword stored IsHelpContextStored;
     property  HelpContext: THelpContext read FHelpContext write SetHelpContext stored IsHelpContextStored default  0 ;
end ;

FParent: TWinControl代表TControl和TWinControl有紧耦合。
2）基础资源服务
  控件需要使用光标、文字、颜色、字体以及其他的资源，TControl必须具备这些资源的支持，相关属性：

    FParentFont:  Boolean ;
    FParentColor:  Boolean ;
    FAlign: TAlign;
    FDragMode: TDragMode;
    FText: PChar;
    FFont: TFont;
    FColor: TColor;
    FCursor: TCursor;

除了资源属性，当外界改变控件使用的资源时，TControl提供响应资源事件的方法，CM-XXXChanged方法是和资源改变相关的方法。

    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;

 

procedure TControl.CMFontChanged(var Message: TMessage);
begin
  Invalidate;
end ;

procedure TControl.CMColorChanged(var Message: TMessage);
begin
  Invalidate;
end ;

TControl.Invalidate调用了TControl.InvalidateControl来重绘控件区域，TControl.InvalidateControl最后调用了Windows API的InvalidateRect莱进行重绘工作。

procedure TControl.Invalidate;
begin
  InvalidateControl(Visible, csOpaque in ControlStyle);
end ;

procedure TControl.InvalidateControl(IsVisible, IsOpaque:  Boolean );
var
  Rect: TRect;

   function  BackgroundClipped:  Boolean ;
  var
    R: TRect;
    List: TList;
    I:  Integer ;
    C: TControl;
  begin
    Result : =   True ;
    List : =  FParent.FControls;
    I : =  List.IndexOf(Self);
     while  I  >   0   do
    begin
      Dec(I);
      C : =  List[I];
       with  C  do
         if  C.Visible  and  (csOpaque in ControlStyle)  then
        begin
          IntersectRect(R, Rect, BoundsRect);
           if  EqualRect(R, Rect)  then   Exit ;
         end ;
     end ;
    Result : =   False ;
   end ;

begin
   if  (IsVisible  or  (csDesigning in ComponentState)  and
     not  (csNoDesignVisible in ControlStyle))  and  (Parent  <>  nil)  and
    Parent.HandleAllocated  then
  begin
    Rect : =  BoundsRect;
    InvalidateRect(Parent.Handle, @Rect,  not  (IsOpaque  or
      (csOpaque in Parent.ControlStyle)  or  BackgroundClipped));
   end ;
end ;

注意：Invalidate被声明为虚拟方法。procedure Invalidate; virtual;
3）处理鼠标的服务
控件需要处理鼠标事件，WMXXButtonXXXX等方法是TControl提供的基础鼠标服务，

  procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
    procedure WMMButtonDown(var Message: TWMMButtonDown); message WM_MBUTTONDOWN;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMRButtonDblClk(var Message: TWMRButtonDblClk); message WM_RBUTTONDBLCLK;
    procedure WMMButtonDblClk(var Message: TWMMButtonDblClk); message WM_MBUTTONDBLCLK;
    procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
    procedure WMMButtonUp(var Message: TWMMButtonUp); message WM_MBUTTONUP;
    procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
    procedure WMCancelMode(var Message: TWMCancelMode); message WM_CANCELMODE;

如果TControl的派生类没有定义处理鼠标的方法，那么TControl便会负责处理鼠标事件。

procedure TControl.WMLButtonDown(var Message: TWMLButtonDown);
begin
  SendCancelMode(Self);
  inherited;
   if  csCaptureMouse in ControlStyle  then  MouseCapture : =   True ;
   if  csClickEvents in ControlStyle  then  Include(FControlState, csClicked);
  DoMouseDown(Message, mbLeft, []);
end ;

4）处理消息和事件的服务
控件要处理事件和消息，要加入响应外界事件的处理机制，这就是

    procedure WndProc(var Message: TMessage); virtual;
    procedure DefaultHandler(var Message); override;

5）控件重绘服务
控件重绘事控件类最需要的核心服务，因为控件可以移动，改变字体、颜色、大小等，当这些事件发生时控件都需要进行重绘工作。采用虚拟方法。
TControl 提供了三个相关的虚拟方法来提供控件重绘的功能，分别是

    procedure Repaint; virtual;
    procedure Invalidate; virtual;
    procedure Update; virtual;

1.TControl与Windows消息的封装
TObject提供了最基本的消息分发和处理的机制，而VCL真正对Windows系统消息的封装则是在TControl中完成的。
TControl将消息转换成VCL的事件，以将系统消息融入VCL框架中。
消息分发机制在4.2节已经介绍过，那么系统消息是如何变成事件的呢？
现在，通过观察TControl的一个代码片段来解答这个问题。在此只以鼠标消息变成鼠标事件的过程来解释，其余的消息封装基本类似。
先摘取TControl声明中的一个片段：
TControl = class(TComponent)
Private
  ……
  FOnMouseDown: TMouseEvent;
  ……
  procedure DoMouseDown(var Message: TWMMouse; Button: TMouseButton;
  Shift: TShiftState);
  ……
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer); dynamic;
  ……
  procedure WMLButtonDown(var Message: TWMLButtonDown); message
WM_LBUTTONDOWN;
  procedure WMRButtonDown(var Message: TWMRButtonDown); message
WM_RBUTTONDOWN;
  procedure WMMButtonDown(var Message: TWMMButtonDown); message
WM_MBUTTONDOWN;
  ……
protected
  ……
  property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
  ……
end;
这段代码是TControl组件类的声明。
TControl声明了一个OnMouseDown属性，该属性读写一个称为FOnMouseDown的事件指针。因此，FOnMouseDown会指向OnMouseDown事件的用户代码。
TControl声明了WMLButtonDown、WMRButtonDown、WMMButtonDown 3个消息 处理函数，它们分别处理WM_LBUTTONDOWN、WM_RBUTTONDOWN、WM _MBUTTONDOWN 3个Windows消息，对应于鼠标的左键按下、右键按下、中键按下3个硬件事件。
另外，还有一个DoMouseDown()方法和一个MouseDown()的dynamic方法，它们与消息处理函数之间2是什么样的关系呢？
现在，就来具体看一下这些函数的实现。
这里是3个消息的处理函数：
procedure TControl.WMLButtonDown(var Message: TWMLButtonDown);
begin
  SendCancelMode(Self);
  inherited;
  if csCaptureMouse in ControlStyle then
    MouseCapture := True;
  if csClickEvents in ControlStyle then
    Include(FControlState, csClicked);
  DoMouseDown(Message, mbLeft, []);
end;
procedure TControl.WMRButtonDown(var Message: TWMRButtonDown);
begin
  inherited;
  DoMouseDown(Message, mbRight, []);
end;

procedure TControl.WMMButtonDown(var Message: TWMMButtonDown);
begin
  inherited;
  DoMouseDown(Message, mbMiddle, []);
end;
当TObject.Dispatch()将WM_LBUTTONDOWN消息、WM_RBUTTONDOWN消息或WM_MBUTTONDOWN消息分发给TControl的派生类的实例后，WMLButtonDown()、WMRButtonDown()或WMMButtonDown()被执行，然后它们都有类似这样
DoMouseDown(Message, mbRight, []);的代码来调用DoMouseDown()：
procedure TControl.DoMouseDown(var Message: TWMMouse; Button:
TMouseButton; Shift: TShiftState);
begin
  if not (csNoStdEvents in ControlStyle) then
  with Message do
    if (Width > 32768) or (Height > 32768) then
  with CalcCursorPos do
    MouseDown(Button, KeysToShiftState(Keys) + Shift, X, Y)
  else
   MouseDown(Button,KeysToShiftState(Keys) + Shift,Message.XPos,Message.Ypos);
end;
在DoMouseDown()中进行一些必要的处理工作后（特殊情况下重新获取鼠标位置），就会调
MouseDown()：
procedure TControl.MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseDown) then
    FOnMouseDown(Self, Button, Shift, X, Y);
end;

在MouseDown()中，才会通过FOnMouseDown事件指针真正去执行用户定义的OnMouseDown事件的代码。
由此，完成了Windows系统消息到VCL事件的转换过程。
因此，从TControl派生的类都可以拥有OnMouseDown事件，只不过该事件属性在TControl中被定义成protected，只有其派生类可见，并且在派生类中可以自由选择是否公布这个属性。要公布该属性只需要简单地将其声明为published即可。如：
TMyControl = class(TControl)
published
  property OnMouseDown;
end;
这些函数过程的调用关系: Dispatch(WM_LBUTTONDOWN)-〉 WMMouseDown() -〉DoMouseDown() -〉MouseDown() -〉程序员的OnMouseDown事件代码;
说明了WM_LBUTTONDOWN消息到OnMouseDown事件的转换过程
在此，只是以OnMouseDown事件为例。其实，VCL对Windows各个消息的封装大同小异，以此一例足以说明事件模型的原理。
另外，值得注意的是，在上例中的MouseDown()函数是一个dynamic方法，因此可以通过在TControl派生类中覆盖MouseDown()来处理自己所编写组件的鼠标按下事件，然后通过inherited;语句调用TControl的MouseDown()来执行使用组件的程序员所编写的OnMouseDown的代码。

转载于:https://www.cnblogs.com/sideandside/archive/2007/05/08/739189.html