娃娃鸭Delphi面向对象编程思想刘艺笔记

4、  TComponent类

属性

１.  Name: TComponentName

２.  property Tag: Longint

３.  property Components[Index: Integer]: TComponent read GetComponent;

４.  property ComponentCount: Integer read GetComponentCount;

５.  property ComponentState: TComponentState read FComponentState;

　TComponentState = set of (csLoading, csReading, csWriting, csDestroying,

    csDesigning, csAncestor, csUpdating, csFixups, csFreeNotification,

csInline, csDesignInstance);

csAncestor：该状态表示这一组件是在父窗口类中引进的组件，只有在csDesigning被设置的前提下才能设为该状态，也就是说只有处于设计期的组件才有可能被设为该标识。

csDesigning：被设置为这一状态的组件表明该组件正处于设计期中，即组件是由窗口设计器所操纵着在进行窗口的可视化设计。在Delphi的可视化设计中，设计时放在窗口中的组件并不是Delphi根据组件在DFM文件中的属性而画在窗口上的，它实际上是一个真实的Window窗体，只不过是由Delphi的窗体设计器所控制而已，而且组件的构造函数也已运行过。

csDestroying：该状态表示组件马上要被销毁。

csFixups：处于该状态的表明组件与另一个还未调入的窗口有关联，当相关的窗口调入后，该标识将会被清除。

csFreeNotification：该标识表示组件在销毁时需要向一个或多个发出销毁的通知。只有另一个组件调用了该组件的FreeNotification方法后组件才会被设置为该属性。

csInline：该标识主要是在窗框Frame保存和调入时用于区分嵌套的Frame对象。被设置了该标识的组件是处于窗体是最上层的组件，可以在设计期进行可视化的属性设计或修改。

csLoading：该标识表示组件正处于装载过程中，即组件正被一个TFiler或其派生类对象所装载，只有组件所拥有的所有子组件被装载后该标识才会被清除。

csReading：当组件被装载时，组件正由一个流中读取组件属性时被设为此标识，它往往与csLoading标识一同被设置，因为csReading标识是在组件被装载而还未读入属性的间隔时刻被设置为此标识的。

csUpdating：该标识表示组件正处于更新过程中以反映出祖先窗口的变化，只有被设置了csAncestor标识的组件才有可能设置有该属性。

csWriting：该标识表示组件正在将其属性写到一个流对象中。

csDesignInstance：该标识往往与csDesigning标识一同出现。该标识表示组件是窗口设计器中的根对象。

６.  property ComponentStyle: TComponentStyle

７.  property Owner: TComponent read FOwner;

存有组件的所有者对象指针。

方法：

１. constructor Create(AOwner: TComponent); virtual;

constructor TComponent.Create(AOwner: TComponent);

begin

  FComponentStyle := [csInheritable];

  if AOwner <> nil then AOwner.InsertComponent(Self);

end;

procedure TComponent.InsertComponent(AComponent: TComponent);

begin

  AComponent.ValidateContainer(Self);

  ValidateRename(AComponent, '', AComponent.FName);

  Insert(AComponent);

  AComponent.SetReference(True);

  if csDesigning in ComponentState then

    AComponent.SetDesigning(True);

  Notification(AComponent, opInsert);

end;

　　procedure TComponent.Insert(AComponent: TComponent);

begin

 　　　 if FComponents = nil then FComponents := TList.Create;

 　　　 FComponents.Add(AComponent);

  　　　AComponent.FOwner := Self;

end;

２. destructor Destroy; override;

destructor TComponent.Destroy;

begin

  Destroying;

  if FFreeNotifies <> nil then

  begin

    while Assigned(FFreeNotifies) and (FFreeNotifies.Count > 0) do

      TComponent(FFreeNotifies[FFreeNotifies.Count - 1]).Notification(Self, opRemove);

    FreeAndNil(FFreeNotifies);

  end;

  DestroyComponents;

  if FOwner <> nil then FOwner.RemoveComponent(Self);

  inherited Destroy;

end;

procedure TComponent.DestroyComponents;

var

  Instance: TComponent;

begin

  while FComponents <> nil do

  begin

    Instance := FComponents.Last;

    if (csFreeNotification in Instance.FComponentState)

      or (FComponentState * [csDesigning, csInline] = [csDesigning, csInline]) then

      RemoveComponent(Instance)

    else

      Remove(Instance);

    Instance.Destroy;

  end;

end;

３. procedure BeforeDestruction; override;

４. procedure Destroying;

