+ renamed to classes.pp

fcl/classes.pas

@@ -1,1000 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-unit Classes;
-
-
-interface
-
-
-const
-
-{ Maximum TList size }
-
-  MaxListSize = Maxint div 16;
-
-{ TStream seek origins }
-
-  soFromBeginning = 0;
-  soFromCurrent = 1;
-  soFromEnd = 2;
-
-{ TFileStream create mode }
-
-  fmCreate = $FFFF;
-
-{ TParser special tokens }
-
-  toEOF     = Char(0);
-  toSymbol  = Char(1);
-  toString  = Char(2);
-  toInteger = Char(3);
-  toFloat   = Char(4);
-
-type
-
-{ Text alignment types }
-
-  TAlignment = (taLeftJustify, taRightJustify, taCenter);
-  TLeftRight = taLeftJustify..taRightJustify;
-
-{ Types used by standard events }
-
-  TShiftState = set of (ssShift, ssAlt, ssCtrl,
-    ssLeft, ssRight, ssMiddle, ssDouble);
-
-  THelpContext = -MaxLongint..MaxLongint;
-
-{ Standard events }
-
-  TNotifyEvent = procedure(Sender: TObject) of object;
-  THelpEvent = function (Command: Word; Data: Longint;
-    var CallHelp: Boolean): Boolean of object;
-  TGetStrProc = procedure(const S: string) of object;
-
-{ Exception classes }
-
-  EStreamError = class(Exception);
-  EFCreateError = class(EStreamError);
-  EFOpenError = class(EStreamError);
-  EFilerError = class(EStreamError);
-  EReadError = class(EFilerError);
-  EWriteError = class(EFilerError);
-  EClassNotFound = class(EFilerError);
-  EMethodNotFound = class(EFilerError);
-  EInvalidImage = class(EFilerError);
-  EResNotFound = class(Exception);
-  EListError = class(Exception);
-  EBitsError = class(Exception);
-  EStringListError = class(Exception);
-  EComponentError = class(Exception);
-  EParserError = class(Exception);
-  EOutOfResources = class(EOutOfMemory);
-  EInvalidOperation = class(Exception);
-
-{ Forward class declarations }
-
-  TStream = class;
-  TFiler = class;
-  TReader = class;
-  TWriter = class;
-  TComponent = class;
-
-{ TList class }
-
-  PPointerList = ^TPointerList;
-  TPointerList = array[0..MaxListSize - 1] of Pointer;
-  TListSortCompare = function (Item1, Item2: Pointer): Integer;
-
-  TList = class(TObject)
-  private
-    FList: PPointerList;
-    FCount: Integer;
-    FCapacity: Integer;
-  protected
-    function Get(Index: Integer): Pointer;
-    procedure Grow; virtual;
-    procedure Put(Index: Integer; Item: Pointer);
-    procedure SetCapacity(NewCapacity: Integer);
-    procedure SetCount(NewCount: Integer);
-  public
-    destructor Destroy; override;
-    function Add(Item: Pointer): Integer;
-    procedure Clear;
-    procedure Delete(Index: Integer);
-    class procedure Error(const Msg: string; Data: Integer); virtual;
-    procedure Exchange(Index1, Index2: Integer);
-    function Expand: TList;
-    function First: Pointer;
-    function IndexOf(Item: Pointer): Integer;
-    procedure Insert(Index: Integer; Item: Pointer);
-    function Last: Pointer;
-    procedure Move(CurIndex, NewIndex: Integer);
-    function Remove(Item: Pointer): Integer;
-    procedure Pack;
-    procedure Sort(Compare: TListSortCompare);
-    property Capacity: Integer read FCapacity write SetCapacity;
-    property Count: Integer read FCount write SetCount;
-    property Items[Index: Integer]: Pointer read Get write Put; default;
-    property List: PPointerList read FList;
-  end;
-
-{ TThreadList class }
-
-  TThreadList = class
-  private
-    FList: TList;
-    FLock: TRTLCriticalSection;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    procedure Add(Item: Pointer);
-    procedure Clear;
-    function  LockList: TList;
-    procedure Remove(Item: Pointer);
-    procedure UnlockList;
-  end;
-
-{ TBits class }
-
-  TBits = class
-  private
-    FSize: Integer;
-    FBits: Pointer;
-    procedure Error;
-    procedure SetSize(Value: Integer);
-    procedure SetBit(Index: Integer; Value: Boolean);
-    function GetBit(Index: Integer): Boolean;
-  public
-    destructor Destroy; override;
-    function OpenBit: Integer;
-    property Bits[Index: Integer]: Boolean read GetBit write SetBit; default;
-    property Size: Integer read FSize write SetSize;
-  end;
-
-{ TPersistent abstract class }
-
-{$M+}
-
-  TPersistent = class(TObject)
-  private
-    procedure AssignError(Source: TPersistent);
-  protected
-    procedure AssignTo(Dest: TPersistent); virtual;
-    procedure DefineProperties(Filer: TFiler); virtual;
-    function  GetOwner: TPersistent; dynamic;
-  public
-    destructor Destroy; override;
-    procedure Assign(Source: TPersistent); virtual;
-    function  GetNamePath: string; dynamic;
-  end;
-
-{$M-}
-
-{ TPersistent class reference type }
-
-  TPersistentClass = class of TPersistent;
-
-{ TCollection class }
-
-  TCollection = class;
-
-  TCollectionItem = class(TPersistent)
-  private
-    FCollection: TCollection;
-    FID: Integer;
-    function GetIndex: Integer;
-    procedure SetCollection(Value: TCollection);
-  protected
-    procedure Changed(AllItems: Boolean);
-    function GetNamePath: string; override;
-    function GetOwner: TPersistent; override;
-    function GetDisplayName: string; virtual;
-    procedure SetIndex(Value: Integer); virtual;
-    procedure SetDisplayName(const Value: string); virtual;
-  public
-    constructor Create(Collection: TCollection); virtual;
-    destructor Destroy; override;
-    property Collection: TCollection read FCollection write SetCollection;
-    property ID: Integer read FID;
-    property Index: Integer read GetIndex write SetIndex;
-    property DisplayName: string read GetDisplayName write SetDisplayName;
-  end;
-
-  TCollectionItemClass = class of TCollectionItem;
-
-  TCollection = class(TPersistent)
-  private
-    FItemClass: TCollectionItemClass;
-    FItems: TList;
-    FUpdateCount: Integer;
-    FNextID: Integer;
-    FPropName: string;
-    function GetCount: Integer;
-    function GetPropName: string;
-    procedure InsertItem(Item: TCollectionItem);
-    procedure RemoveItem(Item: TCollectionItem);
-  protected
-    { Design-time editor support }
-    function GetAttrCount: Integer; dynamic;
-    function GetAttr(Index: Integer): string; dynamic;
-    function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
-    function GetNamePath: string; override;
-    procedure Changed;
-    function GetItem(Index: Integer): TCollectionItem;
-    procedure SetItem(Index: Integer; Value: TCollectionItem);
-    procedure SetItemName(Item: TCollectionItem); virtual;
-    procedure Update(Item: TCollectionItem); virtual;
-    property PropName: string read GetPropName write FPropName;
-  public
-    constructor Create(ItemClass: TCollectionItemClass);
-    destructor Destroy; override;
-    function Add: TCollectionItem;
-    procedure Assign(Source: TPersistent); override;
-    procedure BeginUpdate;
-    procedure Clear;
-    procedure EndUpdate;
-    function FindItemID(ID: Integer): TCollectionItem;
-    property Count: Integer read GetCount;
-    property ItemClass: TCollectionItemClass read FItemClass;
-    property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;
-  end;
-
-  TStrings = class;
-
-{ IStringsAdapter interface }
-{ Maintains link between TStrings and IStrings implementations }
-
-  IStringsAdapter = interface
-    ['{739C2F34-52EC-11D0-9EA6-0020AF3D82DA}']
-    procedure ReferenceStrings(S: TStrings);
-    procedure ReleaseStrings;
-  end;
-
-{ TStrings class }
-
-  TStrings = class(TPersistent)
-  private
-    FUpdateCount: Integer;
-    FAdapter: IStringsAdapter;
-    function GetCommaText: string;
-    function GetName(Index: Integer): string;
-    function GetValue(const Name: string): string;
-    procedure ReadData(Reader: TReader);
-    procedure SetCommaText(const Value: string);
-    procedure SetStringsAdapter(const Value: IStringsAdapter);
-    procedure SetValue(const Name, Value: string);
-    procedure WriteData(Writer: TWriter);
-  protected
-    procedure DefineProperties(Filer: TFiler); override;
-    procedure Error(const Msg: string; Data: Integer);
-    function Get(Index: Integer): string; virtual; abstract;
-    function GetCapacity: Integer; virtual;
-    function GetCount: Integer; virtual; abstract;
-    function GetObject(Index: Integer): TObject; virtual;
-    function GetTextStr: string; virtual;
-    procedure Put(Index: Integer; const S: string); virtual;
-    procedure PutObject(Index: Integer; AObject: TObject); virtual;
-    procedure SetCapacity(NewCapacity: Integer); virtual;
-    procedure SetTextStr(const Value: string); virtual;
-    procedure SetUpdateState(Updating: Boolean); virtual;
-  public
-    destructor Destroy; override;
-    function Add(const S: string): Integer; virtual;
-    function AddObject(const S: string; AObject: TObject): Integer; virtual;
-    procedure Append(const S: string);
-    procedure AddStrings(Strings: TStrings); virtual;
-    procedure Assign(Source: TPersistent); override;
-    procedure BeginUpdate;
-    procedure Clear; virtual; abstract;
-    procedure Delete(Index: Integer); virtual; abstract;
-    procedure EndUpdate;
-    function Equals(Strings: TStrings): Boolean;
-    procedure Exchange(Index1, Index2: Integer); virtual;
-    function GetText: PChar; virtual;
-    function IndexOf(const S: string): Integer; virtual;
-    function IndexOfName(const Name: string): Integer;
-    function IndexOfObject(AObject: TObject): Integer;
-    procedure Insert(Index: Integer; const S: string); virtual; abstract;
-    procedure InsertObject(Index: Integer; const S: string;
-      AObject: TObject);
-    procedure LoadFromFile(const FileName: string); virtual;
-    procedure LoadFromStream(Stream: TStream); virtual;
-    procedure Move(CurIndex, NewIndex: Integer); virtual;
-    procedure SaveToFile(const FileName: string); virtual;
-    procedure SaveToStream(Stream: TStream); virtual;
-    procedure SetText(Text: PChar); virtual;
-    property Capacity: Integer read GetCapacity write SetCapacity;
-    property CommaText: string read GetCommaText write SetCommaText;
-    property Count: Integer read GetCount;
-    property Names[Index: Integer]: string read GetName;
-    property Objects[Index: Integer]: TObject read GetObject write PutObject;
-    property Values[const Name: string]: string read GetValue write SetValue;
-    property Strings[Index: Integer]: string read Get write Put; default;
-    property Text: string read GetTextStr write SetTextStr;
-    property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
-  end;
-
-{ TStringList class }
-
-  TDuplicates = (dupIgnore, dupAccept, dupError);
-
-  PStringItem = ^TStringItem;
-  TStringItem = record
-    FString: string;
-    FObject: TObject;
-  end;
-
-  PStringItemList = ^TStringItemList;
-  TStringItemList = array[0..MaxListSize] of TStringItem;
-
-  TStringList = class(TStrings)
-  private
-    FList: PStringItemList;
-    FCount: Integer;
-    FCapacity: Integer;
-    FSorted: Boolean;
-    FDuplicates: TDuplicates;
-    FOnChange: TNotifyEvent;
-    FOnChanging: TNotifyEvent;
-    procedure ExchangeItems(Index1, Index2: Integer);
-    procedure Grow;
-    procedure QuickSort(L, R: Integer);
-    procedure InsertItem(Index: Integer; const S: string);
-    procedure SetSorted(Value: Boolean);
-  protected
-    procedure Changed; virtual;
-    procedure Changing; virtual;
-    function Get(Index: Integer): string; override;
-    function GetCapacity: Integer; override;
-    function GetCount: Integer; override;
-    function GetObject(Index: Integer): TObject; override;
-    procedure Put(Index: Integer; const S: string); override;
-    procedure PutObject(Index: Integer; AObject: TObject); override;
-    procedure SetCapacity(NewCapacity: Integer); override;
-    procedure SetUpdateState(Updating: Boolean); override;
-  public
-    destructor Destroy; override;
-    function Add(const S: string): Integer; override;
-    procedure Clear; override;
-    procedure Delete(Index: Integer); override;
-    procedure Exchange(Index1, Index2: Integer); override;
-    function Find(const S: string; var Index: Integer): Boolean; virtual;
-    function IndexOf(const S: string): Integer; override;
-    procedure Insert(Index: Integer; const S: string); override;
-    procedure Sort; virtual;
-    property Duplicates: TDuplicates read FDuplicates write FDuplicates;
-    property Sorted: Boolean read FSorted write SetSorted;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
-    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
-  end;
-
-{ TStream abstract class }
-
-  TStream = class(TObject)
-  private
-    function GetPosition: Longint;
-    procedure SetPosition(Pos: Longint);
-    function GetSize: Longint;
-  protected
-    procedure SetSize(NewSize: Longint); virtual;
-  public
-    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
-    function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
-    function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
-    procedure ReadBuffer(var Buffer; Count: Longint);
-    procedure WriteBuffer(const Buffer; Count: Longint);
-    function CopyFrom(Source: TStream; Count: Longint): Longint;
-    function ReadComponent(Instance: TComponent): TComponent;
-    function ReadComponentRes(Instance: TComponent): TComponent;
-    procedure WriteComponent(Instance: TComponent);
-    procedure WriteComponentRes(const ResName: string; Instance: TComponent);
-    procedure WriteDescendent(Instance, Ancestor: TComponent);
-    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
-    procedure ReadResHeader;
-    property Position: Longint read GetPosition write SetPosition;
-    property Size: Longint read GetSize write SetSize;
-  end;
-
-{ THandleStream class }
-
-  THandleStream = class(TStream)
-  private
-    FHandle: Integer;
-  protected
-    procedure SetSize(NewSize: Longint); override;
-  public
-    constructor Create(AHandle: Integer);
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    property Handle: Integer read FHandle;
-  end;
-
-{ TFileStream class }
-
-  TFileStream = class(THandleStream)
-  public
-    constructor Create(const FileName: string; Mode: Word);
-    destructor Destroy; override;
-  end;
-
-{ TCustomMemoryStream abstract class }
-
-  TCustomMemoryStream = class(TStream)
-  private
-    FMemory: Pointer;
-    FSize, FPosition: Longint;
-  protected
-    procedure SetPointer(Ptr: Pointer; Size: Longint);
-  public
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    procedure SaveToStream(Stream: TStream);
-    procedure SaveToFile(const FileName: string);
-    property Memory: Pointer read FMemory;
-  end;
-
-{ TMemoryStream }
-
-  TMemoryStream = class(TCustomMemoryStream)
-  private
-    FCapacity: Longint;
-    procedure SetCapacity(NewCapacity: Longint);
-  protected
-    function Realloc(var NewCapacity: Longint): Pointer; virtual;
-    property Capacity: Longint read FCapacity write SetCapacity;
-  public
-    destructor Destroy; override;
-    procedure Clear;
-    procedure LoadFromStream(Stream: TStream);
-    procedure LoadFromFile(const FileName: string);
-    procedure SetSize(NewSize: Longint); override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-  end;
-
-{ TStringStream }
-
-  TStringStream = class(TStream)
-  private
-    FDataString: string;
-    FPosition: Integer;
-  protected
-    procedure SetSize(NewSize: Longint); override;
-  public
-    constructor Create(const AString: string);
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function ReadString(Count: Longint): string;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    procedure WriteString(const AString: string);
-    property DataString: string read FDataString;
-  end;
-
-{ TResourceStream }
-
-  TResourceStream = class(TCustomMemoryStream)
-  private
-    HResInfo: HRSRC;
-    HGlobal: THandle;
-    procedure Initialize(Instance: THandle; Name, ResType: PChar);
-  public
-    constructor Create(Instance: THandle; const ResName: string; ResType: PChar);
-    constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
-    destructor Destroy; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-  end;
-
-{ TStreamAdapter }
-{ Implements OLE IStream on VCL TStream }
-
-  TStreamAdapter = class(TInterfacedObject, IStream)
-  private
-    FStream: TStream;
-  public
-    constructor Create(Stream: TStream);
-    function Read(pv: Pointer; cb: Longint;
-      pcbRead: PLongint): HResult; stdcall;
-    function Write(pv: Pointer; cb: Longint;
-      pcbWritten: PLongint): HResult; stdcall;
-    function Seek(dlibMove: Largeint; dwOrigin: Longint;
-      out libNewPosition: Largeint): HResult; stdcall;
-    function SetSize(libNewSize: Largeint): HResult; stdcall;
-    function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
-      out cbWritten: Largeint): HResult; stdcall;
-    function Commit(grfCommitFlags: Longint): HResult; stdcall;
-    function Revert: HResult; stdcall;
-    function LockRegion(libOffset: Largeint; cb: Largeint;
-      dwLockType: Longint): HResult; stdcall;
-    function UnlockRegion(libOffset: Largeint; cb: Largeint;
-      dwLockType: Longint): HResult; stdcall;
-    function Stat(out statstg: TStatStg;
-      grfStatFlag: Longint): HResult; stdcall;
-    function Clone(out stm: IStream): HResult; stdcall;
-  end;
-
-{ TFiler }
-
-  TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
-    vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
-    vaNil, vaCollection);
-
-  TFilerFlag = (ffInherited, ffChildPos);
-  TFilerFlags = set of TFilerFlag;
-
-  TReaderProc = procedure(Reader: TReader) of object;
-  TWriterProc = procedure(Writer: TWriter) of object;
-  TStreamProc = procedure(Stream: TStream) of object;
-
-  TFiler = class(TObject)
-  private
-    FStream: TStream;
-    FBuffer: Pointer;
-    FBufSize: Integer;
-    FBufPos: Integer;
-    FBufEnd: Integer;
-    FRoot: TComponent;
-    FAncestor: TPersistent;
-    FIgnoreChildren: Boolean;
-  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 FRoot;
-    property Ancestor: TPersistent read FAncestor write FAncestor;
-    property IgnoreChildren: Boolean read FIgnoreChildren write FIgnoreChildren;
-  end;
-
-{ TReader }
-
-  TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
-    var Address: Pointer; var Error: Boolean) of object;
-  TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
-    var Name: string) of object;
-  TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object;
-  TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string;
-    ComponentClass: TPersistentClass; var Component: TComponent) of object;
-  TReadComponentsProc = procedure(Component: TComponent) of object;
-  TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
-
-  TReader = class(TFiler)
-  private
-    FOwner: TComponent;
-    FParent: TComponent;
-    FFixups: TList;
-    FLoaded: TList;
-    FOnFindMethod: TFindMethodEvent;
-    FOnSetName: TSetNameEvent;
-    FOnReferenceName: TReferenceNameEvent;
-    FOnAncestorNotFound: TAncestorNotFoundEvent;
-    FOnError: TReaderError;
-    FCanHandleExcepts: Boolean;
-    FPropName: string;
-    procedure CheckValue(Value: TValueType);
-    procedure DoFixupReferences;
-    procedure FreeFixups;
-    function GetPosition: Longint;
-    procedure PropertyError;
-    procedure ReadBuffer;
-    procedure ReadData(Instance: TComponent);
-    procedure ReadDataInner(Instance: TComponent);
-    procedure ReadProperty(AInstance: TPersistent);
-    procedure ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
-    function ReadSet(SetType: Pointer): Integer;
-    procedure SetPosition(Value: Longint);
-    procedure SkipSetBody;
-    procedure SkipValue;
-    procedure SkipProperty;
-    procedure SkipComponent(SkipHeader: Boolean);
-  protected
-    function Error(const Message: string): Boolean; virtual;
-    function FindMethod(Root: TComponent; const MethodName: string): Pointer; virtual;
-    procedure SetName(Component: TComponent; var Name: string); virtual;
-    procedure ReferenceName(var Name: string); virtual;
-    function FindAncestorComponent(const Name: string;
-      ComponentClass: TPersistentClass): TComponent; virtual;
-  public
-    destructor Destroy; override;
-    procedure BeginReferences;
-    procedure DefineProperty(const Name: string;
-      ReadData: TReaderProc; WriteData: TWriterProc;
-      HasData: Boolean); override;
-    procedure DefineBinaryProperty(const Name: string;
-      ReadData, WriteData: TStreamProc;
-      HasData: Boolean); override;
-    function EndOfList: Boolean;
-    procedure EndReferences;
-    procedure FixupReferences;
-    procedure FlushBuffer; override;
-    function NextValue: TValueType;
-    procedure Read(var Buf; Count: Longint);
-    function ReadBoolean: Boolean;
-    function ReadChar: Char;
-    procedure ReadCollection(Collection: TCollection);
-    function ReadComponent(Component: TComponent): TComponent;
-    procedure ReadComponents(AOwner, AParent: TComponent;
-      Proc: TReadComponentsProc);
-    function ReadFloat: Extended;
-    function ReadIdent: string;
-    function ReadInteger: Longint;
-    procedure ReadListBegin;
-    procedure ReadListEnd;
-    procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer);
-    function ReadRootComponent(Root: TComponent): TComponent;
-    procedure ReadSignature;
-    function ReadStr: string;
-    function ReadString: string;
-    function ReadValue: TValueType;
-    procedure CopyValue(Writer: TWriter); {!!!}
-    property Owner: TComponent read FOwner write FOwner;
-    property Parent: TComponent read FParent write FParent;
-    property Position: Longint read GetPosition write SetPosition;
-    property OnError: TReaderError read FOnError write FOnError;
-    property OnFindMethod: TFindMethodEvent read FOnFindMethod write FOnFindMethod;
-    property OnSetName: TSetNameEvent read FOnSetName write FOnSetName;
-    property OnReferenceName: TReferenceNameEvent read FOnReferenceName write FOnReferenceName;
-    property OnAncestorNotFound: TAncestorNotFoundEvent read FOnAncestorNotFound write FOnAncestorNotFound;
-  end;
-
-{ TWriter }
-
-  TWriter = class(TFiler)
-  private
-    FRootAncestor: TComponent;
-    FPropPath: string;
-    FAncestorList: TList;
-    FAncestorPos: Integer;
-    FChildPos: Integer;
-    procedure AddAncestor(Component: TComponent);
-    function GetPosition: Longint;
-    procedure SetPosition(Value: Longint);
-    procedure WriteBuffer;
-    procedure WriteData(Instance: TComponent); virtual; // linker optimization
-    procedure WriteProperty(Instance: TPersistent; PropInfo: Pointer);
-    procedure WriteProperties(Instance: TPersistent);
-    procedure WritePropName(const PropName: string);
-  protected
-    procedure WriteBinary(WriteData: TStreamProc);
-    procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer);
-    procedure WriteValue(Value: TValueType);
-  public
-    destructor Destroy; override;
-    procedure DefineProperty(const Name: string;
-      ReadData: TReaderProc; WriteData: TWriterProc;
-      HasData: Boolean); override;
-    procedure DefineBinaryProperty(const Name: string;
-      ReadData, WriteData: TStreamProc;
-      HasData: Boolean); override;
-    procedure FlushBuffer; override;
-    procedure Write(const Buf; Count: Longint);
-    procedure WriteBoolean(Value: Boolean);
-    procedure WriteCollection(Value: TCollection);
-    procedure WriteComponent(Component: TComponent);
-    procedure WriteChar(Value: Char);
-    procedure WriteDescendent(Root: TComponent; AAncestor: TComponent);
-    procedure WriteFloat(Value: Extended);
-    procedure WriteIdent(const Ident: string);
-    procedure WriteInteger(Value: Longint);
-    procedure WriteListBegin;
-    procedure WriteListEnd;
-    procedure WriteRootComponent(Root: TComponent);
-    procedure WriteSignature;
-    procedure WriteStr(const Value: string);
-    procedure WriteString(const Value: string);
-    property Position: Longint read GetPosition write SetPosition;
-    property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
-  end;
-
-{ TParser }
-
-  TParser = class(TObject)
-  private
-    FStream: TStream;
-    FOrigin: Longint;
-    FBuffer: PChar;
-    FBufPtr: PChar;
-    FBufEnd: PChar;
-    FSourcePtr: PChar;
-    FSourceEnd: PChar;
-    FTokenPtr: PChar;
-    FStringPtr: PChar;
-    FSourceLine: Integer;
-    FSaveChar: Char;
-    FToken: Char;
-    procedure ReadBuffer;
-    procedure SkipBlanks;
-  public
-    constructor Create(Stream: TStream);
-    destructor Destroy; override;
-    procedure CheckToken(T: Char);
-    procedure CheckTokenSymbol(const S: string);
-    procedure Error(const Ident: string);
-    procedure ErrorFmt(const Ident: string; const Args: array of const);
-    procedure ErrorStr(const Message: string);
-    procedure HexToBinary(Stream: TStream);
-    function NextToken: Char;
-    function SourcePos: Longint;
-    function TokenComponentIdent: String;
-    function TokenFloat: Extended;
-    function TokenInt: Longint;
-    function TokenString: string;
-    function TokenSymbolIs(const S: string): Boolean;
-    property SourceLine: Integer read FSourceLine;
-    property Token: Char read FToken;
-  end;
-
-{ TThread }
-
-  EThread = class(Exception);
-
-  TThreadMethod = procedure of object;
-  TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
-    tpTimeCritical);
-
-  TThread = class
-  private
-    FHandle: THandle;
-    FThreadID: THandle;
-    FTerminated: Boolean;
-    FSuspended: Boolean;
-    FFreeOnTerminate: Boolean;
-    FFinished: Boolean;
-    FReturnValue: Integer;
-    FOnTerminate: TNotifyEvent;
-    FMethod: TThreadMethod;
-    FSynchronizeException: TObject;
-    procedure CallOnTerminate;
-    function GetPriority: TThreadPriority;
-    procedure SetPriority(Value: TThreadPriority);
-    procedure SetSuspended(Value: Boolean);
-  protected
-    procedure DoTerminate; virtual;
-    procedure Execute; virtual; abstract;
-    procedure Synchronize(Method: TThreadMethod);
-    property ReturnValue: Integer read FReturnValue write FReturnValue;
-    property Terminated: Boolean read FTerminated;
-  public
-    constructor Create(CreateSuspended: Boolean);
-    destructor Destroy; override;
-    procedure Resume;
-    procedure Suspend;
-    procedure Terminate;
-    function WaitFor: Integer;
-    property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
-    property Handle: THandle read FHandle;
-    property Priority: TThreadPriority read GetPriority write SetPriority;
-    property Suspended: Boolean read FSuspended write SetSuspended;
-    property ThreadID: THandle read FThreadID;
-    property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
-  end;
-
-{ TComponent class }
-
-  TOperation = (opInsert, opRemove);
-  TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
-    csDesigning, csAncestor, csUpdating, csFixups);
-  TComponentStyle = set of (csInheritable, csCheckPropAvail);
-  TGetChildProc = procedure (Child: TComponent) of object;
-
-  TComponentName = type string;
-
-  IVCLComObject = interface
-    ['{E07892A0-F52F-11CF-BD2F-0020AF0E5B81}']
-    function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
-    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
-    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
-      NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
-    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
-      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
-    function SafeCallException(ExceptObject: TObject;
-      ExceptAddr: Pointer): Integer;
-    procedure FreeOnRelease;
-  end;
-
-  TComponent = class(TPersistent)
-  private
-    FOwner: TComponent;
-    FName: TComponentName;
-    FTag: Longint;
-    FComponents: TList;
-    FFreeNotifies: TList;
-    FDesignInfo: Longint;
-    FVCLComObject: Pointer;
-    FComponentState: TComponentState;
-    function GetComObject: IUnknown;
-    function GetComponent(AIndex: Integer): TComponent;
-    function GetComponentCount: Integer;
-    function GetComponentIndex: Integer;
-    procedure Insert(AComponent: TComponent);
-    procedure ReadLeft(Reader: TReader);
-    procedure ReadTop(Reader: TReader);
-    procedure Remove(AComponent: TComponent);
-    procedure SetComponentIndex(Value: Integer);
-    procedure SetReference(Enable: Boolean);
-    procedure WriteLeft(Writer: TWriter);
-    procedure WriteTop(Writer: TWriter);
-  protected
-    FComponentStyle: TComponentStyle;
-    procedure ChangeName(const NewName: TComponentName);
-    procedure DefineProperties(Filer: TFiler); override;
-    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
-    function GetChildOwner: TComponent; dynamic;
-    function GetChildParent: TComponent; dynamic;
-    function GetNamePath: string; override;
-    function GetOwner: TPersistent; override;
-    procedure Loaded; virtual;
-    procedure Notification(AComponent: TComponent;
-      Operation: TOperation); virtual;
-    procedure ReadState(Reader: TReader); virtual;
-    procedure SetAncestor(Value: Boolean);
-    procedure SetDesigning(Value: Boolean);
-    procedure SetName(const NewName: TComponentName); virtual;
-    procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic;
-    procedure SetParentComponent(Value: TComponent); dynamic;
-    procedure Updating; dynamic;
-    procedure Updated; dynamic;
-    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); dynamic;
-    procedure ValidateRename(AComponent: TComponent;
-      const CurName, NewName: string); virtual;
-    procedure ValidateContainer(AComponent: TComponent); dynamic;
-    procedure ValidateInsert(AComponent: TComponent); dynamic;
-    procedure WriteState(Writer: TWriter); virtual;
-    { IUnknown }
-    function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
-    function _AddRef: Integer; stdcall;
-    function _Release: Integer; stdcall;
-    { IDispatch }
-    function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
-    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
-    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
-      NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
-    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
-      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
-  public
-    constructor Create(AOwner: TComponent); virtual;
-    destructor Destroy; override;
-    procedure DestroyComponents;
-    procedure Destroying;
-    function FindComponent(const AName: string): TComponent;
-    procedure FreeNotification(AComponent: TComponent);
-    procedure FreeOnRelease;
-    function GetParentComponent: TComponent; dynamic;
-    function HasParent: Boolean; dynamic;
-    procedure InsertComponent(AComponent: TComponent);
-    procedure RemoveComponent(AComponent: TComponent);
-    function SafeCallException(ExceptObject: TObject;
-      ExceptAddr: Pointer): Integer; override;
-    property ComObject: IUnknown read GetComObject;
-    property Components[Index: Integer]: TComponent read GetComponent;
-    property ComponentCount: Integer read GetComponentCount;
-    property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex;
-    property ComponentState: TComponentState read FComponentState;
-    property ComponentStyle: TComponentStyle read FComponentStyle;
-    property DesignInfo: Longint read FDesignInfo write FDesignInfo;
-    property Owner: TComponent read FOwner;
-    property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
-  published
-    property Name: TComponentName read FName write SetName stored False;
-    property Tag: Longint read FTag write FTag default 0;
-  end;
-
-{ TComponent class reference type }
-
-  TComponentClass = class of TComponent;
-
-{ Component registration handlers }
-
-  TActiveXRegType = (axrComponentOnly, axrIncludeDescendants);
-
-var
-  RegisterComponentsProc: procedure(const Page: string;
-    ComponentClasses: array of TComponentClass) = nil;
-  RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass) = nil;
-  RegisterNonActiveXProc: procedure(ComponentClasses: array of TComponentClass;
-    AxRegType: TActiveXRegType) = nil;
-  CurrentGroup: Integer = -1; { Current design group }
-  CreateVCLComObjectProc: procedure(Component: TComponent) = nil;
-
-{ Point and rectangle constructors }
-
-function Point(AX, AY: Integer): TPoint;
-function SmallPoint(AX, AY: SmallInt): TSmallPoint;
-function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
-function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
-
-{ Class registration routines }
-
-procedure RegisterClass(AClass: TPersistentClass);
-procedure RegisterClasses(AClasses: array of TPersistentClass);
-procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
-procedure UnRegisterClass(AClass: TPersistentClass);
-procedure UnRegisterClasses(AClasses: array of TPersistentClass);
-procedure UnRegisterModuleClasses(Module: HMODULE);
-function FindClass(const ClassName: string): TPersistentClass;
-function GetClass(const ClassName: string): TPersistentClass;
-
-{ Component registration routines }
-
-procedure RegisterComponents(const Page: string;
-  ComponentClasses: array of TComponentClass);
-procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
-procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
-  AxRegType: TActiveXRegType);
-
-
-{ Object filing routines }
-
-type
-  TIdentMapEntry = record
-    Value: Integer;
-    Name: String;
-  end;
-
-  TIdentToInt = function(const Ident: string; var Int: Longint): Boolean;
-  TIntToIdent = function(Int: Longint; var Ident: string): Boolean;
-  TFindGlobalComponent = function(const Name: string): TComponent;
-
-var
-  MainThreadID: THandle;
-  FindGlobalComponent: TFindGlobalComponent;
-
-procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToInt: TIdentToInt;
-  IntToIdent: TIntToIdent);
-function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
-function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
-
-function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
-function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
-function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
-function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
-function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
-procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
-
-procedure GlobalFixupReferences;
-procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
-procedure GetFixupInstanceNames(Root: TComponent;
-  const ReferenceRootName: string; Names: TStrings);
-procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
-  NewRootName: string);
-procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
-procedure RemoveFixups(Instance: TPersistent);
-
-procedure BeginGlobalLoading;
-procedure NotifyGlobalLoading;
-procedure EndGlobalLoading;
-
-function CollectionsEqual(C1, C2: TCollection): Boolean;
-
-{ Object conversion routines }
-
-procedure ObjectBinaryToText(Input, Output: TStream);
-procedure ObjectTextToBinary(Input, Output: TStream);
-
-procedure ObjectResourceToText(Input, Output: TStream);
-procedure ObjectTextToResource(Input, Output: TStream);
-
-{ Utility routines }
-
-function LineStart(Buffer, BufPos: PChar): PChar;
-
-implementation
-
-
-end.