home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk14 / doc.pak / CLASSES.INT < prev    next >
Encoding:
Text File  |  1995-08-24  |  14.9 KB  |  442 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Delphi Visual Component Library                 }
  4. {                                                       }
  5. {       Copyright (c) 1995 Borland International        }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit Classes;
  10.  
  11. {$N+,P+,R-,S-,W-}
  12. {$C PRELOAD}
  13.  
  14. interface
  15.  
  16. uses SysUtils, WinTypes, WinProcs;
  17.  
  18. const
  19.  
  20. { Maximum TList size }
  21.  
  22.   MaxListSize = 65520 div SizeOf(Pointer);
  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. type
  35.  
  36. { Text alignment types }
  37.  
  38.   TAlignment = (taLeftJustify, taRightJustify, taCenter);
  39.   TLeftRight = taLeftJustify..taRightJustify;
  40.  
  41. { Types used by standard events }
  42.  
  43.   TShiftState = set of (ssShift, ssAlt, ssCtrl,
  44.     ssLeft, ssRight, ssMiddle, ssDouble);
  45.  
  46.   THelpContext = -MaxLongint..MaxLongint;
  47.  
  48. { Standard events }
  49.  
  50.   TNotifyEvent = procedure(Sender: TObject) of object;
  51.   THelpEvent = function (Command: Word; Data: Longint;
  52.     var CallHelp: Boolean): Boolean of object;
  53.   TGetStrProc = procedure(const S: string) of object;
  54.  
  55. { Exception classes }
  56.  
  57.   EStreamError = class(Exception);
  58.   EFCreateError = class(EStreamError);
  59.   EFOpenError = class(EStreamError);
  60.   EFilerError = class(EStreamError);
  61.   EReadError = class(EFilerError);
  62.   EWriteError = class(EFilerError);
  63.   EClassNotFound = class(EFilerError);
  64.   EMethodNotFound = class(EFilerError);
  65.   EInvalidImage = class(EFilerError);
  66.   EResNotFound = class(Exception);
  67.   EListError = class(Exception);
  68.   EStringListError = class(Exception);
  69.   EComponentError = class(Exception);
  70.   EParserError = class(Exception);
  71.  
  72. { Forward class declarations }
  73.  
  74.   TStream = class;
  75.   TFiler = class;
  76.   TReader = class;
  77.   TWriter = class;
  78.   TComponent = class;
  79.  
  80. { TList class }
  81.  
  82.   TList = class(TObject)
  83.   protected
  84.     procedure Error; virtual;
  85.     function Get(Index: Integer): Pointer;
  86.     procedure Grow; virtual;
  87.     procedure Put(Index: Integer; Item: Pointer);
  88.     procedure SetCapacity(NewCapacity: Integer);
  89.     procedure SetCount(NewCount: Integer);
  90.   public
  91.     destructor Destroy; override;
  92.     function Add(Item: Pointer): Integer;
  93.     procedure Clear;
  94.     procedure Delete(Index: Integer);
  95.     procedure Exchange(Index1, Index2: Integer);
  96.     function Expand: TList;
  97.     function First: Pointer;
  98.     function IndexOf(Item: Pointer): Integer;
  99.     procedure Insert(Index: Integer; Item: Pointer);
  100.     function Last: Pointer;
  101.     procedure Move(CurIndex, NewIndex: Integer);
  102.     function Remove(Item: Pointer): Integer;
  103.     procedure Pack;
  104.     property Capacity: Integer;
  105.     property Count: Integer;
  106.     property Items[Index: Integer]: Pointer; default;
  107.   end;
  108.  
  109. { TPersistent abstract class }
  110.  
  111. {$M+}
  112.  
  113.   TPersistent = class(TObject)
  114.   protected
  115.     procedure AssignTo(Dest: TPersistent); virtual;
  116.     procedure DefineProperties(Filer: TFiler); virtual;
  117.   public
  118.     procedure Assign(Source: TPersistent); virtual;
  119.   end;
  120.  
  121. {$M-}
  122.  
  123. { TPersistent class reference type }
  124.  
  125.   TPersistentClass = class of TPersistent;
  126.  
  127. { TStrings class }
  128.  
  129.   TStrings = class(TPersistent)
  130.   protected
  131.     procedure DefineProperties(Filer: TFiler); override;
  132.     function Get(Index: Integer): string; virtual; abstract;
  133.     function GetCount: Integer; virtual; abstract;
  134.     function GetObject(Index: Integer): TObject; virtual;
  135.     procedure Put(Index: Integer; const S: string); virtual;
  136.     procedure PutObject(Index: Integer; AObject: TObject); virtual;
  137.     procedure SetUpdateState(Updating: Boolean); virtual;
  138.   public
  139.     function Add(const S: string): Integer; virtual;
  140.     function AddObject(const S: string; AObject: TObject): Integer; virtual;
  141.     procedure AddStrings(Strings: TStrings); virtual;
  142.     procedure Assign(Source: TPersistent); override;
  143.     procedure BeginUpdate;
  144.     procedure Clear; virtual; abstract;
  145.     procedure Delete(Index: Integer); virtual; abstract;
  146.     procedure EndUpdate;
  147.     function Equals(Strings: TStrings): Boolean;
  148.     procedure Exchange(Index1, Index2: Integer); virtual;
  149.     function GetText: PChar; virtual;
  150.     function IndexOf(const S: string): Integer; virtual;
  151.     function IndexOfObject(AObject: TObject): Integer;
  152.     procedure Insert(Index: Integer; const S: string); virtual; abstract;
  153.     procedure InsertObject(Index: Integer; const S: string;
  154.       AObject: TObject);
  155.     procedure LoadFromFile(const FileName: string);
  156.     procedure LoadFromStream(Stream: TStream); virtual;
  157.     procedure Move(CurIndex, NewIndex: Integer); virtual;
  158.     procedure SaveToFile(const FileName: string);
  159.     procedure SaveToStream(Stream: TStream); virtual;
  160.     procedure SetText(Text: PChar); virtual;
  161.     property Count: Integer;
  162.     property Objects[Index: Integer]: TObject;
  163.     property Values[const Name: string]: string;
  164.     property Strings[Index: Integer]: string; default;
  165.   end;
  166.  
  167. { TStringList class }
  168.  
  169.   TDuplicates = (dupIgnore, dupAccept, dupError);
  170.  
  171.   TStringList = class(TStrings)
  172.   protected
  173.     procedure Changed; virtual;
  174.     procedure Changing; virtual;
  175.     function Get(Index: Integer): string; override;
  176.     function GetCount: Integer; override;
  177.     function GetObject(Index: Integer): TObject; override;
  178.     procedure Put(Index: Integer; const S: string); override;
  179.     procedure PutObject(Index: Integer; AObject: TObject); override;
  180.     procedure SetUpdateState(Updating: Boolean); override;
  181.   public
  182.     constructor Create;
  183.     destructor Destroy; override;
  184.     function Add(const S: string): Integer; override;
  185.     procedure Clear; override;
  186.     procedure Delete(Index: Integer); override;
  187.     procedure Exchange(Index1, Index2: Integer); override;
  188.     function Find(const S: string; var Index: Integer): Boolean; virtual;
  189.     function IndexOf(const S: string): Integer; override;
  190.     procedure Insert(Index: Integer; const S: string); override;
  191.     procedure Sort; virtual;
  192.     property Duplicates: TDuplicates;
  193.     property Sorted: Boolean;
  194.     property OnChange: TNotifyEvent;
  195.     property OnChanging: TNotifyEvent;
  196.   end;
  197.  
  198. { TStream abstract class }
  199.  
  200.   TStream = class(TObject)
  201.   public
  202.     function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
  203.     function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
  204.     function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
  205.     procedure ReadBuffer(var Buffer; Count: Longint);
  206.     procedure WriteBuffer(const Buffer; Count: Longint);
  207.     function CopyFrom(Source: TStream; Count: Longint): Longint;
  208.     function ReadComponent(Instance: TComponent): TComponent;
  209.     function ReadComponentRes(Instance: TComponent): TComponent;
  210.     procedure WriteComponent(Instance: TComponent);
  211.     procedure WriteComponentRes(const ResName: string; Instance: TComponent);
  212.     procedure ReadResHeader;
  213.     property Position: Longint;
  214.     property Size: Longint;
  215.   end;
  216.  
  217. { THandleStream class }
  218.  
  219.   THandleStream = class(TStream)
  220.   public
  221.     constructor Create(AHandle: Integer);
  222.     function Read(var Buffer; Count: Longint): Longint; override;
  223.     function Write(const Buffer; Count: Longint): Longint; override;
  224.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  225.     property Handle: Integer;
  226.   end;
  227.  
  228. { TFileStream class }
  229.  
  230.   TFileStream = class(THandleStream)
  231.   public
  232.     constructor Create(const FileName: string; Mode: Word);
  233.     destructor Destroy; override;
  234.   end;
  235.  
  236. { TMemoryStream }
  237.  
  238.   TMemoryStream = class(TStream)
  239.   public
  240.     destructor Destroy; override;
  241.     function Read(var Buffer; Count: Longint): Longint; override;
  242.     function Write(const Buffer; Count: Longint): Longint; override;
  243.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  244.     procedure LoadFromStream(Stream: TStream);
  245.     procedure LoadFromFile(const FileName: string);
  246.     procedure SaveToStream(Stream: TStream);
  247.     procedure SaveToFile(const FileName: string);
  248.     procedure SetSize(Size: Longint);
  249.     procedure Clear;
  250.     property Memory: Pointer;
  251.   end;
  252.  
  253. { TFiler }
  254.  
  255.   TReaderProc = procedure(Reader: TReader) of object;
  256.   TWriterProc = procedure(Writer: TWriter) of object;
  257.   TStreamProc = procedure(Stream: TStream) of object;
  258.  
  259.   TFiler = class(TObject)
  260.   public
  261.     constructor Create(Stream: TStream; BufSize: Cardinal);
  262.     destructor Destroy; override;
  263.     procedure DefineProperty(const Name: string;
  264.       ReadData: TReaderProc; WriteData: TWriterProc;
  265.       HasData: Boolean); virtual; abstract;
  266.     procedure DefineBinaryProperty(const Name: string;
  267.       ReadData, WriteData: TStreamProc;
  268.       HasData: Boolean); virtual; abstract;
  269.     property Root: TComponent;
  270.   end;
  271.  
  272. { TReader }
  273.  
  274.   TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
  275.     var Address: Pointer; var Error: Boolean) of object;
  276.   TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
  277.     var Name: string) of object;
  278.   TReadComponentsProc = procedure(Component: TComponent) of object;
  279.   TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
  280.  
  281.   TReader = class(TFiler)
  282.   protected
  283.     function Error(const Message: string): Boolean; virtual;
  284.     function FindMethod(Root: TComponent; const MethodName: string): Pointer; virtual;
  285.     procedure SetName(Component: TComponent; var Name: string); virtual;
  286.   public
  287.     destructor Destroy; override;
  288.     procedure DefineProperty(const Name: string;
  289.       ReadData: TReaderProc; WriteData: TWriterProc;
  290.       HasData: Boolean); override;
  291.     procedure DefineBinaryProperty(const Name: string;
  292.       ReadData, WriteData: TStreamProc;
  293.       HasData: Boolean); override;
  294.     function EndOfList: Boolean;
  295.     procedure Read(var Buf; Count: Longint);
  296.     function ReadBoolean: Boolean;
  297.     function ReadChar: Char;
  298.     procedure ReadComponents(AOwner, AParent: TComponent;
  299.       Proc: TReadComponentsProc);
  300.     function ReadFloat: Extended;
  301.     function ReadIdent: string;
  302.     function ReadInteger: Longint;
  303.     procedure ReadListBegin;
  304.     procedure ReadListEnd;
  305.     function ReadRootComponent(Root: TComponent): TComponent;
  306.     procedure ReadSignature;
  307.     function ReadStr: string;
  308.     function ReadString: string;
  309.     property Owner: TComponent;
  310.     property Parent: TComponent;
  311.     property OnError: TReaderError;
  312.     property OnFindMethod: TFindMethodEvent;
  313.     property OnSetName: TSetNameEvent;
  314.   end;
  315.  
  316. { TWriter }
  317.  
  318.   TWriter = class(TFiler)
  319.   public
  320.     destructor Destroy; override;
  321.     procedure DefineProperty(const Name: string;
  322.       ReadData: TReaderProc; WriteData: TWriterProc;
  323.       HasData: Boolean); override;
  324.     procedure DefineBinaryProperty(const Name: string;
  325.       ReadData, WriteData: TStreamProc;
  326.       HasData: Boolean); override;
  327.     procedure Write(const Buf; Count: Longint);
  328.     procedure WriteBoolean(Value: Boolean);
  329.     procedure WriteComponent(Component: TComponent);
  330.     procedure WriteChar(Value: Char);
  331.     procedure WriteFloat(Value: Extended);
  332.     procedure WriteIdent(const Ident: string);
  333.     procedure WriteInteger(Value: Longint);
  334.     procedure WriteListBegin;
  335.     procedure WriteListEnd;
  336.     procedure WriteRootComponent(Root: TComponent);
  337.     procedure WriteSignature;
  338.     procedure WriteStr(const Value: string);
  339.     procedure WriteString(const Value: string);
  340.   end;
  341.  
  342. { TComponent class }
  343.  
  344.   TOperation = (opInsert, opRemove);
  345.   TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
  346.     csDesigning);
  347.  
  348.   TComponentName = string[63];
  349.  
  350.   TComponent = class(TPersistent)
  351.   protected
  352.     procedure ChangeName(const NewName: TComponentName);
  353.     procedure DefineProperties(Filer: TFiler); override;
  354.     function HasParent: Boolean; virtual;
  355.     procedure Loaded; virtual;
  356.     procedure Notification(AComponent: TComponent;
  357.       Operation: TOperation); virtual;
  358.     procedure ReadState(Reader: TReader); virtual;
  359.     procedure SetDesigning(Value: Boolean);
  360.     procedure SetName(const NewName: TComponentName); virtual;
  361.     procedure ValidateRename(AComponent: TComponent;
  362.       const CurName, NewName: string); virtual;
  363.     procedure WriteComponents(Writer: TWriter); virtual;
  364.     procedure WriteState(Writer: TWriter); virtual;
  365.   public
  366.     constructor Create(AOwner: TComponent); virtual;
  367.     destructor Destroy; override;
  368.     procedure DestroyComponents;
  369.     procedure Destroying;
  370.     function FindComponent(const AName: string): TComponent;
  371.     procedure InsertComponent(AComponent: TComponent);
  372.     procedure RemoveComponent(AComponent: TComponent);
  373.     property Components[Index: Integer]: TComponent;
  374.     property ComponentCount: Integer;
  375.     property ComponentIndex: Integer;
  376.     property ComponentState: TComponentState;
  377.     property DesignInfo: Longint;
  378.     property Owner: TComponent;
  379.   published
  380.     property Name: TComponentName;
  381.     property Tag: Longint default 0;
  382.   end;
  383.  
  384. { TComponent class reference type }
  385.  
  386.   TComponentClass = class of TComponent;
  387.  
  388. { Point and rectangle constructors }
  389.  
  390. function Point(AX, AY: Integer): TPoint;
  391. function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
  392. function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
  393.  
  394. { Class registration routines }
  395.  
  396. procedure RegisterClass(AClass: TPersistentClass);
  397. procedure RegisterClasses(AClasses: array of TPersistentClass);
  398. procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
  399. procedure UnRegisterClass(AClass: TPersistentClass);
  400. procedure UnRegisterClasses(AClasses: array of TPersistentClass);
  401. function FindClass(const ClassName: string): TPersistentClass;
  402. function GetClass(const ClassName: string): TPersistentClass;
  403.  
  404. { Component registration routines }
  405.  
  406. procedure RegisterComponents(const Page: string;
  407.   ComponentClasses: array of TComponentClass);
  408. procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
  409.  
  410. { Object filing routines }
  411.  
  412. type
  413.   TIdentToInt = function (const Ident: string; var Int: Longint): Boolean;
  414.   TIntToIdent = function (Int: Longint; var Ident: string): Boolean;
  415.  
  416. procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToInt: TIdentToInt;
  417.   IntToIdent: TIntToIdent);
  418. function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
  419. function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
  420. procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
  421.  
  422. { Object conversion routines }
  423.  
  424. procedure ObjectBinaryToText(Input, Output: TStream);
  425. procedure ObjectTextToBinary(Input, Output: TStream);
  426.  
  427. procedure ObjectResourceToText(Input, Output: TStream);
  428. procedure ObjectTextToResource(Input, Output: TStream);
  429.  
  430. { StrItem management, shared by TStringList and TStringSparseList }
  431.  
  432. type
  433.   PStrItem = ^TStrItem;
  434.   TStrItem = record
  435.     FObject: TObject;
  436.     FString: string;
  437.   end;
  438.  
  439. procedure DisposeStrItem(P: PStrItem);
  440.  
  441. implementation
  442.