５. function ExecuteAction(Action: TBasicAction): Boolean; dynamic;

６. function FindComponent(const AName: string): TComponent;

function TComponent.FindComponent(const AName: string): TComponent;

var

  I: Integer;

begin

  if (AName <> '') and (FComponents <> nil) then

    for I := 0 to FComponents.Count - 1 do

    begin

      Result := FComponents[I];

      if SameText(Result.FName, AName) then Exit;

    end;

  Result := nil;

end;

７. procedure FreeNotification(AComponent: TComponent);

procedure TComponent.FreeNotification(AComponent: TComponent);

begin

  if (Owner = nil) or (AComponent.Owner <> Owner) then

  begin

    // Never acquire a reference to a component that is being deleted.

    assert(not (csDestroying in (ComponentState + AComponent.ComponentState)));

    if not Assigned(FFreeNotifies) then FFreeNotifies := TList.Create;

    if FFreeNotifies.IndexOf(AComponent) < 0 then

    begin

      FFreeNotifies.Add(AComponent);

      AComponent.FreeNotification(Self);

    end;

  end;

  Include(FComponentState, csFreeNotification);

end;

将指定的组件加入到组件内部的一个列表中。当本组件要被销毁时，组件将依次向列表中的各个组件发出本组件要被销毁的消息。

８. procedure RemoveFreeNotification(AComponent: TComponent);

procedure TComponent.RemoveFreeNotification(AComponent: TComponent);

begin

  RemoveNotification(AComponent);

  AComponent.RemoveNotification(Self);

end;

procedure TComponent.RemoveNotification(AComponent: TComponent);

begin

  if FFreeNotifies <> nil then

  begin

    FFreeNotifies.Remove(AComponent);

    if FFreeNotifies.Count = 0 then

    begin

      FFreeNotifies.Free;

      FFreeNotifies := nil;

    end;

  end;

end;

９. procedure FreeOnRelease;

　procedure TComponent.FreeOnRelease;

begin

 　　 if FVCLComObject <> nil then IVCLComObject(FVCLComObject).FreeOnRelease;

end;

１０. function GetParentComponent: TComponent; dynamic;

该方法取得组件的父组件，它主要是为组件属性的存储而设计的。组件的所有者Owner与组件的父组件是有区别的。组件的父组件主要负责组件属性的存储，而组件的所有者主要负责组件的销毁。

１１. function HasParent: Boolean; dynamic;

对于有父组件的组件，必须覆盖function GetParentComponent: TComponent; dynamic;和procedure SetParentComponent(Value: TComponent); dynamic;方法。

１２.procedure InsertComponent(AComponent: TComponent);

procedure TComponent.InsertComponent(AComponent: TComponent);

begin

  AComponent.ValidateContainer(Self);

  ValidateRename(AComponent, '', AComponent.FName);

  Insert(AComponent);

  AComponent.SetReference(True);

  if csDesigning in ComponentState then

    AComponent.SetDesigning(True);

  Notification(AComponent, opInsert);

end;

１３.procedure RemoveComponent(AComponent: TComponent);

１４.procedure SetSubComponent(IsSubComponent: Boolean);

实例：

procedure TCustomLabel.Notification(AComponent: TComponent;

  Operation: TOperation);

begin

  inherited Notification(AComponent, Operation);

  if (Operation = opRemove) and (AComponent = FFocusControl) then

    FFocusControl := nil;

end;

procedure TCustomLabel.SetFocusControl(Value: TWinControl);

begin

  FFocusControl := Value;

  if Value <> nil then Value.FreeNotification(Self);

end;

 

５、TApplication类

TApplication = class(TComponent)

  private

    FHandle: HWnd;

 ...

end; 

每个传统的Delphi应用程序都封装在一个TApplication对象中。该对象包含了程序的主窗体的句柄，通过该句柄，Windows操作系统可以向应用程序发送消息。实际上TApplication是一个运行时不显示的窗体。

TApplication封装了以下四个功能：

·Windows消息处理

·菜单加速和键盘处理

·异常处理

·上下文联机帮助

属性

１.   property Active: Boolean read FActive;

２.   property DialogHandle: HWnd read GetDialogHandle write SetDialogHandle;

３.   property ExeName: string read GetExeName;

４.   property Handle: HWnd read FHandle write SetHandle;

提供对应用程序主窗口句柄的访问。

５.   property HelpFile: string read FHelpFile write FHelpFile;

６.   property Hint: string read FHint write SetHint;

