home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Komputer 1997 May
/
Pcwk0597.iso
/
borland
/
cb
/
setup
/
cbuilder
/
data.z
/
CLASSES.INT
< prev
next >
Wrap
Text File
|
1997-02-28
|
23KB
|
652 lines
{*******************************************************}
{ }
{ Delphi Visual Component Library }
{ }
{ Copyright (c) 1995-1997 Borland International }
{ }
{*******************************************************}
unit Classes; // $Revision: 1.4 $
{$R-}
interface
uses SysUtils, Windows;
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);
{ 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)
protected
procedure Error; virtual;
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);
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;
property Count: Integer;
property Items[Index: Integer]: Pointer; default;
property List: PPointerList;
end;
{ TBits class }
TBits = class
public
destructor Destroy; override;
function OpenBit: Integer;
property Bits[Index: Integer]: Boolean; default;
property Size: Integer;
end;
{ TPersistent abstract class }
{$M+}
TPersistent = class(TObject)
protected
procedure AssignTo(Dest: TPersistent); virtual;
procedure DefineProperties(Filer: TFiler); virtual;
public
procedure Assign(Source: TPersistent); virtual;
end;
{$M-}
{ TPersistent class reference type }
TPersistentClass = class of TPersistent;
{ TCollection class }
TCollection = class;
TCollectionItem = class(TPersistent)
protected
procedure Changed(AllItems: Boolean);
procedure SetIndex(Value: Integer); virtual;
public
constructor Create(Collection: TCollection); virtual;
destructor Destroy; override;
property Collection: TCollection;
property Index: Integer;
end;
TCollectionItemClass = class of TCollectionItem;
TCollection = class(TPersistent)
protected
procedure Changed;
function GetItem(Index: Integer): TCollectionItem;
procedure SetItem(Index: Integer; Value: TCollectionItem);
procedure Update(Item: TCollectionItem); virtual;
public
constructor Create(ItemClass: TCollectionItemClass);
destructor Destroy; override;
function Add: TCollectionItem;
procedure Assign(Source: TPersistent); override;
procedure BeginUpdate;
procedure Clear;
procedure EndUpdate;
property Count: Integer;
property Items[Index: Integer]: TCollectionItem;
end;
{ TStrings class }
TStrings = class(TPersistent)
protected
procedure DefineProperties(Filer: TFiler); override;
function Get(Index: Integer): string; virtual; abstract;
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 SetTextStr(const Value: string); virtual;
procedure SetUpdateState(Updating: Boolean); virtual;
public
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 CommaText: string;
property Count: Integer;
property Names[Index: Integer]: string;
property Objects[Index: Integer]: TObject;
property Values[const Name: string]: string;
property Strings[Index: Integer]: string; default;
property Text: string;
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)
protected
procedure Changed; virtual;
procedure Changing; virtual;
function Get(Index: Integer): string; 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 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;
property Sorted: Boolean;
property OnChange: TNotifyEvent;
property OnChanging: TNotifyEvent;
end;
{ TStream abstract class }
TStream = class(TObject)
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;
property Size: Longint;
end;
{ THandleStream class }
THandleStream = class(TStream)
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;
end;
{ TFileStream class }
TFileStream = class(THandleStream)
public
constructor Create(const FileName: string; Mode: Word);
destructor Destroy; override;
end;
{ TCustomMemoryStream abstract class }
TCustomMemoryStream = class(TStream)
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;
end;
{ TMemoryStream }
TMemoryStream = class(TCustomMemoryStream)
protected
function Realloc(var NewCapacity: Longint): Pointer; virtual;
property Capacity: Longint;
public
destructor Destroy; override;
procedure Clear;
procedure LoadFromStream(Stream: TStream);
procedure LoadFromFile(const FileName: string);
procedure SetSize(NewSize: Longint);
function Write(const Buffer; Count: Longint): Longint; override;
end;
{ TResourceStream }
TResourceStream = class(TCustomMemoryStream)
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;
{ 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)
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;
property Ancestor: TPersistent;
property IgnoreChildren: Boolean;
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;
TReadComponentsProc = procedure(Component: TComponent) of object;
TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
TReader = class(TFiler)
protected
function Error(const Message: string): Boolean; virtual;
function FindMethod(Root: TComponent; const MethodName: string): Pointer; virtual;
function NextValue: TValueType;
procedure SetName(Component: TComponent; var Name: string); 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;
procedure Read(var Buf; Count: Longint);
function ReadBoolean: Boolean;
function ReadChar: Char;
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;
property Owner: TComponent;
property Parent: TComponent;
property Position: Longint;
property OnError: TReaderError;
property OnFindMethod: TFindMethodEvent;
property OnSetName: TSetNameEvent;
end;
{ TWriter }
TWriter = class(TFiler)
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;
property RootAncestor: TComponent;
end;
{ TParser }
TParser = class(TObject)
public
constructor Create(Stream: TStream);
destructor Destroy; override;
procedure CheckToken(T: Char);
procedure CheckTokenSymbol(const S: string);
procedure Error(Ident: Integer);
procedure ErrorFmt(Ident: Integer; 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;
property Token: Char;
end;
{ TThread }
EThread = class(Exception);
TThreadMethod = procedure of object;
TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
tpTimeCritical);
TThread = class
protected
procedure DoTerminate; virtual;
procedure Execute; virtual; abstract;
procedure Synchronize(Method: TThreadMethod);
property ReturnValue: Integer;
property Terminated: Boolean;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Resume;
procedure Suspend;
procedure Terminate;
function WaitFor: Integer;
property FreeOnTerminate: Boolean;
property Handle: THandle;
property Priority: TT;
property Suspended: Boolean;
property T;
property OnTerminate: TNotifyEvent;
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;
TComponent = class(TPersistent)
protected
FComponentStyle: TComponentStyle;
procedure ChangeName(const NewName: TComponentName);
procedure DefineProperties(Filer: TFiler); override;
procedure GetChildren(Proc: TGetChildProc); dynamic;
function GetChildOwner: TComponent; dynamic;
function GetChildParent: TComponent; dynamic;
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;
procedure ValidateRename(AComponent: TComponent;
const CurName, NewName: string); virtual;
procedure WriteState(Writer: TWriter); virtual;
public
constructor Create(AOwner: TComponent); virtual;
destructor Destroy; override;
procedure DestroyComponents;
procedure Destroying;
function FindComponent(const AName: string): TComponent;
function GetParentComponent: TComponent; dynamic;
function HasParent: Boolean; dynamic;
procedure FreeNotification(AComponent: TComponent);
procedure InsertComponent(AComponent: TComponent);
procedure RemoveComponent(AComponent: TComponent);
property Components[Index: Integer]: TComponent;
property ComponentCount: Integer;
property ComponentIndex: Integer;
property ComponentState: TComponentState;
property ComponentStyle: TComponentStyle;
property DesignInfo: Longint;
property Owner: TComponent;
published
property Name: TComponentName;
property Tag: Longint default 0;
end;
{ TComponent class reference type }
TComponentClass = class of TComponent;
{ Component registration handlers }
const
RegisterComponentsProc: procedure(const Page: string;
ComponentClasses: array of TComponentClass) = nil;
RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass) = 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);
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);
{ Object filing routines }
type
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 InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
function ReadComponentRes(const ResName: string; Instance: TComponent): 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 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