|
|
@@ -0,0 +1,1000 @@
|
|
|
+{
|
|
|
+ $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.
|
michael