７.   property HintHidePause: Integer read FHintHidePause write FHintHidePause;

指定了鼠标尚未从控件或菜单项上移开、在隐藏帮助提示之前的时间间隔。

８.   property MainForm: TForm read FMainForm;

９.   property ShowMainForm: Boolean read FShowMainForm write FShowMainForm;

１０.            property Terminated: Boolean read FTerminate;

报告程序是否收到终止程序的Windows消息WM_QUIT。

方法：

１.   procedure BringToFront;

procedure TApplication.BringToFront;

var

  TopWindow: HWnd;

begin

  if Handle <> 0 then

  begin

    TopWindow := GetLastActivePopup(Handle);

    if (TopWindow <> 0) and (TopWindow <> Handle) and

      IsWindowVisible(TopWindow) and IsWindowEnabled(TopWindow) then

      SetForegroundWindow(TopWindow);

  end;

end;

２.   procedure CreateForm(InstanceClass: TComponentClass; var Reference);

procedure TApplication.CreateForm(InstanceClass: TComponentClass; var Reference);

var

  Instance: TComponent;

begin

  Instance := TComponent(InstanceClass.NewInstance);

  TComponent(Reference) := Instance;

  try

    Instance.Create(Self);

  except

    TComponent(Reference) := nil;

    raise;

  end;

  if (FMainForm = nil) and (Instance is TForm) then

  begin

    TForm(Instance).HandleNeeded;

    FMainForm := TForm(Instance);

  end;

end;

３.   procedure HandleException(Sender: TObject);

４.   procedure UnhookMainWindow(Hook: TWindowHook);

事件：

TNotifyEvent = procedure(Sender: TObject) of object;

·property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;

用OnActivate事件编写一个事件句柄为完成当应用程序成为活动状态时指定特别的处理。

·property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;

当应用程序成为非活动状态时OnDeactivate事件发生。

·property OnException: TExceptionEvent read FOnException write FOnException;

TExceptionEvent = procedure (Sender: TObject; E: Exception) of object;

　当应用程序中的某个无句柄的异常发生时就触发了事件OnException。

　在TApplication.HandleException方法中，OnException事件句柄被自动调用。

procedure TApplication.HandleException(Sender: TObject);

begin

  if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0);

  if ExceptObject is Exception then

  begin

    if not (ExceptObject is EAbort) then

      if Assigned(FOnException) then

        FOnException(Sender, Exception(ExceptObject))

      else

        ShowException(Exception(ExceptObject));

  end else

    SysUtils.ShowException(ExceptObject, ExceptAddr);

end;

·property OnHelp: THelpEvent read FOnHelp write FOnHelp;

THelpEvent = function(Command: Word; Data: Longint;

var CallHelp: Boolean): Boolean of object;

·property OnHint: TNotifyEvent read FOnHint write FOnHint;

·property OnIdle: TIdleEvent read FOnIdle write FOnIdle;

TIdleEvent = procedure (Sender: TObject; var Done: Boolean) of object;

当应用程序成为空闲状态时OnIdle事件发生。

·property OnMessage: TMessageEvent read FOnMessage write FOnMessage;

TMessageEvent = procedure (var Msg: TMsg; var Handled: Boolean) of object;

当应用程序接收到Windows消息时事件OnMessage发生

 

６、TFiler类、TReader类和TWriter类

TFiler = class(TObject)

  private

    FStream: TStream;

    FBuffer: Pointer;

    FBufSize: Integer;

    FBufPos: Integer;

    FBufEnd: Integer;

    FRoot: TComponent;

    FLookupRoot: TComponent;

    FAncestor: TPersistent;

    FIgnoreChildren: Boolean;

  protected

    procedure SetRoot(Value: TComponent); virtual;

  public

    constructor Create(Stream: TStream; BufSize: Integer);

    destructor Destroy; override;

    procedure DefineProperty(const Name: string;

      ReadData: TReaderProc; WriteData: TWriterProc;

      HasData: Boolean); virtual; abstract;

    procedure DefineBinaryProperty(const Name: string;

      ReadData, WriteData: TStreamProc;

      HasData: Boolean); virtual; abstract;

    procedure FlushBuffer; virtual; abstract;

    property Root: TComponent read FRoot write SetRoot;

    property LookupRoot: TComponent read FLookupRoot;

    property Ancestor: TPersistent read FAncestor write FAncestor;

    property IgnoreChildren: Boolean read FIgnoreChildren write FIgnoreChildren;

  end;