home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 August / VPR9708A.ISO / D3TRIAL / INSTALL / DATA.Z / CLASSES.INT < prev    next >
Text File  |  1997-03-21  |  30KB  |  817 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Classes;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses SysUtils, Windows, ActiveX;
  17.  
  18. const
  19.  
  20. { Maximum TList size }
  21.  
  22.   MaxListSize = Maxint div 16;
  23.  
  24. { TStream seek origins }
  25.  
  26.   soFromBeginning = 0;
  27.   soFromCurrent = 1;
  28.   soFromEnd = 2;
  29.  
  30. { TFileStream create mode }
  31.  
  32.   fmCreate = $FFFF;
  33.  
  34. { TParser special tokens }
  35.  
  36.   toEOF     = Char(0);
  37.   toSymbol  = Char(1);
  38.   toString  = Char(2);
  39.   toInteger = Char(3);
  40.   toFloat   = Char(4);
  41.  
  42. type
  43.  
  44. { Text alignment types }
  45.  
  46.   TAlignment = (taLeftJustify, taRightJustify, taCenter);
  47.   TLeftRight = taLeftJustify..taRightJustify;
  48.  
  49. { Types used by standard events }
  50.  
  51.   TShiftState = set of (ssShift, ssAlt, ssCtrl,
  52.     ssLeft, ssRight, ssMiddle, ssDouble);
  53.  
  54.   THelpContext = -MaxLongint..MaxLongint;
  55.  
  56. { Standard events }
  57.  
  58.   TNotifyEvent = procedure(Sender: TObject) of object;
  59.   THelpEvent = function (Command: Word; Data: Longint;
  60.     var CallHelp: Boolean): Boolean of object;
  61.   TGetStrProc = procedure(const S: string) of object;
  62.  
  63. { Exception classes }
  64.  
  65.   EStreamError = class(Exception);
  66.   EFCreateError = class(EStreamError);
  67.   EFOpenError = class(EStreamError);
  68.   EFilerError = class(EStreamError);
  69.   EReadError = class(EFilerError);
  70.   EWriteError = class(EFilerError);
  71.   EClassNotFound = class(EFilerError);
  72.   EMethodNotFound = class(EFilerError);
  73.   EInvalidImage = class(EFilerError);
  74.   EResNotFound = class(Exception);
  75.   EListError = class(Exception);
  76.   EBitsError = class(Exception);
  77.   EStringListError = class(Exception);
  78.   EComponentError = class(Exception);
  79.   EParserError = class(Exception);
  80.   EOutOfResources = class(EOutOfMemory);
  81.   EInvalidOperation = class(Exception);
  82.  
  83. { Forward class declarations }
  84.  
  85.   TStream = class;
  86.   TFiler = class;
  87.   TReader = class;
  88.   TWriter = class;
  89.   TComponent = class;
  90.  
  91. { TList class }
  92.  
  93.   PPointerList = ^TPointerList;
  94.   TPointerList = array[0..MaxListSize - 1] of Pointer;
  95.   TListSortCompare = function (Item1, Item2: Pointer): Integer;
  96.  
  97.   TList = class(TObject)
  98.   protected
  99.     function Get(Index: Integer): Pointer;
  100.     procedure Grow; virtual;
  101.     procedure Put(Index: Integer; Item: Pointer);
  102.     procedure SetCapacity(NewCapacity: Integer);
  103.     procedure SetCount(NewCount: Integer);
  104.   public
  105.     destructor Destroy; override;
  106.     function Add(Item: Pointer): Integer;
  107.     procedure Clear;
  108.     procedure Delete(Index: Integer);
  109.     class procedure Error(const Msg: string; Data: Integer); virtual;
  110.     procedure Exchange(Index1, Index2: Integer);
  111.     function Expand: TList;
  112.     function First: Pointer;
  113.     function IndexOf(Item: Pointer): Integer;
  114.     procedure Insert(Index: Integer; Item: Pointer);
  115.     function Last: Pointer;
  116.     procedure Move(CurIndex, NewIndex: Integer);
  117.     function Remove(Item: Pointer): Integer;
  118.     procedure Pack;
  119.     procedure Sort(Compare: TListSortCompare);
  120.     property Capacity: Integer;
  121.     property Count: Integer;
  122.     property Items[Index: Integer]: Pointer; default;
  123.     property List: PPointerList;
  124.   end;
  125.  
  126. { TThreadList class }
  127.  
  128.   TThreadList = class
  129.   public
  130.     constructor Create;
  131.     destructor Destroy; override;
  132.     procedure Add(Item: Pointer);
  133.     procedure Clear;
  134.     function  LockList: TList;
  135.     procedure Remove(Item: Pointer);
  136.     procedure UnlockList;
  137.   end;
  138.  
  139. { TBits class }
  140.  
  141.   TBits = class
  142.   public
  143.     destructor Destroy; override;
  144.     function OpenBit: Integer;
  145.     property Bits[Index: Integer]: Boolean; default;
  146.     property Size: Integer;
  147.   end;
  148.  
  149. { TPersistent abstract class }
  150.  
  151. {$M+}
  152.  
  153.   TPersistent = class(TObject)
  154.   protected
  155.     procedure AssignTo(Dest: TPersistent); virtual;
  156.     procedure DefineProperties(Filer: TFiler); virtual;
  157.     function  GetOwner: TPersistent; dynamic;
  158.   public
  159.     destructor Destroy; override;
  160.     procedure Assign(Source: TPersistent); virtual;
  161.     function  GetNamePath: string; dynamic;
  162.   end;
  163.  
  164. {$M-}
  165.  
  166. { TPersistent class reference type }
  167.  
  168.   TPersistentClass = class of TPersistent;
  169.  
  170. { TCollection class }
  171.  
  172.   TCollection = class;
  173.  
  174.   TCollectionItem = class(TPersistent)
  175.   protected
  176.     procedure Changed(AllItems: Boolean);
  177.     function GetNamePath: string; override;
  178.     function GetOwner: TPersistent; override;
  179.     function GetDisplayName: string; virtual;
  180.     procedure SetIndex(Value: Integer); virtual;
  181.     procedure SetDisplayName(const Value: string); virtual;
  182.   public
  183.     constructor Create(Collection: TCollection); virtual;
  184.     destructor Destroy; override;
  185.     property Collection: TCollection;
  186.     property ID: Integer;
  187.     property Index: Integer;
  188.     property DisplayName: string;
  189.   end;
  190.  
  191.   TCollectionItemClass = class of TCollectionItem;
  192.  
  193.   TCollection = class(TPersistent)
  194.   protected
  195.     { Design-time editor support }
  196.     function GetAttrCount: Integer; dynamic;
  197.     function GetAttr(Index: Integer): string; dynamic;
  198.     function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
  199.     function GetNamePath: string; override;
  200.     procedure Changed;
  201.     function GetItem(Index: Integer): TCollectionItem;
  202.     procedure SetItem(Index: Integer; Value: TCollectionItem);
  203.     procedure SetItemName(Item: TCollectionItem); virtual;
  204.     procedure Update(Item: TCollectionItem); virtual;
  205.     property PropName: string;
  206.   public
  207.     constructor Create(ItemClass: TCollectionItemClass);
  208.     destructor Destroy; override;
  209.     function Add: TCollectionItem;
  210.     procedure Assign(Source: TPersistent); override;
  211.     procedure BeginUpdate;
  212.     procedure Clear;
  213.     procedure EndUpdate;
  214.     function FindItemID(ID: Integer): TCollectionItem;
  215.     property Count: Integer;
  216.     property ItemClass: TCollectionItemClass;
  217.     property Items[Index: Integer]: TCollectionItem;
  218.   end;
  219.  
  220.   TStrings = class;
  221.  
  222. { IStringsAdapter interface }
  223. { Maintains link between TStrings and IStrings implementations }
  224.  
  225.   IStringsAdapter = interface
  226.     ['{739C2F34-52EC-11D0-9EA6-0020AF3D82DA}']
  227.     procedure ReferenceStrings(S: TStrings);
  228.     procedure ReleaseStrings;
  229.   end;
  230.  
  231. { TStrings class }
  232.  
  233.   TStrings = class(TPersistent)
  234.   protected
  235.     procedure DefineProperties(Filer: TFiler); override;
  236.     procedure Error(const Msg: string; Data: Integer);
  237.     function Get(Index: Integer): string; virtual; abstract;
  238.     function GetCapacity: Integer; virtual;
  239.     function GetCount: Integer; virtual; abstract;
  240.     function GetObject(Index: Integer): TObject; virtual;
  241.     function GetTextStr: string; virtual;
  242.     procedure Put(Index: Integer; const S: string); virtual;
  243.     procedure PutObject(Index: Integer; AObject: TObject); virtual;
  244.     procedure SetCapacity(NewCapacity: Integer); virtual;
  245.     procedure SetTextStr(const Value: string); virtual;
  246.     procedure SetUpdateState(Updating: Boolean); virtual;
  247.   public
  248.     destructor Destroy; override;
  249.     function Add(const S: string): Integer; virtual;
  250.     function AddObject(const S: string; AObject: TObject): Integer; virtual;
  251.     procedure Append(const S: string);
  252.     procedure AddStrings(Strings: TStrings); virtual;
  253.     procedure Assign(Source: TPersistent); override;
  254.     procedure BeginUpdate;
  255.     procedure Clear; virtual; abstract;
  256.     procedure Delete(Index: Integer); virtual; abstract;
  257.     procedure EndUpdate;
  258.     function Equals(Strings: TStrings): Boolean;
  259.     procedure Exchange(Index1, Index2: Integer); virtual;
  260.     function GetText: PChar; virtual;
  261.     function IndexOf(const S: string): Integer; virtual;
  262.     function IndexOfName(const Name: string): Integer;
  263.     function IndexOfObject(AObject: TObject): Integer;
  264.     procedure Insert(Index: Integer; const S: string); virtual; abstract;
  265.     procedure InsertObject(Index: Integer; const S: string;
  266.       AObject: TObject);
  267.     procedure LoadFromFile(const FileName: string); virtual;
  268.     procedure LoadFromStream(Stream: TStream); virtual;
  269.     procedure Move(CurIndex, NewIndex: Integer); virtual;
  270.     procedure SaveToFile(const FileName: string); virtual;
  271.     procedure SaveToStream(Stream: TStream); virtual;
  272.     procedure SetText(Text: PChar); virtual;
  273.     property Capacity: Integer;
  274.     property CommaText: string;
  275.     property Count: Integer;
  276.     property Names[Index: Integer]: string;
  277.     property Objects[Index: Integer]: TObject;
  278.     property Values[const Name: string]: string;
  279.     property Strings[Index: Integer]: string; default;
  280.     property Text: string;
  281.     property StringsAdapter: IStringsAdapter;
  282.   end;
  283.  
  284. { TStringList class }
  285.  
  286.   TDuplicates = (dupIgnore, dupAccept, dupError);
  287.  
  288.   PStringItem = ^TStringItem;
  289.   TStringItem = record
  290.     FString: string;
  291.     FObject: TObject;
  292.   end;
  293.  
  294.   PStringItemList = ^TStringItemList;
  295.   TStringItemList = array[0..MaxListSize] of TStringItem;
  296.  
  297.   TStringList = class(TStrings)
  298.   protected
  299.     procedure Changed; virtual;
  300.     procedure Changing; virtual;
  301.     function Get(Index: Integer): string; override;
  302.     function GetCapacity: Integer; override;
  303.     function GetCount: Integer; override;
  304.     function GetObject(Index: Integer): TObject; override;
  305.     procedure Put(Index: Integer; const S: string); override;
  306.     procedure PutObject(Index: Integer; AObject: TObject); override;
  307.     procedure SetCapacity(NewCapacity: Integer); override;
  308.     procedure SetUpdateState(Updating: Boolean); override;
  309.   public
  310.     destructor Destroy; override;
  311.     function Add(const S: string): Integer; override;
  312.     procedure Clear; override;
  313.     procedure Delete(Index: Integer); override;
  314.     procedure Exchange(Index1, Index2: Integer); override;
  315.     function Find(const S: string; var Index: Integer): Boolean; virtual;
  316.     function IndexOf(const S: string): Integer; override;
  317.     procedure Insert(Index: Integer; const S: string); override;
  318.     procedure Sort; virtual;
  319.     property Duplicates: TDuplicates;
  320.     property Sorted: Boolean;
  321.     property OnChange: TNotifyEvent;
  322.     property OnChanging: TNotifyEvent;
  323.   end;
  324.  
  325. { TStream abstract class }
  326.  
  327.   TStream = class(TObject)
  328.   protected
  329.     procedure SetSize(NewSize: Longint); virtual;
  330.   public
  331.     function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
  332.     function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
  333.     function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
  334.     procedure ReadBuffer(var Buffer; Count: Longint);
  335.     procedure WriteBuffer(const Buffer; Count: Longint);
  336.     function CopyFrom(Source: TStream; Count: Longint): Longint;
  337.     function ReadComponent(Instance: TComponent): TComponent;
  338.     function ReadComponentRes(Instance: TComponent): TComponent;
  339.     procedure WriteComponent(Instance: TComponent);
  340.     procedure WriteComponentRes(const ResName: string; Instance: TComponent);
  341.     procedure WriteDescendent(Instance, Ancestor: TComponent);
  342.     procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
  343.     procedure ReadResHeader;
  344.     property Position: Longint;
  345.     property Size: Longint;
  346.   end;
  347.  
  348. { THandleStream class }
  349.  
  350.   THandleStream = class(TStream)
  351.   protected
  352.     procedure SetSize(NewSize: Longint); override;
  353.   public
  354.     constructor Create(AHandle: Integer);
  355.     function Read(var Buffer; Count: Longint): Longint; override;
  356.     function Write(const Buffer; Count: Longint): Longint; override;
  357.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  358.     property Handle: Integer;
  359.   end;
  360.  
  361. { TFileStream class }
  362.  
  363.   TFileStream = class(THandleStream)
  364.   public
  365.     constructor Create(const FileName: string; Mode: Word);
  366.     destructor Destroy; override;
  367.   end;
  368.  
  369. { TCustomMemoryStream abstract class }
  370.  
  371.   TCustomMemoryStream = class(TStream)
  372.   protected
  373.     procedure SetPointer(Ptr: Pointer; Size: Longint);
  374.   public
  375.     function Read(var Buffer; Count: Longint): Longint; override;
  376.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  377.     procedure SaveToStream(Stream: TStream);
  378.     procedure SaveToFile(const FileName: string);
  379.     property Memory: Pointer;
  380.   end;
  381.  
  382. { TMemoryStream }
  383.  
  384.   TMemoryStream = class(TCustomMemoryStream)
  385.   protected
  386.     function Realloc(var NewCapacity: Longint): Pointer; virtual;
  387.     property Capacity: Longint;
  388.   public
  389.     destructor Destroy; override;
  390.     procedure Clear;
  391.     procedure LoadFromStream(Stream: TStream);
  392.     procedure LoadFromFile(const FileName: string);
  393.     procedure SetSize(NewSize: Longint); override;
  394.     function Write(const Buffer; Count: Longint): Longint; override;
  395.   end;
  396.  
  397. { TStringStream }
  398.  
  399.   TStringStream = class(TStream)
  400.   protected
  401.     procedure SetSize(NewSize: Longint); override;
  402.   public
  403.     constructor Create(const AString: string);
  404.     function Read(var Buffer; Count: Longint): Longint; override;
  405.     function ReadString(Count: Longint): string;
  406.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  407.     function Write(const Buffer; Count: Longint): Longint; override;
  408.     procedure WriteString(const AString: string);
  409.     property DataString: string;
  410.   end;
  411.  
  412. { TResourceStream }
  413.  
  414.   TResourceStream = class(TCustomMemoryStream)
  415.   public
  416.     constructor Create(Instance: THandle; const ResName: string; ResType: PChar);
  417.     constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
  418.     destructor Destroy; override;
  419.     function Write(const Buffer; Count: Longint): Longint; override;
  420.   end;
  421.  
  422. { TStreamAdapter }
  423. { Implements OLE IStream on VCL TStream }
  424.  
  425.   TStreamAdapter = class(TInterfacedObject, IStream)
  426.   public
  427.     constructor Create(Stream: TStream);
  428.     function Read(pv: Pointer; cb: Longint;
  429.       pcbRead: PLongint): HResult; stdcall;
  430.     function Write(pv: Pointer; cb: Longint;
  431.       pcbWritten: PLongint): HResult; stdcall;
  432.     function Seek(dlibMove: Largeint; dwOrigin: Longint;
  433.       out libNewPosition: Largeint): HResult; stdcall;
  434.     function SetSize(libNewSize: Largeint): HResult; stdcall;
  435.     function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
  436.       out cbWritten: Largeint): HResult; stdcall;
  437.     function Commit(grfCommitFlags: Longint): HResult; stdcall;
  438.     function Revert: HResult; stdcall;
  439.     function LockRegion(libOffset: Largeint; cb: Largeint;
  440.       dwLockType: Longint): HResult; stdcall;
  441.     function UnlockRegion(libOffset: Largeint; cb: Largeint;
  442.       dwLockType: Longint): HResult; stdcall;
  443.     function Stat(out statstg: TStatStg;
  444.       grfStatFlag: Longint): HResult; stdcall;
  445.     function Clone(out stm: IStream): HResult; stdcall;
  446.   end;
  447.  
  448. { TFiler }
  449.  
  450.   TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
  451.     vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
  452.     vaNil, vaCollection);
  453.  
  454.   TFilerFlag = (ffInherited, ffChildPos);
  455.   TFilerFlags = set of TFilerFlag;
  456.  
  457.   TReaderProc = procedure(Reader: TReader) of object;
  458.   TWriterProc = procedure(Writer: TWriter) of object;
  459.   TStreamProc = procedure(Stream: TStream) of object;
  460.  
  461.   TFiler = class(TObject)
  462.   public
  463.     constructor Create(Stream: TStream; BufSize: Integer);
  464.     destructor Destroy; override;
  465.     procedure DefineProperty(const Name: string;
  466.       ReadData: TReaderProc; WriteData: TWriterProc;
  467.       HasData: Boolean); virtual; abstract;
  468.     procedure DefineBinaryProperty(const Name: string;
  469.       ReadData, WriteData: TStreamProc;
  470.       HasData: Boolean); virtual; abstract;
  471.     procedure FlushBuffer; virtual; abstract;
  472.     property Root: TComponent;
  473.     property Ancestor: TPersistent;
  474.     property IgnoreChildren: Boolean;
  475.   end;
  476.  
  477. { TReader }
  478.  
  479.   TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
  480.     var Address: Pointer; var Error: Boolean) of object;
  481.   TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
  482.     var Name: string) of object;
  483.   TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object;
  484.   TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string;
  485.     ComponentClass: TPersistentClass; var Component: TComponent) of object;
  486.   TReadComponentsProc = procedure(Component: TComponent) of object;
  487.   TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
  488.  
  489.   TReader = class(TFiler)
  490.   protected
  491.     function Error(const Message: string): Boolean; virtual;
  492.     function FindMethod(Root: TComponent; const MethodName: string): Pointer; virtual;
  493.     procedure SetName(Component: TComponent; var Name: string); virtual;
  494.     procedure ReferenceName(var Name: string); virtual;
  495.     function FindAncestorComponent(const Name: string;
  496.       ComponentClass: TPersistentClass): TComponent; virtual;
  497.   public
  498.     destructor Destroy; override;
  499.     procedure BeginReferences;
  500.     procedure DefineProperty(const Name: string;
  501.       ReadData: TReaderProc; WriteData: TWriterProc;
  502.       HasData: Boolean); override;
  503.     procedure DefineBinaryProperty(const Name: string;
  504.       ReadData, WriteData: TStreamProc;
  505.       HasData: Boolean); override;
  506.     function EndOfList: Boolean;
  507.     procedure EndReferences;
  508.     procedure FixupReferences;
  509.     procedure FlushBuffer; override;
  510.     function NextValue: TValueType;
  511.     procedure Read(var Buf; Count: Longint);
  512.     function ReadBoolean: Boolean;
  513.     function ReadChar: Char;
  514.     procedure ReadCollection(Collection: TCollection);
  515.     function ReadComponent(Component: TComponent): TComponent;
  516.     procedure ReadComponents(AOwner, AParent: TComponent;
  517.       Proc: TReadComponentsProc);
  518.     function ReadFloat: Extended;
  519.     function ReadIdent: string;
  520.     function ReadInteger: Longint;
  521.     procedure ReadListBegin;
  522.     procedure ReadListEnd;
  523.     procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer);
  524.     function ReadRootComponent(Root: TComponent): TComponent;
  525.     procedure ReadSignature;
  526.     function ReadStr: string;
  527.     function ReadString: string;
  528.     function ReadValue: TValueType;
  529.     procedure CopyValue(Writer: TWriter); {!!!}
  530.     property Owner: TComponent;
  531.     property Parent: TComponent;
  532.     property Position: Longint;
  533.     property OnError: TReaderError;
  534.     property OnFindMethod: TFindMethodEvent;
  535.     property OnSetName: TSetNameEvent;
  536.     property OnReferenceName: TReferenceNameEvent;
  537.     property OnAncestorNotFound: TAncestorNotFoundEvent;
  538.   end;
  539.  
  540. { TWriter }
  541.  
  542.   TWriter = class(TFiler)
  543.   protected
  544.     procedure WriteBinary(WriteData: TStreamProc);
  545.     procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer);
  546.     procedure WriteValue(Value: TValueType);
  547.   public
  548.     destructor Destroy; override;
  549.     procedure DefineProperty(const Name: string;
  550.       ReadData: TReaderProc; WriteData: TWriterProc;
  551.       HasData: Boolean); override;
  552.     procedure DefineBinaryProperty(const Name: string;
  553.       ReadData, WriteData: TStreamProc;
  554.       HasData: Boolean); override;
  555.     procedure FlushBuffer; override;
  556.     procedure Write(const Buf; Count: Longint);
  557.     procedure WriteBoolean(Value: Boolean);
  558.     procedure WriteCollection(Value: TCollection);
  559.     procedure WriteComponent(Component: TComponent);
  560.     procedure WriteChar(Value: Char);
  561.     procedure WriteDescendent(Root: TComponent; AAncestor: TComponent);
  562.     procedure WriteFloat(Value: Extended);
  563.     procedure WriteIdent(const Ident: string);
  564.     procedure WriteInteger(Value: Longint);
  565.     procedure WriteListBegin;
  566.     procedure WriteListEnd;
  567.     procedure WriteRootComponent(Root: TComponent);
  568.     procedure WriteSignature;
  569.     procedure WriteStr(const Value: string);
  570.     procedure WriteString(const Value: string);
  571.     property Position: Longint;
  572.     property RootAncestor: TComponent;
  573.   end;
  574.  
  575. { TParser }
  576.  
  577.   TParser = class(TObject)
  578.   public
  579.     constructor Create(Stream: TStream);
  580.     destructor Destroy; override;
  581.     procedure CheckToken(T: Char);
  582.     procedure CheckTokenSymbol(const S: string);
  583.     procedure Error(const Ident: string);
  584.     procedure ErrorFmt(const Ident: string; const Args: array of const);
  585.     procedure ErrorStr(const Message: string);
  586.     procedure HexToBinary(Stream: TStream);
  587.     function NextToken: Char;
  588.     function SourcePos: Longint;
  589.     function TokenComponentIdent: String;
  590.     function TokenFloat: Extended;
  591.     function TokenInt: Longint;
  592.     function TokenString: string;
  593.     function TokenSymbolIs(const S: string): Boolean;
  594.     property SourceLine: Integer;
  595.     property Token: Char;
  596.   end;
  597.  
  598. { TThread }
  599.  
  600.   EThread = class(Exception);
  601.  
  602.   TThreadMethod = procedure of object;
  603.   TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
  604.     tpTimeCritical);
  605.  
  606.   TThread = class
  607.   protected
  608.     procedure DoTerminate; virtual;
  609.     procedure Execute; virtual; abstract;
  610.     procedure Synchronize(Method: TThreadMethod);
  611.     property ReturnValue: Integer;
  612.     property Terminated: Boolean;
  613.   public
  614.     constructor Create(CreateSuspended: Boolean);
  615.     destructor Destroy; override;
  616.     procedure Resume;
  617.     procedure Suspend;
  618.     procedure Terminate;
  619.     function WaitFor: Integer;
  620.     property FreeOnTerminate: Boolean;
  621.     property Handle: THandle;
  622.     property Priority: TT;
  623.     property Suspended: Boolean;
  624.     property T;
  625.     property OnTerminate: TNotifyEvent;
  626.   end;
  627.  
  628. { TComponent class }
  629.  
  630.   TOperation = (opInsert, opRemove);
  631.   TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
  632.     csDesigning, csAncestor, csUpdating, csFixups);
  633.   TComponentStyle = set of (csInheritable, csCheckPropAvail);
  634.   TGetChildProc = procedure (Child: TComponent) of object;
  635.  
  636.   TComponentName = type string;
  637.  
  638.   IVCLComObject = interface
  639.     ['{E07892A0-F52F-11CF-BD2F-0020AF0E5B81}']
  640.     function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
  641.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
  642.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  643.       NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
  644.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  645.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
  646.     function SafeCallException(ExceptObject: TObject;
  647.       ExceptAddr: Pointer): Integer;
  648.     procedure FreeOnRelease;
  649.   end;
  650.  
  651.   TComponent = class(TPersistent)
  652.   protected
  653.     FComponentStyle: TComponentStyle;
  654.     procedure ChangeName(const NewName: TComponentName);
  655.     procedure DefineProperties(Filer: TFiler); override;
  656.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
  657.     function GetChildOwner: TComponent; dynamic;
  658.     function GetChildParent: TComponent; dynamic;
  659.     function GetNamePath: string; override;
  660.     function GetOwner: TPersistent; override;
  661.     procedure Loaded; virtual;
  662.     procedure Notification(AComponent: TComponent;
  663.       Operation: TOperation); virtual;
  664.     procedure ReadState(Reader: TReader); virtual;
  665.     procedure SetAncestor(Value: Boolean);
  666.     procedure SetDesigning(Value: Boolean);
  667.     procedure SetName(const NewName: TComponentName); virtual;
  668.     procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic;
  669.     procedure SetParentComponent(Value: TComponent); dynamic;
  670.     procedure Updating; dynamic;
  671.     procedure Updated; dynamic;
  672.     class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); dynamic;
  673.     procedure ValidateRename(AComponent: TComponent;
  674.       const CurName, NewName: string); virtual;
  675.     procedure ValidateContainer(AComponent: TComponent); dynamic;
  676.     procedure ValidateInsert(AComponent: TComponent); dynamic;
  677.     procedure WriteState(Writer: TWriter); virtual;
  678.     { IUnknown }
  679.     function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
  680.     function _AddRef: Integer; stdcall;
  681.     function _Release: Integer; stdcall;
  682.     { IDispatch }
  683.     function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
  684.     function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
  685.     function GetIDsOfNames(const IID: TGUID; Names: Pointer;
  686.       NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
  687.     function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
  688.       Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
  689.   public
  690.     constructor Create(AOwner: TComponent); virtual;
  691.     destructor Destroy; override;
  692.     procedure DestroyComponents;
  693.     procedure Destroying;
  694.     function FindComponent(const AName: string): TComponent;
  695.     procedure FreeNotification(AComponent: TComponent);
  696.     procedure FreeOnRelease;
  697.     function GetParentComponent: TComponent; dynamic;
  698.     function HasParent: Boolean; dynamic;
  699.     procedure InsertComponent(AComponent: TComponent);
  700.     procedure RemoveComponent(AComponent: TComponent);
  701.     function SafeCallException(ExceptObject: TObject;
  702.       ExceptAddr: Pointer): Integer; override;
  703.     property ComObject: IUnknown;
  704.     property Components[Index: Integer]: TComponent;
  705.     property ComponentCount: Integer;
  706.     property ComponentIndex: Integer;
  707.     property ComponentState: TComponentState;
  708.     property ComponentStyle: TComponentStyle;
  709.     property DesignInfo: Longint;
  710.     property Owner: TComponent;
  711.     property VCLComObject: Pointer;
  712.   published
  713.     property Name: TComponentName;
  714.     property Tag: Longint default 0;
  715.   end;
  716.  
  717. { TComponent class reference type }
  718.  
  719.   TComponentClass = class of TComponent;
  720.  
  721. { Component registration handlers }
  722.  
  723.   TActiveXRegType = (axrComponentOnly, axrIncludeDescendants);
  724.  
  725. var
  726.   RegisterComponentsProc: procedure(const Page: string;
  727.     ComponentClasses: array of TComponentClass) = nil;
  728.   RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass) = nil;
  729.   RegisterNonActiveXProc: procedure(ComponentClasses: array of TComponentClass;
  730.     AxRegType: TActiveXRegType) = nil;
  731.   CurrentGroup: Integer = -1; { Current design group }
  732.   CreateVCLComObjectProc: procedure(Component: TComponent) = nil;
  733.  
  734. { Point and rectangle constructors }
  735.  
  736. function Point(AX, AY: Integer): TPoint;
  737. function SmallPoint(AX, AY: SmallInt): TSmallPoint;
  738. function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
  739. function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
  740.  
  741. { Class registration routines }
  742.  
  743. procedure RegisterClass(AClass: TPersistentClass);
  744. procedure RegisterClasses(AClasses: array of TPersistentClass);
  745. procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
  746. procedure UnRegisterClass(AClass: TPersistentClass);
  747. procedure UnRegisterClasses(AClasses: array of TPersistentClass);
  748. procedure UnRegisterModuleClasses(Module: HMODULE);
  749. function FindClass(const ClassName: string): TPersistentClass;
  750. function GetClass(const ClassName: string): TPersistentClass;
  751.  
  752. { Component registration routines }
  753.  
  754. procedure RegisterComponents(const Page: string;
  755.   ComponentClasses: array of TComponentClass);
  756. procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
  757. procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
  758.   AxRegType: TActiveXRegType);
  759.  
  760.  
  761. { Object filing routines }
  762.  
  763. type
  764.   TIdentMapEntry = record
  765.     Value: Integer;
  766.     Name: String;
  767.   end;
  768.  
  769.   TIdentToInt = function(const Ident: string; var Int: Longint): Boolean;
  770.   TIntToIdent = function(Int: Longint; var Ident: string): Boolean;
  771.   TFindGlobalComponent = function(const Name: string): TComponent;
  772.  
  773. var
  774.   MainThreadID: THandle;
  775.   FindGlobalComponent: TFindGlobalComponent;
  776.  
  777. procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToInt: TIdentToInt;
  778.   IntToIdent: TIntToIdent);
  779. function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
  780. function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
  781.  
  782. function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
  783. function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
  784. function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
  785. function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
  786. function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
  787. procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
  788.  
  789. procedure GlobalFixupReferences;
  790. procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
  791. procedure GetFixupInstanceNames(Root: TComponent;
  792.   const ReferenceRootName: string; Names: TStrings);
  793. procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
  794.   NewRootName: string);
  795. procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
  796. procedure RemoveFixups(Instance: TPersistent);
  797.  
  798. procedure BeginGlobalLoading;
  799. procedure NotifyGlobalLoading;
  800. procedure EndGlobalLoading;
  801.  
  802. function CollectionsEqual(C1, C2: TCollection): Boolean;
  803.  
  804. { Object conversion routines }
  805.  
  806. procedure ObjectBinaryToText(Input, Output: TStream);
  807. procedure ObjectTextToBinary(Input, Output: TStream);
  808.  
  809. procedure ObjectResourceToText(Input, Output: TStream);
  810. procedure ObjectTextToResource(Input, Output: TStream);
  811.  
  812. { Utility routines }
  813.  
  814. function LineStart(Buffer, BufPos: PChar): PChar;
  815.  
  816. implementation
  817.