home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Vcl / DB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  267.9 KB  |  10,178 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       Core Database                                   }
  6. {                                                       }
  7. {       Copyright (c) 1995,99 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Db;
  12.  
  13. {$R-,T-,H+,X+}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Classes, Graphics;
  18.  
  19. type
  20.  
  21. { Forward declarations }
  22.  
  23.   TField = class;
  24.   TObjectField = class;
  25.   TDataLink = class;
  26.   TDataSource = class;
  27.   TDataSet = class;
  28.   TFieldDefs = class;
  29.   TIndexDefs = class;
  30.  
  31. { Exception classes }
  32.  
  33.   EDatabaseError = class(Exception);
  34.  
  35. { EUpdateError }
  36.  
  37.   EUpdateError = class(EDatabaseError)
  38.   private
  39.     FErrorCode: Integer;
  40.     FPreviousError: Integer;
  41.     FContext: string;
  42.     FOriginalException: Exception;
  43.   public
  44.     constructor Create(NativeError, Context: string;
  45.       ErrCode, PrevError: Integer; E: Exception);
  46.     destructor Destroy; override;
  47.     property Context: string read FContext;
  48.     property ErrorCode: Integer read FErrorCode;
  49.     property PreviousError: Integer read FPreviousError;
  50.     property OriginalException: Exception read FOriginalException;
  51.   end;
  52.  
  53. { Misc DataSet types }
  54.  
  55.   TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  56.     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  57.     ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
  58.     ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
  59.     ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,
  60.     ftVariant, ftInterface, ftIDispatch, ftGuid);
  61.  
  62.   TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
  63.     dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue, dsBlockRead,
  64.     dsInternalCalc, dsOpening);
  65.  
  66.   TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
  67.     deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
  68.     deCheckBrowseMode, dePropertyChange, deFieldListChange,
  69.     deFocusControl, deParentScroll, deConnectChange);
  70.  
  71.   TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
  72.   TUpdateStatusSet = set of TUpdateStatus;
  73.  
  74.   TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
  75.  
  76.   TUpdateRecordTypes = set of (rtModified, rtInserted, rtDeleted, rtUnmodified);
  77.  
  78.   TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);
  79.  
  80.   TUpdateKind = (ukModify, ukInsert, ukDelete);
  81.  
  82.   TUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  83.     UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;
  84.  
  85.   TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
  86.     var UpdateAction: TUpdateAction) of object;
  87.  
  88. { TCustomConnection }
  89.  
  90.   TLoginEvent = procedure(Sender: TObject; Username, Password: string) of object;
  91.   TConnectChangeEvent = procedure(Sender: TObject; Connecting: Boolean) of object;
  92.  
  93.   TCustomConnection = class(TComponent)
  94.   private
  95.     FClients: TList;
  96.     FDataSets: TList;
  97.     FConnectEvents: TList;
  98.     FLoginPrompt: Boolean;
  99.     FStreamedConnected: Boolean;
  100.     FAfterConnect: TNotifyEvent;
  101.     FAfterDisconnect: TNotifyEvent;
  102.     FBeforeConnect: TNotifyEvent;
  103.     FBeforeDisconnect: TNotifyEvent;
  104.     FOnLogin: TLoginEvent;
  105.   protected
  106.     procedure DoConnect; virtual;
  107.     procedure DoDisconnect; virtual;
  108.     function GetConnected: Boolean; virtual;
  109.     function GetDataSet(Index: Integer): TDataSet; virtual;
  110.     function GetDataSetCount: Integer; virtual;
  111.     procedure Loaded; override;
  112.     procedure RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil); virtual;
  113.     procedure SetConnected(Value: Boolean); virtual;
  114.     procedure SendConnectEvent(Connecting: Boolean);
  115.     property StreamedConnected: Boolean read FStreamedConnected write FStreamedConnected;
  116.     procedure UnRegisterClient(Client: TObject); virtual;
  117.   public
  118.     constructor Create(AOwner: TComponent); override;
  119.     destructor Destroy; override;
  120.     procedure Open; overload;
  121.     procedure Close;
  122.     property Connected: Boolean read GetConnected write SetConnected default False;
  123.     property DataSets[Index: Integer]: TDataSet read GetDataSet;
  124.     property DataSetCount: Integer read GetDataSetCount;
  125.     property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt default False;
  126.     property AfterConnect: TNotifyEvent read FAfterConnect write FAfterConnect;
  127.     property BeforeConnect: TNotifyEvent read FBeforeConnect write FBeforeConnect;
  128.     property AfterDisconnect: TNotifyEvent read FAfterDisconnect write FAfterDisconnect;
  129.     property BeforeDisconnect: TNotifyEvent read FBeforeDisconnect write FBeforeDisconnect;
  130.     property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
  131.   end;
  132.  
  133. { TNamedItem }
  134.  
  135.   TNamedItem = class(TCollectionItem)
  136.   private
  137.     FName: string;
  138.   protected
  139.     function GetDisplayName: string; override;
  140.     procedure SetDisplayName(const Value: string); override;
  141.   published
  142.     property Name: string read FName write SetDisplayName;
  143.   end;
  144.  
  145. { TDefCollection }
  146.  
  147.   TDefUpdateMethod = procedure of object;
  148.  
  149.   TDefCollection = class(TOwnedCollection)
  150.   private
  151.     FDataSet: TDataSet;
  152.     FUpdated: Boolean;
  153.     FOnUpdate: TNotifyEvent;
  154.     FInternalUpdateCount: Integer;
  155.   protected
  156.     procedure DoUpdate(Sender: TObject);
  157.     procedure SetItemName(AItem: TCollectionItem); override;
  158.     procedure Update(AItem: TCollectionItem); override;
  159.     procedure UpdateDefs(AMethod: TDefUpdateMethod);
  160.     property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
  161.   public
  162.     constructor Create(ADataSet: TDataSet; AOwner: TPersistent;
  163.       AClass: TCollectionItemClass);
  164.     function Find(const AName: string): TNamedItem;
  165.     procedure GetItemNames(List: TStrings);
  166.     function IndexOf(const AName: string): Integer;
  167.     property DataSet: TDataSet read FDataSet;
  168.     property Updated: Boolean read FUpdated write FUpdated;
  169.   end;
  170.  
  171. { TFieldDef }
  172.  
  173.   TFieldClass = class of TField;
  174.  
  175.   TFieldAttribute = (faHiddenCol, faReadonly, faRequired, faLink, faUnNamed, faFixed);
  176.   TFieldAttributes = set of TFieldAttribute;
  177.  
  178.   TFieldDef = class(TNamedItem)
  179.   private
  180.     FChildDefs: TFieldDefs;
  181.     FPrecision: Integer;
  182.     FFieldNo: Integer;
  183.     FSize: Integer;
  184.     FInternalCalcField: Boolean;
  185.     FDataType: TFieldType;
  186.     FAttributes: TFieldAttributes;
  187.     function CreateFieldComponent(Owner: TComponent;
  188.       ParentField: TObjectField = nil; FieldName: string = ''): TField;
  189.     function GetChildDefs: TFieldDefs;
  190.     function GetFieldClass: TFieldClass;
  191.     function GetFieldNo: Integer;
  192.     function GetParentDef: TFieldDef;
  193.     function GetRequired: Boolean;
  194.     function GetSize: Integer;
  195.     procedure ReadRequired(Reader: TReader);
  196.     procedure SetAttributes(Value: TFieldAttributes);
  197.     procedure SetChildDefs(Value: TFieldDefs);
  198.     procedure SetDataType(Value: TFieldType);
  199.     procedure SetPrecision(Value: Integer);
  200.     procedure SetRequired(Value: Boolean);
  201.     procedure SetSize(Value: Integer);
  202.   protected
  203.     procedure DefineProperties(Filer: TFiler); override;
  204.   public
  205.     constructor Create(Owner: TFieldDefs; const Name: string;
  206.       DataType: TFieldType; Size: Integer; Required: Boolean; FieldNo: Integer); reintroduce; overload;
  207.     destructor Destroy; override;
  208.     function AddChild: TFieldDef;
  209.     procedure Assign(Source: TPersistent); override;
  210.     function CreateField(Owner: TComponent; ParentField: TObjectField = nil;
  211.       const FieldName: string = ''; CreateChildren: Boolean = True): TField;
  212.     function HasChildDefs: Boolean;
  213.     property FieldClass: TFieldClass read GetFieldClass;
  214.     property FieldNo: Integer read GetFieldNo write FFieldNo stored False;
  215.     property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
  216.     property ParentDef: TFieldDef read GetParentDef;
  217.     property Required: Boolean read GetRequired write SetRequired;
  218.   published
  219.     property Attributes: TFieldAttributes read FAttributes write SetAttributes default [];
  220.     property ChildDefs: TFieldDefs read GetChildDefs write SetChildDefs stored HasChildDefs;
  221.     property DataType: TFieldType read FDataType write SetDataType default ftUnknown;
  222.     property Precision: Integer read FPrecision write SetPrecision default 0;
  223.     property Size: Integer read GetSize write SetSize default 0;
  224.   end;
  225.  
  226. { TFieldDefs }
  227.  
  228.   TFieldDefs = class(TDefCollection)
  229.   private
  230.     FParentDef: TFieldDef;
  231.     FHiddenFields: Boolean;
  232.     function GetFieldDef(Index: Integer): TFieldDef;
  233.     procedure SetFieldDef(Index: Integer; Value: TFieldDef);
  234.     procedure SetHiddenFields(Value: Boolean);
  235.   protected
  236.     procedure FieldDefUpdate(Sender: TObject);
  237.     procedure ChildDefUpdate(Sender: TObject);
  238.     procedure SetItemName(AItem: TCollectionItem); override;
  239.   public
  240.     constructor Create(AOwner: TPersistent);
  241.     function AddFieldDef: TFieldDef;
  242.     function Find(const Name: string): TFieldDef;
  243.     procedure Update; reintroduce;
  244.     { procedure Add kept for compatability - AddFieldDef is the better way }
  245.     procedure Add(const Name: string; DataType: TFieldType; Size: Integer = 0;
  246.       Required: Boolean = False);
  247.     property HiddenFields: Boolean read FHiddenFields write SetHiddenFields;
  248.     property Items[Index: Integer]: TFieldDef read GetFieldDef write SetFieldDef; default;
  249.     property ParentDef: TFieldDef read FParentDef;
  250.   end;
  251.  
  252. { TIndexDef }
  253.  
  254.   TIndexOption = (ixPrimary, ixUnique, ixDescending, ixCaseInsensitive,
  255.     ixExpression, ixNonMaintained);
  256.   TIndexOptions = set of TIndexOption;
  257.  
  258.   TIndexDef = class(TNamedItem)
  259.   private
  260.     FSource: string;
  261.     FFieldExpression: string;
  262.     FDescFields: string;
  263.     FCaseInsFields: string;
  264.     FOptions: TIndexOptions;
  265.     FGroupingLevel: Integer;
  266.     function GetExpression: string;
  267.     function GetFields: string;
  268.     procedure SetDescFields(const Value: string);
  269.     procedure SetCaseInsFields(const Value: string);
  270.     procedure SetExpression(const Value: string);
  271.     procedure SetFields(const Value: string);
  272.     procedure SetOptions(Value: TIndexOptions);
  273.     procedure SetSource(const Value: string);
  274.   protected
  275.     function GetDisplayName: string; override;
  276.   public
  277.     constructor Create(Owner: TIndexDefs; const Name, Fields: string;
  278.       Options: TIndexOptions); reintroduce; overload;
  279.     procedure Assign(ASource: TPersistent); override;
  280.     property FieldExpression: string read FFieldExpression;
  281.   published
  282.     property CaseInsFields: string read FCaseInsFields write SetCaseInsFields;
  283.     property DescFields: string read FDescFields write SetDescFields;
  284.     property Expression: string read GetExpression write SetExpression;
  285.     property Fields: string read GetFields write SetFields;
  286.     property Options: TIndexOptions read FOptions write SetOptions default [];
  287.     property Source: string read FSource write SetSource;
  288.     property GroupingLevel: Integer read FGroupingLevel write FGroupingLevel default 0;
  289.   end;
  290.  
  291. { TIndexDefs }
  292.  
  293.   TIndexDefs = class(TDefCollection)
  294.   private
  295.     function GetIndexDef(Index: Integer): TIndexDef;
  296.     procedure SetIndexDef(Index: Integer; Value: TIndexDef);
  297.   public
  298.     constructor Create(ADataSet: TDataSet);
  299.     function AddIndexDef: TIndexDef;
  300.     function Find(const Name: string): TIndexDef;
  301.     procedure Update; reintroduce;
  302.     function FindIndexForFields(const Fields: string): TIndexDef;
  303.     function GetIndexForFields(const Fields: string;
  304.       CaseInsensitive: Boolean): TIndexDef;
  305.     { procedure Add kept for compatability - AddIndexDef is the better way }
  306.     procedure Add(const Name, Fields: string; Options: TIndexOptions);
  307.     property Items[Index: Integer]: TIndexDef read GetIndexDef write SetIndexDef; default;
  308.   end;
  309.  
  310. { TFlatList }
  311.  
  312.   TFlatList = class(TStringList)
  313.   private
  314.     FDataSet: TDataSet;
  315.     FLocked: Boolean;
  316.     FUpdated: Boolean;
  317.   protected
  318.     procedure ListChanging(Sender: TObject);
  319.     function FindItem(const Name: string; MustExist: Boolean): TObject;
  320.     function GetCount: Integer; override;
  321.     function GetUpdated: Boolean; virtual;
  322.     procedure UpdateList; virtual; abstract;
  323.     property Updated: Boolean read GetUpdated write FUpdated;
  324.     property Locked: Boolean read FLocked write FLocked;
  325.   public
  326.     constructor Create(ADataSet: TDataSet);
  327.     procedure Update;
  328.     property DataSet: TDataSet read FDataSet;
  329.   end;
  330.  
  331. { TFieldDefList }
  332.  
  333.   TFieldDefList = class(TFlatList)
  334.   private
  335.     function GetFieldDef(Index: Integer): TFieldDef;
  336.   protected
  337.     function GetUpdated: Boolean; override;
  338.     procedure UpdateList; override;
  339.   public
  340.     function FieldByName(const Name: string): TFieldDef;
  341.     function Find(const Name: string): TFieldDef; reintroduce;
  342.     property FieldDefs[Index: Integer]: TFieldDef read GetFieldDef; default;
  343.   end;
  344.  
  345. { TFieldList }
  346.  
  347.   TFieldList = class(TFlatList)
  348.   private
  349.     function GetField(Index: Integer): TField;
  350.   protected
  351.     procedure UpdateList; override;
  352.   public
  353.     function FieldByName(const Name: string): TField;
  354.     function Find(const Name: string): TField; reintroduce;
  355.     property Fields[Index: Integer]: TField read GetField; default;
  356.   end;
  357.  
  358. { TFields }
  359.  
  360.   TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc, fkAggregate);
  361.   TFieldKinds = set of TFieldKind;
  362.  
  363.   TFields = class(TObject)
  364.   private
  365.     FList: TList;
  366.     FDataSet: TDataSet;
  367.     FSparseFields: Integer;
  368.     FOnChange: TNotifyEvent;
  369.     FValidFieldKinds: TFieldKinds;
  370.   protected
  371.     procedure Changed;
  372.     procedure CheckFieldKind(FieldKind: TFieldKind; Field: TField);
  373.     function GetCount: Integer;
  374.     function GetField(Index: Integer): TField;
  375.     procedure SetField(Index: Integer; Value: TField);
  376.     procedure SetFieldIndex(Field: TField; Value: Integer);
  377.     property SparseFields: Integer read FSparseFields write FSparseFields;
  378.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  379.     property ValidFieldKinds: TFieldKinds read FValidFieldKinds write FValidFieldKinds;
  380.   public
  381.     constructor Create(ADataSet: TDataSet);
  382.     destructor Destroy; override;
  383.     procedure Add(Field: TField);
  384.     procedure CheckFieldName(const FieldName: string);
  385.     procedure CheckFieldNames(const FieldNames: string);
  386.     procedure Clear;
  387.     function FindField(const FieldName: string): TField;
  388.     function FieldByName(const FieldName: string): TField;
  389.     function FieldByNumber(FieldNo: Integer): TField;
  390.     procedure GetFieldNames(List: TStrings);
  391.     function IndexOf(Field: TField): Integer;
  392.     procedure Remove(Field: TField);
  393.     property Count: Integer read GetCount;
  394.     property DataSet: TDataSet read FDataSet;
  395.     property Fields[Index: Integer]: TField read GetField write SetField; default;
  396.   end;
  397.  
  398. { TField }
  399.  
  400.   TProviderFlag = (pfInUpdate, pfInWhere, pfInKey, pfHidden);
  401.   TProviderFlags = set of TProviderFlag;
  402.  
  403.   TFieldNotifyEvent = procedure(Sender: TField) of object;
  404.   TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
  405.     DisplayText: Boolean) of object;
  406.   TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  407.   TFieldRef = ^TField;
  408.   TFieldChars = set of Char;
  409.   TAutoRefreshFlag = (arNone, arAutoInc, arDefault);
  410.  
  411.   PLookupListEntry = ^TLookupListEntry;
  412.   TLookupListEntry = record
  413.     Key: Variant;
  414.     Value: Variant;
  415.   end;
  416.  
  417.   TLookupList = class(TObject)
  418.   private
  419.     FList: TList;
  420.   public
  421.     constructor Create;
  422.     destructor Destroy; override;
  423.     procedure Add(const AKey, AValue: Variant);
  424.     procedure Clear;
  425.     function ValueOfKey(const AKey: Variant): Variant;
  426.   end;
  427.  
  428.   TField = class(TComponent)
  429.   private
  430.     FAutoGenerateValue: TAutoRefreshFlag;
  431.     FDataSet: TDataSet;
  432.     FFieldName: string;
  433.     FFields: TFields;
  434.     FDataType: TFieldType;
  435.     FReadOnly: Boolean;
  436.     FFieldKind: TFieldKind;
  437.     FAlignment: TAlignment;
  438.     FVisible: Boolean;
  439.     FRequired: Boolean;
  440.     FValidating: Boolean;
  441.     FSize: Integer;
  442.     FOffset: Integer;
  443.     FFieldNo: Integer;
  444.     FDisplayWidth: Integer;
  445.     FDisplayLabel: string;
  446.     FEditMask: string;
  447.     FValueBuffer: Pointer;
  448.     FLookupDataSet: TDataSet;
  449.     FKeyFields: string;
  450.     FLookupKeyFields: string;
  451.     FLookupResultField: string;
  452.     FLookupCache: Boolean;
  453.     FLookupList: TLookupList;
  454.     FAttributeSet: string;
  455.     FCustomConstraint: string;
  456.     FImportedConstraint: string;
  457.     FConstraintErrorMessage: string;
  458.     FDefaultExpression: string;
  459.     FOrigin: string;
  460.     FProviderFlags: TProviderFlags;
  461.     FParentField: TObjectField;
  462.     FValidChars: TFieldChars;
  463.     FOnChange: TFieldNotifyEvent;
  464.     FOnValidate: TFieldNotifyEvent;
  465.     FOnGetText: TFieldGetTextEvent;
  466.     FOnSetText: TFieldSetTextEvent;
  467.     procedure CalcLookupValue;
  468.     function GetCalculated: Boolean;
  469.     function GetDisplayLabel: string;
  470.     function GetDisplayName: string;
  471.     function GetDisplayText: string;
  472.     function GetDisplayWidth: Integer;
  473.     function GetEditText: string;
  474.     function GetFullName: string;
  475.     function GetIndex: Integer;
  476.     function GetIsIndexField: Boolean;
  477.     function GetLookup: Boolean;
  478.     function GetLookupList: TLookupList;
  479.     function GetCurValue: Variant;
  480.     function GetNewValue: Variant;
  481.     function GetOldValue: Variant;
  482.     function IsDisplayLabelStored: Boolean;
  483.     function IsDisplayWidthStored: Boolean;
  484.     procedure ReadAttributeSet(Reader: TReader);
  485.     procedure ReadCalculated(Reader: TReader);
  486.     procedure ReadLookup(Reader: TReader);
  487.     procedure SetAlignment(Value: TAlignment);
  488.     procedure SetCalculated(Value: Boolean);
  489.     procedure SetDisplayLabel(Value: string);
  490.     procedure SetDisplayWidth(Value: Integer);
  491.     procedure SetEditMask(const Value: string);
  492.     procedure SetEditText(const Value: string);
  493.     procedure SetFieldName(const Value: string);
  494.     procedure SetIndex(Value: Integer);
  495.     procedure SetLookup(Value: Boolean);
  496.     procedure SetLookupDataSet(Value: TDataSet);
  497.     procedure SetLookupKeyFields(const Value: string);
  498.     procedure SetLookupResultField(const Value: string);
  499.     procedure SetKeyFields(const Value: string);
  500.     procedure SetLookupCache(const Value: Boolean);
  501.     procedure SetNewValue(const Value: Variant);
  502.     procedure SetReadOnly(const Value: Boolean);
  503.     procedure SetVisible(Value: Boolean);
  504.     procedure ValidateLookupInfo(All: Boolean);
  505.     procedure WriteAttributeSet(Writer: TWriter);
  506.     procedure WriteCalculated(Writer: TWriter);
  507.     procedure WriteLookup(Writer: TWriter);
  508.   protected
  509.     function AccessError(const TypeName: string): EDatabaseError; dynamic;
  510.     procedure Bind(Binding: Boolean); virtual;
  511.     procedure CheckInactive;
  512.     class procedure CheckTypeSize(Value: Integer); virtual;
  513.     procedure Change; virtual;
  514.     procedure DataChanged;
  515.     procedure DefineProperties(Filer: TFiler); override;
  516.     procedure FreeBuffers; virtual;
  517.     function GetAsBoolean: Boolean; virtual;
  518.     function GetAsByteArray: Variant; virtual;
  519.     function GetAsCurrency: Currency; virtual;
  520.     function GetAsDateTime: TDateTime; virtual;
  521.     function GetAsFloat: Double; virtual;
  522.     function GetAsInteger: Longint; virtual;
  523.     function GetAsString: string; virtual;
  524.     function GetAsVariant: Variant; virtual;
  525.     function GetCanModify: Boolean; virtual;
  526.     function GetClassDesc: string; virtual;
  527.     function GetDataSize: Integer; virtual;
  528.     procedure CopyData(Source, Dest: Pointer); virtual;
  529.     function GetDefaultWidth: Integer; virtual;
  530.     function GetFieldNo: Integer; virtual;
  531.     function GetHasConstraints: Boolean; virtual;
  532.     function GetIsNull: Boolean; virtual;
  533.     function GetSize: Integer; virtual;
  534.     procedure GetText(var Text: string; DisplayText: Boolean); virtual;
  535.     procedure Notification(AComponent: TComponent;
  536.       Operation: TOperation); override;
  537.     procedure PropertyChanged(LayoutAffected: Boolean);
  538.     procedure ReadState(Reader: TReader); override;
  539.     procedure SetAsBoolean(Value: Boolean); virtual;
  540.     procedure SetAsByteArray(const Value: Variant); virtual;
  541.     procedure SetAsCurrency(Value: Currency); virtual;
  542.     procedure SetAsDateTime(Value: TDateTime); virtual;
  543.     procedure SetAsFloat(Value: Double); virtual;
  544.     procedure SetAsInteger(Value: Longint); virtual;
  545.     procedure SetAsString(const Value: string); virtual;
  546.     procedure SetAsVariant(const Value: Variant); virtual;
  547.     procedure SetDataSet(ADataSet: TDataSet); virtual;
  548.     procedure SetDataType(Value: TFieldType);
  549.     procedure SetFieldKind(Value: TFieldKind); virtual;
  550.     procedure SetParentComponent(AParent: TComponent); override;
  551.     procedure SetParentField(AField: TObjectField); virtual;
  552.     procedure SetSize(Value: Integer); virtual;
  553.     procedure SetText(const Value: string); virtual;
  554.     procedure SetVarValue(const Value: Variant); virtual;
  555.     procedure SetAutoGenerateValue(const Value: TAutoRefreshFlag);
  556.   public
  557.     constructor Create(AOwner: TComponent); override;
  558.     destructor Destroy; override;
  559.     procedure Assign(Source: TPersistent); override;
  560.     procedure AssignValue(const Value: TVarRec);
  561.     procedure Clear; virtual;
  562.     procedure FocusControl;
  563.     function GetData(Buffer: Pointer; NativeFormat: Boolean = True): Boolean;
  564.     function GetParentComponent: TComponent; override;
  565.     function HasParent: Boolean; override;
  566.     class function IsBlob: Boolean; virtual;
  567.     function IsValidChar(InputChar: Char): Boolean; virtual;
  568.     procedure RefreshLookupList;
  569.     procedure SetData(Buffer: Pointer; NativeFormat: Boolean = True);
  570.     procedure SetFieldType(Value: TFieldType); virtual;
  571.     procedure Validate(Buffer: Pointer);
  572.     property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  573.     property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
  574.     property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
  575.     property AsFloat: Double read GetAsFloat write SetAsFloat;
  576.     property AsInteger: Longint read GetAsInteger write SetAsInteger;
  577.     property AsString: string read GetAsString write SetAsString;
  578.     property AsVariant: Variant read GetAsVariant write SetAsVariant;
  579.     property AttributeSet: string read FAttributeSet write FAttributeSet;
  580.     property Calculated: Boolean read GetCalculated write SetCalculated default False;
  581.     property CanModify: Boolean read GetCanModify;
  582.     property CurValue: Variant read GetCurValue;
  583.     property DataSet: TDataSet read FDataSet write SetDataSet stored False;
  584.     property DataSize: Integer read GetDataSize;
  585.     property DataType: TFieldType read FDataType;
  586.     property DisplayName: string read GetDisplayName;
  587.     property DisplayText: string read GetDisplayText;
  588.     property EditMask: string read FEditMask write SetEditMask;
  589.     property EditMaskPtr: string read FEditMask;
  590.     property FieldNo: Integer read GetFieldNo;
  591.     property FullName: string read GetFullName;
  592.     property IsIndexField: Boolean read GetIsIndexField;
  593.     property IsNull: Boolean read GetIsNull;
  594.     property Lookup: Boolean read GetLookup write SetLookup;
  595.     property LookupList: TLookupList read GetLookupList;
  596.     property NewValue: Variant read GetNewValue write SetNewValue;
  597.     property Offset: Integer read FOffset;
  598.     property OldValue: Variant read GetOldValue;
  599.     property ParentField: TObjectField read FParentField write SetParentField;
  600.     property Size: Integer read GetSize write SetSize;
  601.     property Text: string read GetEditText write SetEditText;
  602.     property ValidChars: TFieldChars read FValidChars write FValidChars;
  603.     property Value: Variant read GetAsVariant write SetAsVariant;
  604.   published
  605.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  606.     property AutoGenerateValue: TAutoRefreshFlag read FAutoGenerateValue write SetAutoGenerateValue default arNone;
  607.     property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  608.     property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
  609.     property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
  610.     property DisplayLabel: string read GetDisplayLabel write SetDisplayLabel
  611.       stored IsDisplayLabelStored;
  612.     property DisplayWidth: Integer read GetDisplayWidth write SetDisplayWidth
  613.       stored IsDisplayWidthStored;
  614.     property FieldKind: TFieldKind read FFieldKind write SetFieldKind default fkData;
  615.     property FieldName: string read FFieldName write SetFieldName;
  616.     property HasConstraints: Boolean read GetHasConstraints;
  617.     property Index: Integer read GetIndex write SetIndex stored False;
  618.     property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  619.     property LookupDataSet: TDataSet read FLookupDataSet write SetLookupDataSet;
  620.     property LookupKeyFields: string read FLookupKeyFields write SetLookupKeyFields;
  621.     property LookupResultField: string read FLookupResultField write SetLookupResultField;
  622.     property KeyFields: string read FKeyFields write SetKeyFields;
  623.     property LookupCache: Boolean read FLookupCache write SetLookupCache default False;
  624.     property Origin: string read FOrigin write FOrigin;
  625.     property ProviderFlags: TProviderFlags read FProviderFlags write FProviderFlags default [pfInWhere, pfInUpdate];
  626.     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  627.     property Required: Boolean read FRequired write FRequired default False;
  628.     property Visible: Boolean read FVisible write SetVisible default True;
  629.     property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
  630.     property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
  631.     property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
  632.     property OnValidate: TFieldNotifyEvent read FOnValidate write FOnValidate;
  633.   end;
  634.  
  635. { TStringField }
  636.  
  637.   TStringField = class(TField)
  638.   private
  639.     FFixedChar: Boolean;
  640.     FTransliterate: Boolean;
  641.   protected
  642.     class procedure CheckTypeSize(Value: Integer); override;
  643.     function GetAsBoolean: Boolean; override;
  644.     function GetAsDateTime: TDateTime; override;
  645.     function GetAsFloat: Double; override;
  646.     function GetAsInteger: Longint; override;
  647.     function GetAsString: string; override;
  648.     function GetAsVariant: Variant; override;
  649.     function GetDataSize: Integer; override;
  650.     function GetDefaultWidth: Integer; override;
  651.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  652.     function GetValue(var Value: string): Boolean;
  653.     procedure SetAsBoolean(Value: Boolean); override;
  654.     procedure SetAsDateTime(Value: TDateTime); override;
  655.     procedure SetAsFloat(Value: Double); override;
  656.     procedure SetAsInteger(Value: Longint); override;
  657.     procedure SetAsString(const Value: string); override;
  658.     procedure SetVarValue(const Value: Variant); override;
  659.   public
  660.     constructor Create(AOwner: TComponent); override;
  661.     property Value: string read GetAsString write SetAsString;
  662.   published
  663.     property EditMask;
  664.     property FixedChar: Boolean read FFixedChar write FFixedChar default False;
  665.     property Size default 20;
  666.     property Transliterate: Boolean read FTransliterate write FTransliterate default True;
  667.   end;
  668.  
  669. { TWideStringField }
  670.  
  671.   TWideStringField = class(TStringField)
  672.   protected
  673.     class procedure CheckTypeSize(Value: Integer); override;
  674.     function GetAsString: string; override;
  675.     function GetAsVariant: Variant; override;
  676.     function GetAsWideString: WideString;
  677.     function GetDataSize: Integer; override;
  678.     procedure SetAsString(const Value: string); override;
  679.     procedure SetVarValue(const Value: Variant); override;
  680.     procedure SetAsWideString(const Value: WideString);
  681.   public
  682.     constructor Create(AOwner: TComponent); override;
  683.     property Value: WideString read GetAsWideString write SetAsWideString;
  684.   end;
  685.  
  686. { TNumericField }
  687.  
  688.   TNumericField = class(TField)
  689.   private
  690.     FDisplayFormat: string;
  691.     FEditFormat: string;
  692.   protected
  693.     procedure RangeError(Value, Min, Max: Extended);
  694.     procedure SetDisplayFormat(const Value: string);
  695.     procedure SetEditFormat(const Value: string);
  696.   public
  697.     constructor Create(AOwner: TComponent); override;
  698.   published
  699.     property Alignment default taRightJustify;
  700.     property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  701.     property EditFormat: string read FEditFormat write SetEditFormat;
  702.   end;
  703.  
  704. { TIntegerField }
  705.  
  706.   TIntegerField = class(TNumericField)
  707.   private
  708.     FMinRange: Longint;
  709.     FMaxRange: Longint;
  710.     FMinValue: Longint;
  711.     FMaxValue: Longint;
  712.     procedure CheckRange(Value, Min, Max: Longint);
  713.     procedure SetMaxValue(Value: Longint);
  714.     procedure SetMinValue(Value: Longint);
  715.   protected
  716.     function GetAsFloat: Double; override;
  717.     function GetAsInteger: Longint; override;
  718.     function GetAsString: string; override;
  719.     function GetAsVariant: Variant; override;
  720.     function GetDataSize: Integer; override;
  721.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  722.     function GetValue(var Value: Longint): Boolean;
  723.     procedure SetAsFloat(Value: Double); override;
  724.     procedure SetAsInteger(Value: Longint); override;
  725.     procedure SetAsString(const Value: string); override;
  726.     procedure SetVarValue(const Value: Variant); override;
  727.   public
  728.     constructor Create(AOwner: TComponent); override;
  729.     property Value: Longint read GetAsInteger write SetAsInteger;
  730.   published
  731.     property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
  732.     property MinValue: Longint read FMinValue write SetMinValue default 0;
  733.   end;
  734.  
  735. { TSmallintField }
  736.  
  737.   TSmallintField = class(TIntegerField)
  738.   protected
  739.     function GetDataSize: Integer; override;
  740.   public
  741.     constructor Create(AOwner: TComponent); override;
  742.   end;
  743.  
  744. { TLargeintField }
  745.  
  746.   Largeint = Int64;
  747.  
  748.   TLargeintField = class(TNumericField)
  749.   private
  750.     FMinValue: Largeint;
  751.     FMaxValue: Largeint;
  752.     procedure CheckRange(Value, Min, Max: Largeint);
  753.   protected
  754.     function GetAsFloat: Double; override;
  755.     function GetAsInteger: Longint; override;
  756.     function GetAsLargeint: Largeint;
  757.     function GetAsString: string; override;
  758.     function GetAsVariant: Variant; override;
  759.     function GetDataSize: Integer; override;
  760.     function GetDefaultWidth: Integer; override;
  761.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  762.     function GetValue(var Value: Largeint): Boolean;
  763.     procedure SetAsFloat(Value: Double); override;
  764.     procedure SetAsInteger(Value: Longint); override;
  765.     procedure SetAsLargeint(Value: Largeint);
  766.     procedure SetAsString(const Value: string); override;
  767.     procedure SetVarValue(const Value: Variant); override;
  768.   public
  769.     constructor Create(AOwner: TComponent); override;
  770.     property AsLargeInt: LargeInt read GetAsLargeint write SetAsLargeint;
  771.     property Value: Largeint read GetAsLargeint write SetAsLargeint;
  772.   published
  773.     property MaxValue: Largeint read FMaxValue write FMaxValue default 0;
  774.     property MinValue: Largeint read FMinValue write FMinValue default 0;
  775.   end;
  776.  
  777. { TWordField }
  778.  
  779.   TWordField = class(TIntegerField)
  780.   protected
  781.     function GetDataSize: Integer; override;
  782.   public
  783.     constructor Create(AOwner: TComponent); override;
  784.   end;
  785.  
  786. { TAutoIncField }
  787.  
  788.   TAutoIncField = class(TIntegerField)
  789.   public
  790.     constructor Create(AOwner: TComponent); override;
  791.   end;
  792.  
  793. { TFloatField }
  794.  
  795.   TFloatField = class(TNumericField)
  796.   private
  797.     FCurrency: Boolean;
  798.     FCheckRange: Boolean;
  799.     FPrecision: Integer;
  800.     FMinValue: Double;
  801.     FMaxValue: Double;
  802.     procedure SetCurrency(Value: Boolean);
  803.     procedure SetMaxValue(Value: Double);
  804.     procedure SetMinValue(Value: Double);
  805.     procedure SetPrecision(Value: Integer);
  806.     procedure UpdateCheckRange;
  807.   protected
  808.     function GetAsFloat: Double; override;
  809.     function GetAsInteger: Longint; override;
  810.     function GetAsString: string; override;
  811.     function GetAsVariant: Variant; override;
  812.     function GetDataSize: Integer; override;
  813.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  814.     procedure SetAsFloat(Value: Double); override;
  815.     procedure SetAsInteger(Value: Longint); override;
  816.     procedure SetAsString(const Value: string); override;
  817.     procedure SetVarValue(const Value: Variant); override;
  818.   public
  819.     constructor Create(AOwner: TComponent); override;
  820.     property Value: Double read GetAsFloat write SetAsFloat;
  821.   published
  822.     { Lowercase to avoid name clash with C++ Currency type }
  823.     property currency: Boolean read FCurrency write SetCurrency default False;
  824.     property MaxValue: Double read FMaxValue write SetMaxValue;
  825.     property MinValue: Double read FMinValue write SetMinValue;
  826.     property Precision: Integer read FPrecision write SetPrecision default 15;
  827.   end;
  828.  
  829. { TCurrencyField }
  830.  
  831.   TCurrencyField = class(TFloatField)
  832.   public
  833.     constructor Create(AOwner: TComponent); override;
  834.   published
  835.     property Currency default True;
  836.   end;
  837.  
  838. { TBooleanField }
  839.  
  840.   TBooleanField = class(TField)
  841.   private
  842.     FDisplayValues: string;
  843.     FTextValues: array[Boolean] of string;
  844.     procedure LoadTextValues;
  845.     procedure SetDisplayValues(const Value: string);
  846.   protected
  847.     function GetAsBoolean: Boolean; override;
  848.     function GetAsString: string; override;
  849.     function GetAsVariant: Variant; override;
  850.     function GetDataSize: Integer; override;
  851.     function GetDefaultWidth: Integer; override;
  852.     procedure SetAsBoolean(Value: Boolean); override;
  853.     procedure SetAsString(const Value: string); override;
  854.     procedure SetVarValue(const Value: Variant); override;
  855.   public
  856.     constructor Create(AOwner: TComponent); override;
  857.     property Value: Boolean read GetAsBoolean write SetAsBoolean;
  858.   published
  859.     property DisplayValues: string read FDisplayValues write SetDisplayValues;
  860.   end;
  861.  
  862. { TDateTimeField }
  863.  
  864.   TDateTimeField = class(TField)
  865.   private
  866.     FDisplayFormat: string;
  867.     function GetValue(var Value: TDateTime): Boolean;
  868.     procedure SetDisplayFormat(const Value: string);
  869.   protected
  870.     procedure CopyData(Source, Dest: Pointer); override;
  871.     function GetAsDateTime: TDateTime; override;
  872.     function GetAsFloat: Double; override;
  873.     function GetAsString: string; override;
  874.     function GetAsVariant: Variant; override;
  875.     function GetDataSize: Integer; override;
  876.     function GetDefaultWidth: Integer; override;
  877.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  878.     procedure SetAsDateTime(Value: TDateTime); override;
  879.     procedure SetAsFloat(Value: Double); override;
  880.     procedure SetAsString(const Value: string); override;
  881.     procedure SetVarValue(const Value: Variant); override;
  882.   public
  883.     constructor Create(AOwner: TComponent); override;
  884.     property Value: TDateTime read GetAsDateTime write SetAsDateTime;
  885.   published
  886.     property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  887.     property EditMask;
  888.   end;
  889.  
  890. { TDateField }
  891.  
  892.   TDateField = class(TDateTimeField)
  893.   protected
  894.     function GetDataSize: Integer; override;
  895.   public
  896.     constructor Create(AOwner: TComponent); override;
  897.   end;
  898.  
  899. { TTimeField }
  900.  
  901.   TTimeField = class(TDateTimeField)
  902.   protected
  903.     function GetDataSize: Integer; override;
  904.   public
  905.     constructor Create(AOwner: TComponent); override;
  906.   end;
  907.  
  908. { TBinaryField }
  909.  
  910.   TBinaryField = class(TField)
  911.   protected
  912.     class procedure CheckTypeSize(Value: Integer); override;
  913.     procedure CopyData(Source, Dest: Pointer); override;
  914.     function GetAsString: string; override;
  915.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  916.     function GetAsVariant: Variant; override;
  917.     procedure SetAsString(const Value: string); override;
  918.     procedure SetText(const Value: string); override;
  919.     procedure SetVarValue(const Value: Variant); override;
  920.   public
  921.     constructor Create(AOwner: TComponent); override;
  922.   published
  923.     property Size default 16;
  924.   end;
  925.  
  926. { TBytesField }
  927.  
  928.   TBytesField = class(TBinaryField)
  929.   protected
  930.     function GetDataSize: Integer; override;
  931.   public
  932.     constructor Create(AOwner: TComponent); override;
  933.   end;
  934.  
  935. { TVarBytesField }
  936.  
  937.   TVarBytesField = class(TBytesField)
  938.   protected
  939.     function GetDataSize: Integer; override;
  940.     procedure SetAsByteArray(const Value: Variant); override;
  941.   public
  942.     constructor Create(AOwner: TComponent); override;
  943.   end;
  944.  
  945. { TBCDField }
  946.  
  947.   PBcd = ^TBcd;
  948.   TBcd  = packed record
  949.     Precision: Byte;                        { 1..64 }
  950.     SignSpecialPlaces: Byte;                { Sign:1, Special:1, Places:6 }
  951.     Fraction: packed array [0..31] of Byte; { BCD Nibbles, 00..99 per Byte, high Nibble 1st }
  952.   end;
  953.  
  954.  
  955.   TBCDField = class(TNumericField)
  956.   private
  957.     FCurrency: Boolean;
  958.     FCheckRange: Boolean;
  959.     FMinValue: Currency;
  960.     FMaxValue: Currency;
  961.     FPrecision: Integer;
  962.     procedure SetCurrency(Value: Boolean);
  963.     procedure SetMaxValue(Value: Currency);
  964.     procedure SetMinValue(Value: Currency);
  965.     procedure SetPrecision(Value: Integer);
  966.     procedure UpdateCheckRange;
  967.   protected
  968.     class procedure CheckTypeSize(Value: Integer); override;
  969.     procedure CopyData(Source, Dest: Pointer); override;
  970.     function GetAsCurrency: Currency; override;
  971.     function GetAsFloat: Double; override;
  972.     function GetAsInteger: Longint; override;
  973.     function GetAsString: string; override;
  974.     function GetAsVariant: Variant; override;
  975.     function GetDataSize: Integer; override;
  976.     function GetDefaultWidth: Integer; override;
  977.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  978.     function GetValue(var Value: Currency): Boolean;
  979.     procedure SetAsCurrency(Value: Currency); override;
  980.     procedure SetAsFloat(Value: Double); override;
  981.     procedure SetAsInteger(Value: Longint); override;
  982.     procedure SetAsString(const Value: string); override;
  983.     procedure SetVarValue(const Value: Variant); override;
  984.   public
  985.     constructor Create(AOwner: TComponent); override;
  986.     property Value: Currency read GetAsCurrency write SetAsCurrency;
  987.   published
  988.     { Lowercase to avoid name clash with C++ Currency type }
  989.     property currency: Boolean read FCurrency write SetCurrency default False;
  990.     property MaxValue: Currency read FMaxValue write SetMaxValue;
  991.     property MinValue: Currency read FMinValue write SetMinValue;
  992.     property Precision: Integer read FPrecision write SetPrecision default 0;
  993.     property Size default 4;
  994.   end;
  995.  
  996. { TBlobField }
  997.  
  998.   TBlobType = ftBlob..ftOraClob;
  999.  
  1000.   TBlobField = class(TField)
  1001.   private
  1002.     FModified: Boolean;
  1003.     FModifiedRecord: Integer;
  1004.     FTransliterate: Boolean;
  1005.     function GetBlobType: TBlobType;
  1006.     function GetModified: Boolean;
  1007.     procedure LoadFromBlob(Blob: TBlobField);
  1008.     procedure LoadFromBitmap(Bitmap: TBitmap);
  1009.     procedure LoadFromStrings(Strings: TStrings);
  1010.     procedure SaveToBitmap(Bitmap: TBitmap);
  1011.     procedure SaveToStrings(Strings: TStrings);
  1012.     procedure SetBlobType(Value: TBlobType);
  1013.     procedure SetModified(Value: Boolean);
  1014.   protected
  1015.     procedure AssignTo(Dest: TPersistent); override;
  1016.     procedure FreeBuffers; override;
  1017.     function GetAsString: string; override;
  1018.     function GetAsVariant: Variant; override;
  1019.     function GetBlobSize: Integer; virtual;
  1020.     function GetClassDesc: string; override;
  1021.     function GetIsNull: Boolean; override;
  1022.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  1023.     procedure SetAsString(const Value: string); override;
  1024.     procedure SetText(const Value: string); override;
  1025.     procedure SetVarValue(const Value: Variant); override;
  1026.   public
  1027.     constructor Create(AOwner: TComponent); override;
  1028.     procedure Assign(Source: TPersistent); override;
  1029.     procedure Clear; override;
  1030.     class function IsBlob: Boolean; override;
  1031.     procedure LoadFromFile(const FileName: string);
  1032.     procedure LoadFromStream(Stream: TStream);
  1033.     procedure SaveToFile(const FileName: string);
  1034.     procedure SaveToStream(Stream: TStream);
  1035.     procedure SetFieldType(Value: TFieldType); override;
  1036.     property BlobSize: Integer read GetBlobSize;
  1037.     property Modified: Boolean read GetModified write SetModified;
  1038.     property Value: string read GetAsString write SetAsString;
  1039.     property Transliterate: Boolean read FTransliterate write FTransliterate;
  1040.   published
  1041.     property BlobType: TBlobType read GetBlobType write SetBlobType;
  1042.     property Size default 0;
  1043.   end;
  1044.  
  1045. { TMemoField }
  1046.  
  1047.   TMemoField = class(TBlobField)
  1048.   public
  1049.     constructor Create(AOwner: TComponent); override;
  1050.   published
  1051.     property Transliterate default True;
  1052.   end;
  1053.  
  1054. { TGraphicField }
  1055.  
  1056.   TGraphicField = class(TBlobField)
  1057.   public
  1058.     constructor Create(AOwner: TComponent); override;
  1059.   end;
  1060.  
  1061. { TObjectField }
  1062.  
  1063.   TObjectField = class(TField)
  1064.   private
  1065.     FFields: TFields;
  1066.     FOwnedFields: TFields;
  1067.     FObjectType: string;
  1068.     FTotalSize: Integer;
  1069.     FUnNamed: Boolean;
  1070.     procedure DataSetChanged;
  1071.     procedure ReadUnNamed(Reader: TReader);
  1072.     procedure WriteUnNamed(Writer: TWriter);
  1073.   protected
  1074.     class procedure CheckTypeSize(Value: Integer); override;
  1075.     procedure DefineProperties(Filer: TFiler); override;
  1076.     procedure FreeBuffers; override;
  1077.     function GetAsString: string; override;
  1078.     function GetAsVariant: Variant; override;
  1079.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  1080.     function GetDefaultWidth: Integer; override;
  1081.     function GetFieldCount: Integer;
  1082.     function GetFields: TFields; virtual;
  1083.     function GetFieldValue(Index: Integer): Variant; virtual;
  1084.     function GetHasConstraints: Boolean; override;
  1085.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  1086.     procedure SetDataSet(ADataSet: TDataSet); override;
  1087.     procedure SetFieldKind(Value: TFieldKind); override;
  1088.     procedure SetFieldValue(Index: Integer; const Value: Variant); virtual;
  1089.     procedure SetParentField(AField: TObjectField); override;
  1090.     procedure SetUnNamed(Value: Boolean);
  1091.     procedure SetVarValue(const Value: Variant); override;
  1092.   public
  1093.     constructor Create(AOwner: TComponent); override;
  1094.     destructor Destroy; override;
  1095.     property FieldCount: Integer read GetFieldCount;
  1096.     property Fields: TFields read GetFields;
  1097.     property FieldValues[Index: Integer]: Variant read GetFieldValue
  1098.       write SetFieldValue; default;
  1099.     property UnNamed: Boolean read FUnNamed default False;
  1100.   published
  1101.     property ObjectType: string read FObjectType write FObjectType;
  1102.   end;
  1103.  
  1104. { TADTField }
  1105.  
  1106.   TADTField = class(TObjectField)
  1107.   private
  1108.     procedure FieldsChanged(Sender: TObject);
  1109.   protected
  1110.     function GetSize: Integer; override;
  1111.   public
  1112.     constructor Create(AOwner: TComponent); override;
  1113.   end;
  1114.  
  1115. { TArrayField }
  1116.  
  1117.   TArrayField = class(TObjectField)
  1118.   protected
  1119.     procedure Bind(Binding: Boolean); override;
  1120.     procedure SetSize(Value: Integer); override;
  1121.   public
  1122.     constructor Create(AOwner: TComponent); override;
  1123.     property Size default 10;
  1124.   end;
  1125.  
  1126. { TDataSetField }
  1127.  
  1128.   TDataSetField = class(TObjectField)
  1129.   private
  1130.     FOwnedDataSet: TDataSet;
  1131.     FNestedDataSet: TDataSet;
  1132.     FIncludeObjectField: Boolean;
  1133.     function GetNestedDataSet: TDataSet;
  1134.     procedure AssignNestedDataSet(Value: TDataSet);
  1135.     procedure SetIncludeObjectField(Value: Boolean);
  1136.   protected
  1137.     procedure Bind(Binding: Boolean); override;
  1138.     function GetCanModify: Boolean; override;
  1139.     function GetFields: TFields; override;
  1140.   public
  1141.     constructor Create(AOwner: TComponent); override;
  1142.     destructor Destroy; override;
  1143.     property NestedDataSet: TDataSet read GetNestedDataSet;
  1144.   published
  1145.     property IncludeObjectField: Boolean read FIncludeObjectField write SetIncludeObjectField;
  1146.   end;
  1147.  
  1148. { TReferenceField }
  1149.  
  1150.   TReferenceField = class(TDataSetField)
  1151.   private
  1152.     FReferenceTableName: string;
  1153.   protected
  1154.     function GetAsVariant: Variant; override;
  1155.     function GetDataSize: Integer; override;
  1156.     procedure SetVarValue(const Value: Variant); override;
  1157.   public
  1158.     constructor Create(AOwner: TComponent); override;
  1159.     procedure Assign(Source: TPersistent); override;
  1160.   published
  1161.     property ReferenceTableName: string read FReferenceTableName write FReferenceTableName;
  1162.     property Size default 0;
  1163.   end;
  1164.  
  1165. { TVariantField }
  1166.  
  1167.   TVariantField = class(TField)
  1168.   protected
  1169.     class procedure CheckTypeSize(Value: Integer); override;
  1170.     function GetAsBoolean: Boolean; override;
  1171.     function GetAsDateTime: TDateTime; override;
  1172.     function GetAsFloat: Double; override;
  1173.     function GetAsInteger: Longint; override;
  1174.     function GetAsString: string; override;
  1175.     function GetAsVariant: Variant; override;
  1176.     function GetDefaultWidth: Integer; override;
  1177.     procedure SetAsBoolean(Value: Boolean); override;
  1178.     procedure SetAsDateTime(Value: TDateTime); override;
  1179.     procedure SetAsFloat(Value: Double); override;
  1180.     procedure SetAsInteger(Value: Longint); override;
  1181.     procedure SetAsString(const Value: string); override;
  1182.     procedure SetVarValue(const Value: Variant); override;
  1183.   public
  1184.     constructor Create(AOwner: TComponent); override;
  1185.   end;
  1186.  
  1187. { TInterfaceField }
  1188.  
  1189.   TInterfaceField = class(TField)
  1190.   protected
  1191.     class procedure CheckTypeSize(Value: Integer); override;
  1192.     function GetValue: IUnknown;
  1193.     function GetAsVariant: Variant; override;
  1194.     procedure SetValue(const Value: IUnknown);
  1195.     procedure SetVarValue(const Value: Variant); override;
  1196.   public
  1197.     constructor Create(AOwner: TComponent); override;
  1198.     property Value: IUnknown read GetValue write SetValue;
  1199.   end;
  1200.  
  1201. { TIDispatchField }
  1202.  
  1203.   TIDispatchField = class(TInterfaceField)
  1204.   protected
  1205.     function GetValue: IDispatch;
  1206.     procedure SetValue(const Value: IDispatch);
  1207.   public
  1208.     constructor Create(AOwner: TComponent); override;
  1209.     property Value: IDispatch read GetValue write SetValue;
  1210.   end;
  1211.  
  1212. { TGuidField }
  1213.  
  1214.   TGuidField = class(TStringField)
  1215.   protected
  1216.     class procedure CheckTypeSize(Value: Integer); override;
  1217.     function GetAsGuid: TGUID;
  1218.     function GetDefaultWidth: Integer; override;
  1219.     procedure SetAsGuid(const Value: TGUID);
  1220.   public
  1221.     constructor Create(AOwner: TComponent); override;
  1222.     property AsGuid: TGUID read GetAsGuid write SetAsGuid;
  1223.   end;
  1224.  
  1225. { TAggregateField }
  1226.  
  1227.   TAggregateField = class(TField)
  1228.   private
  1229.     FActive: Boolean;
  1230.     FCurrency: Boolean;
  1231.     FDisplayName: string;
  1232.     FDisplayFormat: string;
  1233.     FExpression: string;
  1234.     FGroupingLevel: Integer;
  1235.     FIndexName: string;
  1236.     FHandle: Pointer;
  1237.     FPrecision: Integer;
  1238.     FResultType: TFieldType;
  1239.     procedure SetHandle(Value: Pointer); virtual;
  1240.     procedure SetActive(Value: Boolean);
  1241.     function GetHandle: Pointer; virtual;
  1242.     procedure SetGroupingLevel(Value: Integer);
  1243.     procedure SetIndexName(Value: String);
  1244.     procedure SetExpression(Value: String);
  1245.     procedure SetPrecision(Value: Integer);
  1246.     procedure SetCurrency(Value: Boolean);
  1247.   protected
  1248.     function GetAsString: string; override;
  1249.     function GetAsVariant: Variant; override;
  1250.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  1251.     procedure Reset;
  1252.     procedure SetDisplayFormat(const Value: string);
  1253.   public
  1254.     constructor Create(AOwner: TComponent); override;
  1255.     property Handle: Pointer read GetHandle write SetHandle;
  1256.     property ResultType: TFieldType read FResultType write FResultType;
  1257.   published
  1258.     property Active: Boolean read FActive write SetActive default False;
  1259.     property currency: Boolean read FCurrency write SetCurrency default False;
  1260.     property DisplayName: String read FDisplayName write FDisplayName;
  1261.     property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  1262.     property Expression: String read FExpression write SetExpression;
  1263.     property FieldKind default fkAggregate;
  1264.     property GroupingLevel: Integer read FGroupingLevel write SetGroupingLevel default 0;
  1265.     property IndexName: String read FIndexName write SetIndexName;
  1266.     property Precision: Integer read FPrecision write SetPrecision default 15;
  1267.     property Visible default False;
  1268.   end;
  1269.  
  1270. { TDataLink }
  1271.  
  1272.   TDataLink = class(TPersistent)
  1273.   private
  1274.     FDataSource: TDataSource;
  1275.     FNext: TDataLink;
  1276.     FBufferCount: Integer;
  1277.     FFirstRecord: Integer;
  1278.     FReadOnly: Boolean;
  1279.     FActive: Boolean;
  1280.     FVisualControl: Boolean;
  1281.     FEditing: Boolean;
  1282.     FUpdating: Boolean;
  1283.     FDataSourceFixed: Boolean;
  1284.     function GetDataSet: TDataSet;
  1285.     procedure SetActive(Value: Boolean);
  1286.     procedure SetDataSource(ADataSource: TDataSource);
  1287.     procedure SetEditing(Value: Boolean);
  1288.     procedure SetReadOnly(Value: Boolean);
  1289.     procedure UpdateRange;
  1290.     procedure UpdateState;
  1291.   protected
  1292.     procedure ActiveChanged; virtual;
  1293.     procedure CheckBrowseMode; virtual;
  1294.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  1295.     procedure DataSetChanged; virtual;
  1296.     procedure DataSetScrolled(Distance: Integer); virtual;
  1297.     procedure EditingChanged; virtual;
  1298.     procedure FocusControl(Field: TFieldRef); virtual;
  1299.     function GetActiveRecord: Integer; virtual;
  1300.     function GetBOF: Boolean; virtual;
  1301.     function GetBufferCount: Integer; virtual;
  1302.     function GetEOF: Boolean; virtual;
  1303.     function GetRecordCount: Integer; virtual;
  1304.     procedure LayoutChanged; virtual;
  1305.     function MoveBy(Distance: Integer): Integer; virtual;
  1306.     procedure RecordChanged(Field: TField); virtual;
  1307.     procedure SetActiveRecord(Value: Integer); virtual;
  1308.     procedure SetBufferCount(Value: Integer); virtual;
  1309.     procedure UpdateData; virtual;
  1310.     property VisualControl: Boolean read FVisualControl write FVisualControl;
  1311.   public
  1312.     constructor Create;
  1313.     destructor Destroy; override;
  1314.     function Edit: Boolean;
  1315.     function ExecuteAction(Action: TBasicAction): Boolean; dynamic;
  1316.     function UpdateAction(Action: TBasicAction): Boolean; dynamic;
  1317.     procedure UpdateRecord;
  1318.     property Active: Boolean read FActive;
  1319.     property ActiveRecord: Integer read GetActiveRecord write SetActiveRecord;
  1320.     property BOF: Boolean read GetBOF;
  1321.     property BufferCount: Integer read FBufferCount write SetBufferCount;
  1322.     property DataSet: TDataSet read GetDataSet;
  1323.     property DataSource: TDataSource read FDataSource write SetDataSource;
  1324.     property DataSourceFixed: Boolean read FDataSourceFixed write FDataSourceFixed;
  1325.     property Editing: Boolean read FEditing;
  1326.     property Eof: Boolean read GetEOF;
  1327.     property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  1328.     property RecordCount: Integer read GetRecordCount;
  1329.   end;
  1330.  
  1331. { TDetailDataLink }
  1332.  
  1333.   TDetailDataLink = class(TDataLink)
  1334.   protected
  1335.     function GetDetailDataSet: TDataSet; virtual;
  1336.   public
  1337.     property DetailDataSet: TDataSet read GetDetailDataSet;
  1338.   end;
  1339.  
  1340. { TMasterDataLink }
  1341.  
  1342.   TMasterDataLink = class(TDetailDataLink)
  1343.   private
  1344.     FDataSet: TDataSet;
  1345.     FFieldNames: string;
  1346.     FFields: TList;
  1347.     FOnMasterChange: TNotifyEvent;
  1348.     FOnMasterDisable: TNotifyEvent;
  1349.     procedure SetFieldNames(const Value: string);
  1350.   protected
  1351.     procedure ActiveChanged; override;
  1352.     procedure CheckBrowseMode; override;
  1353.     function GetDetailDataSet: TDataSet; override;
  1354.     procedure LayoutChanged; override;
  1355.     procedure RecordChanged(Field: TField); override;
  1356.   public
  1357.     constructor Create(DataSet: TDataSet);
  1358.     destructor Destroy; override;
  1359.     property FieldNames: string read FFieldNames write SetFieldNames;
  1360.     property Fields: TList read FFields;
  1361.     property OnMasterChange: TNotifyEvent read FOnMasterChange write FOnMasterChange;
  1362.     property OnMasterDisable: TNotifyEvent read FOnMasterDisable write FOnMasterDisable;
  1363.   end;
  1364.  
  1365. { TDataSource }
  1366.  
  1367.   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  1368.  
  1369.   TDataSource = class(TComponent)
  1370.   private
  1371.     FDataSet: TDataSet;
  1372.     FDataLinks: TList;
  1373.     FEnabled: Boolean;
  1374.     FAutoEdit: Boolean;
  1375.     FState: TDataSetState;
  1376.     FOnStateChange: TNotifyEvent;
  1377.     FOnDataChange: TDataChangeEvent;
  1378.     FOnUpdateData: TNotifyEvent;
  1379.     procedure AddDataLink(DataLink: TDataLink);
  1380.     procedure DataEvent(Event: TDataEvent; Info: Longint);
  1381.     procedure NotifyDataLinks(Event: TDataEvent; Info: Longint);
  1382.     procedure NotifyLinkTypes(Event: TDataEvent; Info: Longint; LinkType: Boolean);
  1383.     procedure RemoveDataLink(DataLink: TDataLink);
  1384.     procedure SetDataSet(ADataSet: TDataSet);
  1385.     procedure SetEnabled(Value: Boolean);
  1386.     procedure SetState(Value: TDataSetState);
  1387.     procedure UpdateState;
  1388.   protected
  1389.     property DataLinks: TList read FDataLinks;
  1390.   public
  1391.     constructor Create(AOwner: TComponent); override;
  1392.     destructor Destroy; override;
  1393.     procedure Edit;
  1394.     function IsLinkedTo(DataSet: TDataSet): Boolean;
  1395.     property State: TDataSetState read FState;
  1396.   published
  1397.     property AutoEdit: Boolean read FAutoEdit write FAutoEdit default True;
  1398.     property DataSet: TDataSet read FDataSet write SetDataSet;
  1399.     property Enabled: Boolean read FEnabled write SetEnabled default True;
  1400.     property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
  1401.     property OnDataChange: TDataChangeEvent read FOnDataChange write FOnDataChange;
  1402.     property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
  1403.   end;
  1404.  
  1405. { TDataSetDesigner }
  1406.  
  1407.   TDataSetDesigner = class(TObject)
  1408.   private
  1409.     FDataSet: TDataSet;
  1410.     FSaveActive: Boolean;
  1411.   public
  1412.     constructor Create(DataSet: TDataSet);
  1413.     destructor Destroy; override;
  1414.     procedure BeginDesign;
  1415.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  1416.     procedure EndDesign;
  1417.     property DataSet: TDataSet read FDataSet;
  1418.   end;
  1419.  
  1420. { TCheckConstraint }
  1421.  
  1422.   TCheckConstraint = class(TCollectionItem)
  1423.   private
  1424.     FImportedConstraint: string;
  1425.     FCustomConstraint: string;
  1426.     FErrorMessage: string;
  1427.     FFromDictionary: Boolean;
  1428.     procedure SetImportedConstraint(const Value: string);
  1429.     procedure SetCustomConstraint(const Value: string);
  1430.     procedure SetErrorMessage(const Value: string);
  1431.   public
  1432.     procedure Assign(Source: TPersistent); override;
  1433.     function GetDisplayName: string; override;
  1434.   published
  1435.     property CustomConstraint: string read FCustomConstraint write SetCustomConstraint;
  1436.     property ErrorMessage: string read FErrorMessage write SetErrorMessage;
  1437.     property FromDictionary: Boolean read FFromDictionary write FFromDictionary;
  1438.     property ImportedConstraint: string read FImportedConstraint write SetImportedConstraint;
  1439.   end;
  1440.  
  1441. { TCheckConstraints }
  1442.  
  1443.   TCheckConstraints = class(TCollection)
  1444.   private
  1445.     FOwner: TPersistent;
  1446.     function GetItem(Index: Integer): TCheckConstraint;
  1447.     procedure SetItem(Index: Integer; Value: TCheckConstraint);
  1448.   protected
  1449.     function GetOwner: TPersistent; override;
  1450.   public
  1451.     constructor Create(Owner: TPersistent);
  1452.     function Add: TCheckConstraint;
  1453.     property Items[Index: Integer]: TCheckConstraint read GetItem write SetItem; default;
  1454.   end;
  1455.  
  1456. { TParam }
  1457.  
  1458.   TBlobData = string;
  1459.  
  1460.   TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult);
  1461.   TParamTypes = set of TParamType;
  1462.  
  1463.   TParams = class;
  1464.  
  1465.   TParam = class(TCollectionItem)
  1466.   private
  1467.     FParamRef: TParam;
  1468.     FNativeStr: string;
  1469.     FData: Variant;
  1470.     FNull: Boolean;
  1471.     FName: string;
  1472.     FDataType: TFieldType;
  1473.     FBound: Boolean;
  1474.     FParamType: TParamType;
  1475.     function ParamRef: TParam;
  1476.     function GetDataSet: TDataSet;
  1477.     function IsParamStored: Boolean;
  1478.     function GetDataType: TFieldType;
  1479.     function GetParamType: TParamType;
  1480.     procedure SetParamType(Value: TParamType);
  1481.   protected
  1482.     procedure AssignParam(Param: TParam);
  1483.     procedure AssignTo(Dest: TPersistent); override;
  1484.     function GetAsBCD: Currency;
  1485.     function GetAsBoolean: Boolean;
  1486.     function GetAsDateTime: TDateTime;
  1487.     function GetAsCurrency: Currency;
  1488.     function GetAsFloat: Double;
  1489.     function GetAsInteger: Longint;
  1490.     function GetAsMemo: string;
  1491.     function GetAsString: string;
  1492.     function GetAsVariant: Variant;
  1493.     function GetIsNull: Boolean;
  1494.     function IsEqual(Value: TParam): Boolean;
  1495.     procedure SetAsBCD(const Value: Currency);
  1496.     procedure SetAsBlob(const Value: TBlobData);
  1497.     procedure SetAsBoolean(Value: Boolean);
  1498.     procedure SetAsCurrency(const Value: Currency);
  1499.     procedure SetAsDate(const Value: TDateTime);
  1500.     procedure SetAsDateTime(const Value: TDateTime);
  1501.     procedure SetAsFloat(const Value: Double);
  1502.     procedure SetAsInteger(Value: Longint);
  1503.     procedure SetAsMemo(const Value: string);
  1504.     procedure SetAsString(const Value: string);
  1505.     procedure SetAsSmallInt(Value: LongInt);
  1506.     procedure SetAsTime(const Value: TDateTime);
  1507.     procedure SetAsVariant(const Value: Variant);
  1508.     procedure SetAsWord(Value: LongInt);
  1509.     procedure SetDataType(Value: TFieldType);
  1510.     procedure SetText(const Value: string);
  1511.     function GetDisplayName: string; override;
  1512.     property DataSet: TDataSet read GetDataSet;
  1513.   public
  1514.     constructor Create(Collection: TCollection); overload; override;
  1515.     constructor Create(AParams: TParams; AParamType: TParamType); reintroduce; overload;
  1516.     procedure Assign(Source: TPersistent); override;
  1517.     procedure AssignField(Field: TField);
  1518.     procedure AssignFieldValue(Field: TField; const Value: Variant);
  1519.     procedure Clear;
  1520.     procedure GetData(Buffer: Pointer);
  1521.     function GetDataSize: Integer;
  1522.     procedure LoadFromFile(const FileName: string; BlobType: TBlobType);
  1523.     procedure LoadFromStream(Stream: TStream; BlobType: TBlobType);
  1524.     procedure SetBlobData(Buffer: Pointer; Size: Integer);
  1525.     procedure SetData(Buffer: Pointer);
  1526.     property AsBCD: Currency read GetAsBCD write SetAsBCD;
  1527.     property AsBlob: TBlobData read GetAsString write SetAsBlob;
  1528.     property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  1529.     property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
  1530.     property AsDate: TDateTime read GetAsDateTime write SetAsDate;
  1531.     property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
  1532.     property AsFloat: Double read GetAsFloat write SetAsFloat;
  1533.     property AsInteger: LongInt read GetAsInteger write SetAsInteger;
  1534.     property AsSmallInt: LongInt read GetAsInteger write SetAsSmallInt;
  1535.     property AsMemo: string read GetAsMemo write SetAsMemo;
  1536.     property AsString: string read GetAsString write SetAsString;
  1537.     property AsTime: TDateTime read GetAsDateTime write SetAsTime;
  1538.     property AsWord: LongInt read GetAsInteger write SetAsWord;
  1539.     property Bound: Boolean read FBound write FBound;
  1540.     property IsNull: Boolean read GetIsNull;
  1541.     property NativeStr: string read FNativeStr write FNativeStr;
  1542.     property Text: string read GetAsString write SetText;
  1543.   published
  1544.     property DataType: TFieldType read GetDataType write SetDataType;
  1545.     property Name: string read FName write FName;
  1546.     property ParamType: TParamType read GetParamType write SetParamType;
  1547.     property Value: Variant read GetAsVariant write SetAsVariant stored IsParamStored;
  1548.   end;
  1549.  
  1550. { TParams }
  1551.  
  1552.   TParams = class(TCollection)
  1553.   private
  1554.     FOwner: TPersistent;
  1555.     function GetParamValue(const ParamName: string): Variant;
  1556.     procedure ReadBinaryData(Stream: TStream);
  1557.     procedure SetParamValue(const ParamName: string;
  1558.       const Value: Variant);
  1559.     function GetItem(Index: Integer): TParam;
  1560.     procedure SetItem(Index: Integer; Value: TParam);
  1561.   protected
  1562.     procedure AssignTo(Dest: TPersistent); override;
  1563.     procedure DefineProperties(Filer: TFiler); override;
  1564.     function GetDataSet: TDataSet;
  1565.     function GetOwner: TPersistent; override;
  1566.     procedure Update(Item: TCollectionItem); override;
  1567.   public
  1568.     constructor Create(Owner: TPersistent); overload;
  1569.     procedure AssignValues(Value: TParams);
  1570.     { Create, AddParam, RemoveParam and CreateParam are in for backward compatibility }
  1571.     constructor Create; overload;
  1572.     procedure AddParam(Value: TParam);
  1573.     procedure RemoveParam(Value: TParam);
  1574.     function CreateParam(FldType: TFieldType; const ParamName: string;
  1575.       ParamType: TParamType): TParam;
  1576.     procedure GetParamList(List: TList; const ParamNames: string);
  1577.     function IsEqual(Value: TParams): Boolean;
  1578.     function ParseSQL(SQL: String; DoCreate: Boolean): String;
  1579.     function ParamByName(const Value: string): TParam;
  1580.     function FindParam(const Value: string): TParam;
  1581.     property Items[Index: Integer]: TParam read GetItem write SetItem; default;
  1582.     property ParamValues[const ParamName: string]: Variant read GetParamValue write SetParamValue;
  1583.   end;
  1584.  
  1585. { IProviderSupport interface }
  1586.  
  1587.   IProviderSupport = interface
  1588.     procedure PSEndTransaction(Commit: Boolean);
  1589.     procedure PSExecute;
  1590.     function PSExecuteStatement(const ASQL: string; AParams: TParams;
  1591.       ResultSet: Pointer = nil): Integer;
  1592.     procedure PSGetAttributes(List: TList);
  1593.     function PSGetDefaultOrder: TIndexDef;
  1594.     function PSGetKeyFields: string;
  1595.     function PSGetParams: TParams;
  1596.     function PSGetQuoteChar: string;
  1597.     function PSGetTableName: string;
  1598.     function PSGetIndexDefs(IndexTypes: TIndexOptions = [ixPrimary..ixNonMaintained]): TIndexDefs;
  1599.     function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
  1600.     function PSInTransaction: Boolean;
  1601.     function PSIsSQLBased: Boolean;
  1602.     function PSIsSQLSupported: Boolean;
  1603.     procedure PSReset;
  1604.     procedure PSSetParams(AParams: TParams);
  1605.     procedure PSSetCommandText(const CommandText: string);
  1606.     procedure PSStartTransaction;
  1607.     function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean;
  1608.   end;
  1609.  
  1610. { TDataSet }
  1611.  
  1612.   TBookmark = Pointer;
  1613.   TBookmarkStr = string;
  1614.  
  1615.   PBookmarkFlag = ^TBookmarkFlag;
  1616.   TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
  1617.  
  1618.   TBufferList = array of PChar;
  1619.  
  1620.   TGetMode = (gmCurrent, gmNext, gmPrior);
  1621.  
  1622.   TGetResult = (grOK, grBOF, grEOF, grError);
  1623.  
  1624.   TResyncMode = set of (rmExact, rmCenter);
  1625.  
  1626.   TDataAction = (daFail, daAbort, daRetry);
  1627.  
  1628.   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
  1629.  
  1630.   TLocateOption = (loCaseInsensitive, loPartialKey);
  1631.   TLocateOptions = set of TLocateOption;
  1632.  
  1633.   TDataOperation = procedure of object;
  1634.  
  1635.   TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  1636.   TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  1637.     var Action: TDataAction) of object;
  1638.  
  1639.   TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  1640.   TFilterOptions = set of TFilterOption;
  1641.  
  1642.   TFilterRecordEvent = procedure(DataSet: TDataSet;
  1643.     var Accept: Boolean) of object;
  1644.  
  1645.   PPacketAttribute = ^TPacketAttribute;
  1646.   TPacketAttribute = record
  1647.     Name: string;
  1648.     Value: OleVariant;
  1649.     IncludeInDelta: Boolean;
  1650.   end;
  1651.  
  1652.   TBlobByteData = array of Byte;
  1653.  
  1654.   TGroupPosInd = (gbFirst, gbMiddle, gbLast);
  1655.   TGroupPosInds = set of TGroupPosInd;
  1656.  
  1657.   TDataSet = class(TComponent, IProviderSupport)
  1658.   private
  1659.     FFields: TFields;
  1660.     FAggFields: TFields;
  1661.     FFieldDefs: TFieldDefs;
  1662.     FFieldDefList: TFieldDefList;
  1663.     FFieldList: TFieldList;
  1664.     FDataSources: TList;
  1665.     FFirstDataLink: TDataLink;
  1666.     FBufferCount: Integer;
  1667.     FRecordCount: Integer;
  1668.     FActiveRecord: Integer;
  1669.     FCurrentRecord: Integer;
  1670.     FBuffers: TBufferList;
  1671.     FCalcBuffer: PChar;
  1672.     FBookmarkSize: Integer;
  1673.     FCalcFieldsSize: Integer;
  1674.     FDesigner: TDataSetDesigner;
  1675.     FDisableCount: Integer;
  1676.     FBlobFieldCount: Integer;
  1677.     FFilterText: string;
  1678.     FBlockReadSize: Integer;
  1679.     FConstraints: TCheckConstraints;
  1680.     FDataSetField: TDataSetField;
  1681.     FNestedDataSets: TList;
  1682.     FNestedDatasetClass: TClass;
  1683.     FReserved: Pointer;
  1684.     FFieldNoOfs: Integer;
  1685.     { Byte sized data members (for alignment) }
  1686.     FFilterOptions: TFilterOptions;
  1687.     FState: TDataSetState;
  1688.     FEnableEvent: TDataEvent;
  1689.     FDisableState: TDataSetState;
  1690.     FBOF: Boolean;
  1691.     FEOF: Boolean;
  1692.     FModified: Boolean;
  1693.     FStreamedActive: Boolean;
  1694.     FInternalCalcFields: Boolean;
  1695.     FFound: Boolean;
  1696.     FDefaultFields: Boolean;
  1697.     FAutoCalcFields: Boolean;
  1698.     FFiltered: Boolean;
  1699.     FObjectView: Boolean;
  1700.     FSparseArrays: Boolean;
  1701.     FInternalOpenComplete: Boolean;
  1702.     { Events }
  1703.     FBeforeOpen: TDataSetNotifyEvent;
  1704.     FAfterOpen: TDataSetNotifyEvent;
  1705.     FBeforeClose: TDataSetNotifyEvent;
  1706.     FAfterClose: TDataSetNotifyEvent;
  1707.     FBeforeInsert: TDataSetNotifyEvent;
  1708.     FAfterInsert: TDataSetNotifyEvent;
  1709.     FBeforeEdit: TDataSetNotifyEvent;
  1710.     FAfterEdit: TDataSetNotifyEvent;
  1711.     FBeforePost: TDataSetNotifyEvent;
  1712.     FAfterPost: TDataSetNotifyEvent;
  1713.     FBeforeCancel: TDataSetNotifyEvent;
  1714.     FAfterCancel: TDataSetNotifyEvent;
  1715.     FBeforeDelete: TDataSetNotifyEvent;
  1716.     FAfterDelete: TDataSetNotifyEvent;
  1717.     FBeforeRefresh: TDataSetNotifyEvent;
  1718.     FAfterRefresh: TDataSetNotifyEvent;
  1719.     FBeforeScroll: TDataSetNotifyEvent;
  1720.     FAfterScroll: TDataSetNotifyEvent;
  1721.     FOnNewRecord: TDataSetNotifyEvent;
  1722.     FOnCalcFields: TDataSetNotifyEvent;
  1723.     FOnEditError: TDataSetErrorEvent;
  1724.     FOnPostError: TDataSetErrorEvent;
  1725.     FOnDeleteError: TDataSetErrorEvent;
  1726.     FOnFilterRecord: TFilterRecordEvent;
  1727.     procedure AddDataSource(DataSource: TDataSource);
  1728.     procedure AddRecord(const Values: array of const; Append: Boolean);
  1729.     procedure BeginInsertAppend;
  1730.     procedure CheckCanModify;
  1731.     procedure CheckOperation(Operation: TDataOperation;
  1732.       ErrorEvent: TDataSetErrorEvent);
  1733.     procedure CheckParentState;
  1734.     procedure CheckRequiredFields;
  1735.     procedure DoInternalOpen;
  1736.     procedure EndInsertAppend;
  1737.     function GetActive: Boolean;
  1738.     function GetBuffer(Index: Integer): PChar;
  1739.     function GetFieldCount: Integer;
  1740.     function GetFieldValue(const FieldName: string): Variant;
  1741.     function GetFound: Boolean;
  1742.     function GetNestedDataSets: TList;
  1743.     procedure MoveBuffer(CurIndex, NewIndex: Integer);
  1744.     procedure RemoveDataSource(DataSource: TDataSource);
  1745.     procedure SetBufferCount(Value: Integer);
  1746.     procedure SetConstraints(Value: TCheckConstraints);
  1747.     procedure SetFieldDefs(Value: TFieldDefs);
  1748.     procedure SetFieldValue(const FieldName: string; const Value: Variant);
  1749.     procedure SetSparseArrays(Value: Boolean);
  1750.   protected
  1751.     { IProviderSupport }
  1752.     procedure PSEndTransaction(Commit: Boolean); virtual;
  1753.     procedure PSExecute; virtual;
  1754.     function PSExecuteStatement(const ASQL: string; AParams: TParams;
  1755.       ResultSet: Pointer = nil): Integer; virtual;
  1756.     procedure PSGetAttributes(List: TList); virtual;
  1757.     function PSGetDefaultOrder: TIndexDef; virtual;
  1758.     function PSGetKeyFields: string; virtual;
  1759.     function PSGetParams: TParams; virtual;
  1760.     function PSGetQuoteChar: string; virtual;
  1761.     function PSGetTableName: string; virtual;
  1762.     function PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs; virtual;
  1763.     function PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError; virtual;
  1764.     function PSInTransaction: Boolean; virtual;
  1765.     function PSIsSQLBased: Boolean; virtual;
  1766.     function PSIsSQLSupported: Boolean; virtual;
  1767.     procedure PSReset; virtual;
  1768.     procedure PSSetParams(AParams: TParams); virtual;
  1769.     procedure PSSetCommandText(const CommandText: string); virtual;
  1770.     procedure PSStartTransaction; virtual;
  1771.     function PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean; virtual;
  1772.   protected
  1773.     procedure ResetAggField(Field: TField); virtual;
  1774.     procedure BindFields(Binding: Boolean);
  1775.     function BookmarkAvailable: Boolean;
  1776.     procedure CalculateFields(Buffer: PChar); virtual;
  1777.     procedure CheckActive; virtual;
  1778.     procedure CheckFieldCompatibility(Field: TField; FieldDef: TFieldDef); virtual;
  1779.     procedure CheckInactive; virtual;
  1780.     procedure ClearBuffers; virtual;
  1781.     procedure ClearCalcFields(Buffer: PChar); virtual;
  1782.     procedure CloseBlob(Field: TField); virtual;
  1783.     procedure CloseCursor; virtual;
  1784.     procedure CreateFields; virtual;
  1785.     function CreateNestedDataSet(DataSetField: TDataSetField): TDataSet; virtual;
  1786.     procedure DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean); virtual;
  1787.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  1788.     procedure DefChanged(Sender: TObject); virtual;
  1789.     procedure DestroyFields; virtual;
  1790.     procedure DoAfterCancel; virtual;
  1791.     procedure DoAfterClose; virtual;
  1792.     procedure DoAfterDelete; virtual;
  1793.     procedure DoAfterEdit; virtual;
  1794.     procedure DoAfterInsert; virtual;
  1795.     procedure DoAfterOpen; virtual;
  1796.     procedure DoAfterPost; virtual;
  1797.     procedure DoAfterRefresh; virtual;
  1798.     procedure DoAfterScroll; virtual;
  1799.     procedure DoBeforeCancel; virtual;
  1800.     procedure DoBeforeClose; virtual;
  1801.     procedure DoBeforeDelete; virtual;
  1802.     procedure DoBeforeEdit; virtual;
  1803.     procedure DoBeforeInsert; virtual;
  1804.     procedure DoBeforeOpen; virtual;
  1805.     procedure DoBeforePost; virtual;
  1806.     procedure DoBeforeRefresh; virtual;
  1807.     procedure DoBeforeScroll; virtual;
  1808.     procedure DoOnCalcFields; virtual;
  1809.     procedure DoOnNewRecord; virtual;
  1810.     function FieldByNumber(FieldNo: Integer): TField;
  1811.     function FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
  1812.     procedure OpenCursorComplete;
  1813.     procedure FreeFieldBuffers; virtual;
  1814.     function GetAggregateValue(Field: TField): Variant; virtual;
  1815.     function GetAggRecordCount(Grp: TGroupPosInd): Integer; virtual;
  1816.     procedure ActivateBuffers; virtual;
  1817.     function GetBookmarkStr: TBookmarkStr; virtual;
  1818.     procedure GetCalcFields(Buffer: PChar); virtual;
  1819.     function GetCanModify: Boolean; virtual;
  1820.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  1821.     function GetDataSource: TDataSource; virtual;
  1822.     function GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
  1823.     function GetFieldFullName(Field: TField): string; virtual;
  1824.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; virtual;
  1825.     function GetIsIndexField(Field: TField): Boolean; virtual;
  1826.     function GetIndexDefs(IndexDefs: TIndexDefs; IndexTypes: TIndexOptions): TIndexDefs;
  1827.     function GetNextRecords: Integer; virtual;
  1828.     function GetNextRecord: Boolean; virtual;
  1829.     function GetPriorRecords: Integer; virtual;
  1830.     function GetPriorRecord: Boolean; virtual;
  1831.     function GetRecordCount: Integer; virtual;
  1832.     function GetRecNo: Integer; virtual;
  1833.     procedure InitFieldDefs; virtual;
  1834.     procedure InitFieldDefsFromFields;
  1835.     procedure InitRecord(Buffer: PChar); virtual;
  1836.     procedure InternalCancel; virtual;
  1837.     procedure InternalEdit; virtual;
  1838.     procedure InternalInsert; virtual;
  1839.     procedure InternalRefresh; virtual;
  1840.     procedure Loaded; override;
  1841.     procedure OpenCursor(InfoQuery: Boolean = False); virtual;
  1842.     procedure OpenParentDataSet(ParentDataSet: TDataSet);
  1843.     procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
  1844.     procedure RestoreState(const Value: TDataSetState);
  1845.     procedure BlockReadNext; virtual;
  1846.     procedure SetActive(Value: Boolean); virtual;
  1847.     procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
  1848.     procedure SetBlockReadSize(Value: Integer); virtual;
  1849.     procedure SetBufListSize(Value: Integer);
  1850.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  1851.     procedure SetCurrentRecord(Index: Integer); virtual;
  1852.     procedure SetDataSetField(const Value: TDataSetField); virtual;
  1853.     procedure SetDefaultFields(const Value: Boolean);
  1854.     procedure SetFiltered(Value: Boolean); virtual;
  1855.     procedure SetFilterOptions(Value: TFilterOptions); virtual;
  1856.     procedure SetFilterText(const Value: string); virtual;
  1857.     procedure SetFound(const Value: Boolean);
  1858.     procedure SetModified(Value: Boolean);
  1859.     procedure SetName(const Value: TComponentName); override;
  1860.     procedure SetObjectView(const Value: Boolean);
  1861.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
  1862.     procedure SetRecNo(Value: Integer); virtual;
  1863.     procedure SetState(Value: TDataSetState);
  1864.     procedure SetStateFieldValue(State: TDataSetState; Field: TField; const Value: Variant); virtual;
  1865.     function SetTempState(const Value: TDataSetState): TDataSetState;
  1866.     function TempBuffer: PChar;
  1867.     procedure UpdateBufferCount;
  1868.     procedure UpdateIndexDefs; virtual;
  1869.     property ActiveRecord: Integer read FActiveRecord;
  1870.     property CurrentRecord: Integer read FCurrentRecord;
  1871.     property BlobFieldCount: Integer read FBlobFieldCount;
  1872.     property BookmarkSize: Integer read FBookmarkSize write FBookmarkSize;
  1873.     property Buffers[Index: Integer]: PChar read GetBuffer;
  1874.     property BufferCount: Integer read FBufferCount;
  1875.     property CalcBuffer: PChar read FCalcBuffer;
  1876.     property CalcFieldsSize: Integer read FCalcFieldsSize;
  1877.     property Constraints: TCheckConstraints read FConstraints write SetConstraints;
  1878.     property FieldNoOfs: Integer read FFieldNoOfs write FFieldNoOfs;
  1879.     property InternalCalcFields: Boolean read FInternalCalcFields;
  1880.     property NestedDataSets: TList read GetNestedDataSets;
  1881.     property NestedDataSetClass: TClass read FNestedDataSetClass write FNestedDataSetClass;
  1882.     property Reserved: Pointer read FReserved write FReserved;
  1883.   protected { abstract methods }
  1884.     function AllocRecordBuffer: PChar; virtual; abstract;
  1885.     procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
  1886.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  1887.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
  1888.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
  1889.     function GetRecordSize: Word; virtual; abstract;
  1890.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
  1891.     procedure InternalClose; virtual; abstract;
  1892.     procedure InternalDelete; virtual; abstract;
  1893.     procedure InternalFirst; virtual; abstract;
  1894.     procedure InternalGotoBookmark(Bookmark: Pointer); virtual; abstract;
  1895.     procedure InternalHandleException; virtual; abstract;
  1896.     procedure InternalInitFieldDefs; virtual; abstract;
  1897.     procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
  1898.     procedure InternalLast; virtual; abstract;
  1899.     procedure InternalOpen; virtual; abstract;
  1900.     procedure InternalPost; virtual; abstract;
  1901.     procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
  1902.     function IsCursorOpen: Boolean; virtual; abstract;
  1903.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
  1904.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  1905.     procedure SetFieldData(Field: TField; Buffer: Pointer); overload; virtual; abstract;
  1906.     procedure SetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean); overload; virtual;
  1907.   public
  1908.     constructor Create(AOwner: TComponent); override;
  1909.     destructor Destroy; override;
  1910.     function ActiveBuffer: PChar;
  1911.     procedure Append;
  1912.     procedure AppendRecord(const Values: array of const);
  1913.     function BookmarkValid(Bookmark: TBookmark): Boolean; virtual;
  1914.     procedure Cancel; virtual;
  1915.     procedure CheckBrowseMode;
  1916.     procedure ClearFields;
  1917.     procedure Close;
  1918.     function  ControlsDisabled: Boolean;
  1919.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; virtual;
  1920.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
  1921.     procedure CursorPosChanged;
  1922.     procedure Delete;
  1923.     procedure DisableControls;
  1924.     procedure Edit;
  1925.     procedure EnableControls;
  1926.     function FieldByName(const FieldName: string): TField;
  1927.     function FindField(const FieldName: string): TField;
  1928.     function FindFirst: Boolean;
  1929.     function FindLast: Boolean;
  1930.     function FindNext: Boolean;
  1931.     function FindPrior: Boolean;
  1932.     procedure First;
  1933.     procedure FreeBookmark(Bookmark: TBookmark); virtual;
  1934.     function GetBookmark: TBookmark; virtual;
  1935.     function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
  1936.     procedure GetDetailDataSets(List: TList);
  1937.     procedure GetDetailLinkFields(MasterFields, DetailFields: TList); virtual;
  1938.     function GetBlobFieldData(FieldNo: Integer; var Buffer: TBlobByteData): Integer; virtual;
  1939.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; overload; virtual;
  1940.     function GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean; overload; virtual;
  1941.     function GetFieldData(Field: TField; Buffer: Pointer; NativeFormat: Boolean): Boolean; overload; virtual;
  1942.     procedure GetFieldList(List: TList; const FieldNames: string);
  1943.     procedure GetFieldNames(List: TStrings);
  1944.     procedure GotoBookmark(Bookmark: TBookmark);
  1945.     procedure Insert;
  1946.     procedure InsertRecord(const Values: array of const);
  1947.     function IsEmpty: Boolean;
  1948.     function IsLinkedTo(DataSource: TDataSource): Boolean;
  1949.     function IsSequenced: Boolean; virtual;
  1950.     procedure Last;
  1951.     function Locate(const KeyFields: string; const KeyValues: Variant;
  1952.       Options: TLocateOptions): Boolean; virtual;
  1953.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  1954.       const ResultFields: string): Variant; virtual;
  1955.     function MoveBy(Distance: Integer): Integer;
  1956.     procedure Next;
  1957.     procedure Open;
  1958.     procedure Post; virtual;
  1959.     procedure Prior;
  1960.     procedure Refresh;
  1961.     procedure Resync(Mode: TResyncMode); virtual;
  1962.     procedure SetFields(const Values: array of const);
  1963.     function Translate(Src, Dest: PChar; ToOem: Boolean): Integer; virtual;
  1964.     procedure UpdateCursorPos;
  1965.     procedure UpdateRecord;
  1966.     function UpdateStatus: TUpdateStatus; virtual;
  1967.     property AggFields: TFields read FAggFields;
  1968.     property Bof: Boolean read FBOF;
  1969.     property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
  1970.     property CanModify: Boolean read GetCanModify;
  1971.     property DataSetField: TDataSetField read FDataSetField write SetDataSetField;
  1972.     property DataSource: TDataSource read GetDataSource;
  1973.     property DefaultFields: Boolean read FDefaultFields;
  1974.     property Designer: TDataSetDesigner read FDesigner;
  1975.     property Eof: Boolean read FEOF; {Upper case EOF conflicts with C++}
  1976.     property BlockReadSize: Integer read FBlockReadSize write SetBlockReadSize;
  1977.     property FieldCount: Integer read GetFieldCount;
  1978.     property FieldDefs: TFieldDefs read FFieldDefs write SetFieldDefs;
  1979.     property FieldDefList: TFieldDefList read FFieldDefList;
  1980.     property Fields: TFields read FFields;
  1981.     property FieldList: TFieldList read FFieldList;
  1982.     property FieldValues[const FieldName: string]: Variant read GetFieldValue write SetFieldValue; default;
  1983.     property Found: Boolean read GetFound;
  1984.     property Modified: Boolean read FModified;
  1985.     property ObjectView: Boolean read FObjectView write SetObjectView;
  1986.     property RecordCount: Integer read GetRecordCount;
  1987.     property RecNo: Integer read GetRecNo write SetRecNo;
  1988.     property RecordSize: Word read GetRecordSize;
  1989.     property SparseArrays: Boolean read FSparseArrays write SetSparseArrays;
  1990.     property State: TDataSetState read FState;
  1991.     property Filter: string read FFilterText write SetFilterText;
  1992.     property Filtered: Boolean read FFiltered write SetFiltered default False;
  1993.     property FilterOptions: TFilterOptions read FFilterOptions write SetFilterOptions default [];
  1994.     property Active: Boolean read GetActive write SetActive default False;
  1995.     property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields default True;
  1996.     property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
  1997.     property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
  1998.     property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
  1999.     property AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
  2000.     property BeforeInsert: TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
  2001.     property AfterInsert: TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
  2002.     property BeforeEdit: TDataSetNotifyEvent read FBeforeEdit write FBeforeEdit;
  2003.     property AfterEdit: TDataSetNotifyEvent read FAfterEdit write FAfterEdit;
  2004.     property BeforePost: TDataSetNotifyEvent read FBeforePost write FBeforePost;
  2005.     property AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
  2006.     property BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
  2007.     property AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
  2008.     property BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
  2009.     property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
  2010.     property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
  2011.     property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
  2012.     property BeforeRefresh: TDataSetNotifyEvent read FBeforeRefresh write FBeforeRefresh;
  2013.     property AfterRefresh: TDataSetNotifyEvent read FAfterRefresh write FAfterRefresh;
  2014.     property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
  2015.     property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
  2016.     property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
  2017.     property OnFilterRecord: TFilterRecordEvent read FOnFilterRecord write SetOnFilterRecord;
  2018.     property OnNewRecord: TDataSetNotifyEvent read FOnNewRecord write FOnNewRecord;
  2019.     property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
  2020.   end;
  2021.  
  2022. { TDateTimeRec }
  2023.  
  2024. type
  2025.   TDateTimeAlias = type TDateTime;
  2026.   {$NODEFINE TDateTimeAlias}
  2027.   (*$HPPEMIT 'namespace Db'*)
  2028.   (*$HPPEMIT '{'*)
  2029.   (*$HPPEMIT '    typedef TDateTimeBase TDateTimeAlias;'*)
  2030.   (*$HPPEMIT '}'*)
  2031.   TDateTimeRec = record
  2032.     case TFieldType of
  2033.       ftDate: (Date: Longint);
  2034.       ftTime: (Time: Longint);
  2035.       ftDateTime: (DateTime: TDateTimeAlias);
  2036.   end;
  2037.  
  2038. const
  2039.   { The following field types do not support assignment as text, unless the
  2040.     field object's OnSetText event is assigned to perform the text to
  2041.     binary conversion. }
  2042.   ftNonTextTypes = [ftBytes, ftVarBytes, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
  2043.     ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftADT, ftArray,
  2044.     ftReference, ftDataSet];
  2045.  
  2046.   { Field types with a fixed size.  TField.Size = 0 for all of these }
  2047.   ftFixedSizeTypes = [ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat,
  2048.     ftCurrency, ftDate, ftTime, ftDateTime, ftAutoInc, ftLargeint];
  2049.  
  2050.   dsEditModes = [dsEdit, dsInsert, dsSetKey];
  2051.   dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter,
  2052.     dsNewValue, dsInternalCalc];
  2053.  
  2054.   DefaultFieldClasses: array[TFieldType] of TFieldClass = (
  2055.     nil,                { ftUnknown }
  2056.     TStringField,       { ftString }
  2057.     TSmallintField,     { ftSmallint }
  2058.     TIntegerField,      { ftInteger }
  2059.     TWordField,         { ftWord }
  2060.     TBooleanField,      { ftBoolean }
  2061.     TFloatField,        { ftFloat }
  2062.     TCurrencyField,     { ftCurrency }
  2063.     TBCDField,          { ftBCD }
  2064.     TDateField,         { ftDate }
  2065.     TTimeField,         { ftTime }
  2066.     TDateTimeField,     { ftDateTime }
  2067.     TBytesField,        { ftBytes }
  2068.     TVarBytesField,     { ftVarBytes }
  2069.     TAutoIncField,      { ftAutoInc }
  2070.     TBlobField,         { ftBlob }
  2071.     TMemoField,         { ftMemo }
  2072.     TGraphicField,      { ftGraphic }
  2073.     TBlobField,         { ftFmtMemo }
  2074.     TBlobField,         { ftParadoxOle }
  2075.     TBlobField,         { ftDBaseOle }
  2076.     TBlobField,         { ftTypedBinary }
  2077.     nil,                { ftCursor }
  2078.     TStringField,       { ftFixedChar }
  2079.     TWideStringField,   { ftWideString }
  2080.     TLargeIntField,     { ftLargeInt }
  2081.     TADTField,          { ftADT }
  2082.     TArrayField,        { ftArray }
  2083.     TReferenceField,    { ftReference }
  2084.     TDataSetField,      { ftDataSet }
  2085.     TBlobField,         { ftOraBlob }
  2086.     TMemoField,         { ftOraClob }
  2087.     TVariantField,      { ftVariant }
  2088.     TInterfaceField,    { ftInterface }
  2089.     TIDispatchField,     { ftIDispatch }
  2090.     TGuidField);        { ftGuid }
  2091.  
  2092.   FieldTypeNames: array[TFieldType] of string = (
  2093.     'Unknown', 'String', 'SmallInt', 'Integer', 'Word', 'Boolean', 'Float',
  2094.     'Currency', 'BCD', 'Date', 'Time', 'DateTime', 'Bytes', 'VarBytes',
  2095.     'AutoInc', 'Blob', 'Memo', 'Graphic', 'FmtMemo', 'ParadoxOle',
  2096.     'dBaseOle', 'TypedBinary', 'Cursor', 'FixedChar', 'WideString',
  2097.     'LargeInt', 'ADT', 'Array', 'Reference', 'DataSet', 'OraBlob', 'OraClob',
  2098.     'Variant', 'Interface', 'Dispatch', 'Guid');
  2099.  
  2100.   FieldTypeVarMap: array[TFieldType] of Word = (
  2101.     varEmpty, varString, varInteger, varInteger, varInteger,
  2102.     varBoolean, varDouble, varCurrency, varCurrency, varDate, varDate, varDate,
  2103.     varEmpty, varEmpty, varInteger, varEmpty, varString, varEmpty,
  2104.     varEmpty, varEmpty, varEmpty, varEmpty, varEmpty, varString, varOleStr,
  2105.     varEmpty, varEmpty, varEmpty, varEmpty, varEmpty, varEmpty, varEmpty,
  2106.     varVariant, varUnknown, varDispatch, varString);
  2107.  
  2108.   ObjectFieldTypes = [ftADT, ftArray, ftReference, ftDataSet];
  2109.  
  2110.   dsMaxStringSize = 8192; { Maximum string field size }
  2111.   RegisterFieldsProc: procedure(const FieldClassess: array of TFieldClass) = nil;
  2112.  
  2113. { Global Functions }
  2114.   
  2115. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  2116. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  2117.  
  2118. procedure DatabaseError(const Message: string; Component: TComponent = nil);
  2119. procedure DatabaseErrorFmt(const Message: string; const Args: array of const;
  2120.   Component: TComponent = nil);
  2121.  
  2122. procedure DisposeMem(var Buffer; Size: Integer);
  2123. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
  2124. function BCDToCurr(const BCD: TBcd; var Curr: Currency): Boolean;
  2125. function CurrToBCD(Curr: Currency; var BCD: TBcd; Precision: Integer = 32;
  2126.   Decimals: Integer = 4): Boolean;
  2127.  
  2128. function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
  2129.   const FieldName: string): TField;
  2130.  
  2131. function VarTypeToDataType(VarType: Integer): TFieldType;
  2132.  
  2133. implementation
  2134.  
  2135. uses DBConsts, Mask, Consts, ComObj, ActiveX;
  2136.  
  2137. { Paradox graphic BLOB header }
  2138.  
  2139. type
  2140.   TGraphicHeader = record
  2141.     Count: Word;                { Fixed at 1 }
  2142.     HType: Word;                { Fixed at $0100 }
  2143.     Size: Longint;              { Size not including header }
  2144.   end;
  2145.  
  2146. { Error and exception handling routines }
  2147.  
  2148. { EUpdateError }
  2149.  
  2150. constructor EUpdateError.Create(NativeError, Context: string;
  2151.   ErrCode, PrevError: Integer; E: Exception);
  2152. begin
  2153.   FContext := Context;
  2154.   FErrorCode := ErrCode;
  2155.   FPreviousError := PrevError;
  2156.   FOriginalException := E;
  2157.   inherited Create(NativeError);
  2158. end;
  2159.  
  2160. destructor EUpdateError.Destroy;
  2161. begin
  2162.   FOriginalException.Free;
  2163.   inherited Destroy;
  2164. end;
  2165.  
  2166. procedure DatabaseError(const Message: string; Component: TComponent = nil);
  2167. begin
  2168.   if Assigned(Component) and (Component.Name <> '') then
  2169.     raise EDatabaseError.Create(Format('%s: %s', [Component.Name, Message])) else
  2170.     raise EDatabaseError.Create(Message);
  2171. end;
  2172.  
  2173. procedure DatabaseErrorFmt(const Message: string; const Args: array of const;
  2174.   Component: TComponent = nil);
  2175. begin
  2176.   DatabaseError(Format(Message, Args), Component);
  2177. end;
  2178.  
  2179. function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
  2180.   const FieldName: string): TField;
  2181. begin
  2182.   Result := DataSet.FindField(FieldName);
  2183.   if Result = nil then
  2184.     DatabaseErrorFmt(SFieldNotFound, [FieldName], Control);
  2185. end;
  2186.  
  2187. { Utility routines }
  2188.  
  2189. procedure DisposeMem(var Buffer; Size: Integer);
  2190. begin
  2191.   if Pointer(Buffer) <> nil then
  2192.   begin
  2193.     FreeMem(Pointer(Buffer), Size);
  2194.     Pointer(Buffer) := nil;
  2195.   end;
  2196. end;
  2197.  
  2198. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean; assembler;
  2199. asm
  2200.         PUSH    EDI
  2201.         PUSH    ESI
  2202.         MOV     ESI,Buf1
  2203.         MOV     EDI,Buf2
  2204.         XOR     EAX,EAX
  2205.         JECXZ   @@1
  2206.         CLD
  2207.         REPE    CMPSB
  2208.         JNE     @@1
  2209.         INC     EAX
  2210. @@1:    POP     ESI
  2211.         POP     EDI
  2212. end;
  2213.  
  2214. function CurrToBCD(Curr: Currency; var BCD: TBcd; Precision: Integer = 32;
  2215.   Decimals: Integer = 4): Boolean;
  2216. const
  2217.   Power10: array[0..3] of Single = (10000, 1000, 100, 10);
  2218. var
  2219.   Digits: array[0..63] of Byte;
  2220. asm
  2221.         PUSH    EBX
  2222.         PUSH    ESI
  2223.         PUSH    EDI
  2224.         MOV     ESI,EAX
  2225.         XCHG    ECX,EDX
  2226.         MOV     [ESI].TBcd.Precision,CL
  2227.         MOV     [ESI].TBcd.SignSpecialPlaces,DL
  2228. @@1:    SUB     EDX,4
  2229.         JE      @@3
  2230.         JA      @@2
  2231.         FILD    Curr
  2232.         FDIV    Power10.Single[EDX*4+16]
  2233.         FISTP   Curr
  2234.         JMP     @@3
  2235. @@2:    DEC     ECX
  2236.         MOV     Digits.Byte[ECX],0
  2237.         DEC     EDX
  2238.         JNE     @@2
  2239. @@3:    MOV     EAX,Curr.Integer[0]
  2240.         MOV     EBX,Curr.Integer[4]
  2241.         OR      EBX,EBX
  2242.         JNS     @@4
  2243.         NEG     EBX
  2244.         NEG     EAX
  2245.         SBB     EBX,0
  2246.         OR      [ESI].TBcd.SignSpecialPlaces,80H
  2247. @@4:    MOV     EDI,10
  2248. @@5:    MOV     EDX,EAX
  2249.         OR      EDX,EBX
  2250.         JE      @@7
  2251.         XOR     EDX,EDX
  2252.         OR      EBX,EBX
  2253.         JE      @@6
  2254.         XCHG    EAX,EBX
  2255.         DIV     EDI
  2256.         XCHG    EAX,EBX
  2257. @@6:    DIV     EDI
  2258. @@7:    MOV     Digits.Byte[ECX-1],DL
  2259.         DEC     ECX
  2260.         JNE     @@5
  2261.         OR      EAX,EBX
  2262.         MOV     AL,0
  2263.         JNE     @@9
  2264.         MOV     CL,[ESI].TBcd.Precision
  2265.         INC     ECX
  2266.         SHR     ECX,1
  2267. @@8:    MOV     AX,Digits.Word[ECX*2-2]
  2268.         SHL     AL,4
  2269.         OR      AL,AH
  2270.         MOV     [ESI].TBcd.Fraction.Byte[ECX-1],AL
  2271.         DEC     ECX
  2272.         JNE     @@8
  2273.         MOV     AL,1
  2274. @@9:    POP     EDI
  2275.         POP     ESI
  2276.         POP     EBX
  2277. end;
  2278.  
  2279. function BCDToCurr(const BCD: TBcd; var Curr: Currency): Boolean;
  2280. const
  2281.   FConst10: Single = 10;
  2282.   CWNear: Word = $133F;
  2283. var
  2284.   CtrlWord: Word;
  2285.   Temp: Integer;
  2286.   Digits: array[0..63] of Byte;
  2287. asm
  2288.         PUSH    EBX
  2289.         PUSH    ESI
  2290.         MOV     EBX,EAX
  2291.         MOV     ESI,EDX
  2292.         MOV     AL,0
  2293.         MOVZX   EDX,[EBX].TBcd.Precision
  2294.         OR      EDX,EDX
  2295.         JE      @@8
  2296.         LEA     ECX,[EDX+1]
  2297.         SHR     ECX,1
  2298. @@1:    MOV     AL,[EBX].TBcd.Fraction.Byte[ECX-1]
  2299.         MOV     AH,AL
  2300.         SHR     AL,4
  2301.         AND     AH,0FH
  2302.         MOV     Digits.Word[ECX*2-2],AX
  2303.         DEC     ECX
  2304.         JNE     @@1
  2305.         XOR     EAX,EAX
  2306. @@2:    MOV     AL,Digits.Byte[ECX]
  2307.         OR      AL,AL
  2308.         JNE     @@3
  2309.         INC     ECX
  2310.         CMP     ECX,EDX
  2311.         JNE     @@2
  2312.         FLDZ
  2313.         JMP     @@7
  2314. @@3:    MOV     Temp,EAX
  2315.         FILD    Temp
  2316. @@4:    INC     ECX
  2317.         CMP     ECX,EDX
  2318.         JE      @@5
  2319.         FMUL    FConst10
  2320.         MOV     AL,Digits.Byte[ECX]
  2321.         MOV     Temp,EAX
  2322.         FIADD   Temp
  2323.         JMP     @@4
  2324. @@5:    MOV     AL,[EBX].TBcd.SignSpecialPlaces
  2325.         OR      AL,AL
  2326.         JNS     @@6
  2327.         FCHS
  2328. @@6:    AND     EAX,3FH
  2329.         SUB     EAX,4
  2330.         NEG     EAX
  2331.         CALL    FPower10
  2332. @@7:    FSTCW   CtrlWord
  2333.         FLDCW   CWNear
  2334.         FISTP   [ESI].Currency
  2335.         FSTSW   AX
  2336.         NOT     AL
  2337.         AND     AL,1
  2338.         FCLEX
  2339.         FLDCW   CtrlWord
  2340.         FWAIT
  2341. @@8:    POP     ESI
  2342.         POP     EBX
  2343. end;
  2344.  
  2345. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  2346. var
  2347.   I: Integer;
  2348. begin
  2349.   I := Pos;
  2350.   while (I <= Length(Fields)) and (Fields[I] <> ';') do Inc(I);
  2351.   Result := Trim(Copy(Fields, Pos, I - Pos));
  2352.   if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I);
  2353.   Pos := I;
  2354. end;
  2355.  
  2356. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  2357. begin
  2358.   if Assigned(RegisterFieldsProc) then
  2359.     RegisterFieldsProc(FieldClasses) else
  2360.     DatabaseError(SInvalidFieldRegistration);
  2361. end;
  2362.  
  2363. function VarTypeToDataType(VarType: Integer): TFieldType;
  2364. begin
  2365.   case VarType of
  2366.     varSmallint, varByte: Result := ftSmallInt;
  2367.     varInteger: Result := ftInteger;
  2368.     varCurrency: Result := ftBCD;
  2369.     varSingle, varDouble: Result := ftFloat;
  2370.     varDate: Result := ftDateTime;
  2371.     varBoolean: Result := ftBoolean;
  2372.     varString, varOleStr: Result := ftString;
  2373.   else
  2374.     Result := ftUnknown;
  2375.   end;
  2376. end;
  2377.  
  2378. { TCustomConnection }
  2379.  
  2380. constructor TCustomConnection.Create(AOwner: TComponent);
  2381. begin
  2382.   inherited Create(AOwner);
  2383.   FDataSets := TList.Create;
  2384.   FClients := TList.Create;
  2385.   FConnectEvents := TList.Create;
  2386. end;
  2387.  
  2388. destructor TCustomConnection.Destroy;
  2389. begin
  2390.   inherited Destroy;
  2391.   SetConnected(False);
  2392.   FreeAndNil(FConnectEvents);
  2393.   FreeAndNil(FClients);
  2394.   FreeAndNil(FDataSets);
  2395. end;
  2396.  
  2397. procedure TCustomConnection.Loaded;
  2398. begin
  2399.   inherited Loaded;
  2400.   try
  2401.     if FStreamedConnected then SetConnected(True);
  2402.   except
  2403.     on E: Exception do
  2404.       if csDesigning in ComponentState then
  2405.         ShowException(E, ExceptAddr) else
  2406.         raise;
  2407.   end;
  2408. end;
  2409.  
  2410. procedure TCustomConnection.Open;
  2411. begin
  2412.   SetConnected(True);
  2413. end;
  2414.  
  2415. procedure TCustomConnection.Close;
  2416. begin
  2417.   SetConnected(False);
  2418. end;
  2419.  
  2420. procedure TCustomConnection.SetConnected(Value: Boolean);
  2421. begin
  2422.   if (csReading in ComponentState) and Value then
  2423.     FStreamedConnected := True else
  2424.   begin
  2425.     if Value = GetConnected then Exit;
  2426.     if Value then
  2427.     begin
  2428.       if Assigned(BeforeConnect) then BeforeConnect(Self);
  2429.       DoConnect;
  2430.       SendConnectEvent(True);
  2431.       if Assigned(AfterConnect) then AfterConnect(Self);
  2432.     end else
  2433.     begin
  2434.       if Assigned(BeforeDisconnect) then BeforeDisconnect(Self);
  2435.       SendConnectEvent(False);
  2436.       DoDisconnect;
  2437.       if Assigned(AfterDisconnect) then AfterDisconnect(Self);
  2438.     end;
  2439.   end;
  2440. end;
  2441.  
  2442. procedure TCustomConnection.DoConnect;
  2443. begin
  2444. end;
  2445.  
  2446. procedure TCustomConnection.DoDisconnect;
  2447. begin
  2448. end;
  2449.  
  2450. function TCustomConnection.GetConnected: Boolean;
  2451. begin
  2452.   Result := False;
  2453. end;
  2454.  
  2455. procedure TCustomConnection.SendConnectEvent(Connecting: Boolean);
  2456. var
  2457.   I: Integer;
  2458.   ConnectEvent: TConnectChangeEvent;
  2459. begin
  2460.   for I := 0 to FClients.Count - 1 do
  2461.   begin
  2462.     if FConnectEvents[I] <> nil then
  2463.     begin
  2464.       TMethod(ConnectEvent).Code := FConnectEvents[I];
  2465.       TMethod(ConnectEvent).Data := FClients[I];
  2466.       ConnectEvent(Self, Connecting);
  2467.     end;
  2468.     if TObject(FClients[I]) is TDataset then
  2469.       TDataSet(FClients[I]).DataEvent(deConnectChange, Integer(Connecting));
  2470.   end;
  2471. end;
  2472.  
  2473. procedure TCustomConnection.RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil);
  2474. begin
  2475.   FClients.Add(Client);
  2476.   FConnectEvents.Add(TMethod(Event).Code);
  2477.   if Client is TDataSet then
  2478.     FDataSets.Add(Client);
  2479. end;
  2480.  
  2481. procedure TCustomConnection.UnRegisterClient(Client: TObject);
  2482. var
  2483.   Index: Integer;
  2484. begin
  2485.   if Client is TDataSet then
  2486.     FDataSets.Remove(Client);
  2487.   Index := FClients.IndexOf(Client);
  2488.   if Index <> -1 then
  2489.   begin
  2490.     FClients.Delete(Index);
  2491.     FConnectEvents.Delete(Index);
  2492.   end;
  2493. end;
  2494.  
  2495. function TCustomConnection.GetDataSet(Index: Integer): TDataSet;
  2496. begin
  2497.   Result := FDataSets[Index];
  2498. end;
  2499.  
  2500. function TCustomConnection.GetDataSetCount: Integer;
  2501. begin
  2502.   Result := FDataSets.Count;
  2503. end;
  2504.  
  2505. { TDataSetDesigner }
  2506.  
  2507. constructor TDataSetDesigner.Create(DataSet: TDataSet);
  2508. begin
  2509.   FDataSet := DataSet;
  2510.   FDataSet.FDesigner := Self;
  2511. end;
  2512.  
  2513. destructor TDataSetDesigner.Destroy;
  2514. begin
  2515.   FDataSet.FDesigner := nil;
  2516. end;
  2517.  
  2518. procedure TDataSetDesigner.BeginDesign;
  2519. begin
  2520.   FDataSet.DisableControls;
  2521.   FSaveActive := FDataSet.Active;
  2522.   if FSaveActive then
  2523.   begin
  2524.     FDataSet.SetState(dsInactive);
  2525.     FDataSet.CloseCursor;
  2526.   end;
  2527. end;
  2528.  
  2529. procedure TDataSetDesigner.DataEvent(Event: TDataEvent; Info: Longint);
  2530. begin
  2531. end;
  2532.  
  2533. procedure TDataSetDesigner.EndDesign;
  2534. begin
  2535.   if FSaveActive then
  2536.   begin
  2537.     try
  2538.       FDataSet.OpenCursor;
  2539.       FDataSet.SetState(dsBrowse);
  2540.     except
  2541.       FDataSet.EnableControls;
  2542.       FDataSet.SetState(dsInactive);
  2543.       FDataSet.CloseCursor;
  2544.       raise;
  2545.     end;
  2546.   end;
  2547.   FSaveActive := False;
  2548.   FDataSet.EnableControls;
  2549. end;
  2550.  
  2551. { TNamedItem }
  2552.  
  2553. function TNamedItem.GetDisplayName: string;
  2554. begin
  2555.   Result := FName;
  2556. end;
  2557.  
  2558. procedure TNamedItem.SetDisplayName(const Value: string);
  2559. begin
  2560.   if (Value <> '') and (AnsiCompareText(Value, FName) <> 0) and
  2561.     (Collection is TDefCollection) and
  2562.     (TDefCollection(Collection).IndexOf(Value) >= 0) then
  2563.     DatabaseErrorFmt(SDuplicateName, [Value, Collection.ClassName]);
  2564.   FName := Value;
  2565.   inherited;
  2566. end;
  2567.  
  2568. { TDefCollection }
  2569.  
  2570. constructor TDefCollection.Create(ADataSet: TDataSet; AOwner: TPersistent;
  2571.   AClass: TCollectionItemClass);
  2572. begin
  2573.   inherited Create(AOwner, AClass);
  2574.   FDataSet := ADataSet;
  2575.   FOnUpdate := DoUpdate;
  2576. end;
  2577.  
  2578. procedure TDefCollection.SetItemName(AItem: TCollectionItem);
  2579. begin
  2580.   with TNamedItem(AItem) do
  2581.     if (Name = '') and Assigned(DataSet) then
  2582.       Name := DataSet.Name + Copy(ClassName, 2, 5) + IntToStr(ID+1);
  2583. end;
  2584.  
  2585. procedure TDefCollection.Update(AItem: TCollectionItem);
  2586. begin
  2587.   if Assigned(DataSet) and not (csLoading in DataSet.ComponentState) then OnUpdate(AItem);
  2588. end;
  2589.  
  2590. procedure TDefCollection.DoUpdate(Sender: TObject);
  2591. begin
  2592.   if (FInternalUpdateCount = 0) then
  2593.   begin
  2594.     Updated := False;
  2595.     DataSet.DefChanged(Self);
  2596.   end;
  2597. end;
  2598.  
  2599. procedure TDefCollection.UpdateDefs(AMethod: TDefUpdateMethod);
  2600. begin
  2601.   if not Updated then
  2602.   begin
  2603.     Inc(FInternalUpdateCount);
  2604.     BeginUpdate;
  2605.     try
  2606.       AMethod;
  2607.     finally
  2608.       EndUpdate;
  2609.       Dec(FInternalUpdateCount);
  2610.     end;
  2611.     Updated := True; { Defs are now a mirror of data source }
  2612.   end;
  2613. end;
  2614.  
  2615. function TDefCollection.IndexOf(const AName: string): Integer;
  2616. begin
  2617.   for Result := 0 to Count - 1 do
  2618.     if AnsiCompareText(TNamedItem(Items[Result]).Name, AName) = 0 then Exit;
  2619.   Result := -1;
  2620. end;
  2621.  
  2622. function TDefCollection.Find(const AName: string): TNamedItem;
  2623. var
  2624.   I: Integer;
  2625. begin
  2626.   I := IndexOf(AName);
  2627.   if I < 0 then Result := nil else Result := TNamedItem(Items[I]);
  2628. end;
  2629.  
  2630. procedure TDefCollection.GetItemNames(List: TStrings);
  2631. var
  2632.   I: Integer;
  2633. begin
  2634.   List.BeginUpdate;
  2635.   try
  2636.     List.Clear;
  2637.     for I := 0 to Count - 1 do
  2638.       with TNamedItem(Items[I]) do
  2639.         if Name <> '' then List.Add(Name);
  2640.   finally
  2641.     List.EndUpdate;
  2642.   end;
  2643. end;
  2644.  
  2645. { TFieldDef }
  2646.  
  2647. constructor TFieldDef.Create(Owner: TFieldDefs; const Name: string;
  2648.   DataType: TFieldType; Size: Integer; Required: Boolean; FieldNo: Integer);
  2649. var
  2650.   FieldClass: TFieldClass;
  2651. begin
  2652.   inherited Create(Owner);
  2653.   FieldClass := Owner.FDataSet.GetFieldClass(DataType);
  2654.   if Assigned(FieldClass) then
  2655.     FieldClass.CheckTypeSize(Size);
  2656.   FName := Name;
  2657.   FDataType := DataType;
  2658.   FSize := Size;
  2659.   if Required then
  2660.     Include(FAttributes, faRequired);
  2661.   FFieldNo := FieldNo;
  2662. end;
  2663.  
  2664. destructor TFieldDef.Destroy;
  2665. begin
  2666.   inherited Destroy;
  2667.   FChildDefs.Free;
  2668. end;
  2669.  
  2670. procedure TFieldDef.ReadRequired(Reader: TReader);
  2671. begin
  2672.   SetRequired(Reader.ReadBoolean);
  2673. end;
  2674.  
  2675. procedure TFieldDef.DefineProperties(Filer: TFiler);
  2676. begin
  2677.   inherited DefineProperties(Filer);
  2678.   Filer.DefineProperty('Required', ReadRequired, nil, False);
  2679. end;
  2680.  
  2681. function TFieldDef.GetFieldClass: TFieldClass;
  2682. begin
  2683.   if Collection is TFieldDefs then
  2684.     Result := TFieldDefs(Collection).DataSet.GetFieldClass(DataType) else
  2685.     Result := nil;
  2686. end;
  2687.  
  2688. function TFieldDef.GetFieldNo: Integer;
  2689. begin
  2690.   if FFieldNo > 0 then
  2691.     Result := FFieldNo else
  2692.     Result := Index + 1;
  2693. end;
  2694.  
  2695. procedure TFieldDef.SetAttributes(Value: TFieldAttributes);
  2696. begin
  2697.   FAttributes := Value;
  2698.   Changed(False);
  2699. end;
  2700.  
  2701. procedure TFieldDef.SetDataType(Value: TFieldType);
  2702. const
  2703.   TypeSizes: packed array[TFieldType] of Byte =
  2704.     (0 {ftUnknown}, 20 {ftString}, 0 {ftSmallint}, 0 {ftInteger}, 0 {ftWord},
  2705.      0 {ftBoolean}, 0 {ftFloat}, 0 {ftCurrency}, 4 {ftBCD}, 0 {ftDate},
  2706.      0 {ftTime}, 0 {ftDateTime}, 16 {ftBytes}, 16 {ftVarBytes}, 0 {ftAutoInc},
  2707.      0 {ftBlob}, 0 {ftMemo}, 0 {ftGraphic}, 0 {ftFmtMemo}, 0 {ftParadoxOle},
  2708.      0 {ftDBaseOle}, 0 {ftTypedBinary}, 0 {ftCursor}, 20 { ftFixedChar },
  2709.      0 {ftWideString}, 0 {ftLargeInt} , 0 {ftADT}, 10 {ftArray}, 0 {ftReference},
  2710.      0 {ftDataSet}, 0 {ftOraBlob}, 0 {ftOraClob}, 0 {ftVariant}, 0 {ftInterface},
  2711.      0 {ftIDispatch}, 0 {ftGuid});
  2712. begin
  2713.   FDataType := Value;
  2714.   FPrecision := 0;
  2715.   FSize := TypeSizes[Value];
  2716.   Changed(False);
  2717. end;
  2718.  
  2719. procedure TFieldDef.SetPrecision(Value: Integer);
  2720. begin
  2721.   FPrecision := Value;
  2722.   Changed(False);
  2723. end;
  2724.  
  2725. function TFieldDef.GetRequired: Boolean;
  2726. begin
  2727.   Result := faRequired in Attributes;
  2728. end;
  2729.  
  2730. procedure TFieldDef.SetRequired(Value: Boolean);
  2731. begin
  2732.   if Value then
  2733.     Attributes := Attributes + [faRequired] else
  2734.     Attributes := Attributes - [faRequired];
  2735. end;
  2736.  
  2737. function TFieldDef.GetSize: Integer;
  2738. begin
  2739.   if HasChildDefs and (FSize = 0) then
  2740.     Result := FChildDefs.Count else
  2741.     Result := FSize;
  2742. end;
  2743.  
  2744. procedure TFieldDef.SetSize(Value: Integer);
  2745. var
  2746.   FClass: TFieldClass;
  2747. begin
  2748.   if HasChildDefs and (DataType <> ftArray) then Exit;
  2749.   FSize := Value;
  2750.   Changed(False);
  2751.   FClass := FieldClass;
  2752.   if Assigned(FClass) and (Size <> 0) then FClass.CheckTypeSize(Size);
  2753. end;
  2754.  
  2755. function TFieldDef.GetChildDefs: TFieldDefs;
  2756. begin
  2757.   if FChildDefs = nil then
  2758.     FChildDefs := TFieldDefs.Create(Self);
  2759.   Result := FChildDefs;
  2760. end;
  2761.  
  2762. procedure TFieldDef.SetChildDefs(Value: TFieldDefs);
  2763. begin
  2764.   ChildDefs.Assign(Value);
  2765. end;
  2766.  
  2767. function TFieldDef.HasChildDefs: Boolean;
  2768. begin
  2769.   Result := (FChildDefs <> nil) and (FChildDefs.Count > 0);
  2770. end;
  2771.  
  2772. function TFieldDef.AddChild: TFieldDef;
  2773. begin
  2774.   Result := ChildDefs.AddFieldDef;
  2775. end;
  2776.  
  2777. function TFieldDef.GetParentDef: TFieldDef;
  2778. begin
  2779.   Result := TFieldDefs(Collection).ParentDef;
  2780. end;
  2781.  
  2782. procedure TFieldDef.Assign(Source: TPersistent);
  2783. var
  2784.   I: Integer;
  2785.   S: TFieldDef;
  2786. begin
  2787.   if Source is TFieldDef then
  2788.   begin
  2789.     if Collection <> nil then Collection.BeginUpdate;
  2790.     try
  2791.       S := TFieldDef(Source);
  2792.       {FieldNo is defaulted}
  2793.       Name := S.Name;
  2794.       DataType := S.DataType;
  2795.       Size := S.Size;
  2796.       Precision := S.Precision;
  2797.       Attributes := S.Attributes;
  2798.       InternalCalcField := TFieldDef(Source).InternalCalcField;
  2799.       if HasChildDefs then ChildDefs.Clear;
  2800.       if S.HasChildDefs then
  2801.         for I := 0 to S.ChildDefs.Count - 1 do
  2802.           with AddChild do Assign(S.ChildDefs[I]);
  2803.     finally
  2804.       if Collection <> nil then Collection.EndUpdate;
  2805.     end;
  2806.   end else inherited;
  2807. end;
  2808.  
  2809. function TFieldDef.CreateFieldComponent(Owner: TComponent;
  2810.   ParentField: TObjectField = nil; FieldName: string = ''): TField;
  2811. var
  2812.   FieldClassType: TFieldClass;
  2813. begin
  2814.   FieldClassType := GetFieldClass;
  2815.   if FieldClassType = nil then DatabaseErrorFmt(SUnknownFieldType, [Name]);
  2816.   Result := FieldClassType.Create(Owner);
  2817.   try
  2818.     Result.Size := Size;
  2819.     if FieldName <> '' then
  2820.       Result.FieldName := FieldName else
  2821.       Result.FieldName := Name;
  2822.     Result.Required := faRequired in Attributes;
  2823.     Result.ReadOnly := faReadonly in Attributes;
  2824.     Result.SetFieldType(DataType);
  2825.     if Result is TBCDField then
  2826.       TBCDField(Result).FPrecision := Precision;
  2827.     if Assigned(ParentField) then
  2828.       Result.ParentField := ParentField else
  2829.       Result.DataSet := TFieldDefs(Collection).DataSet;
  2830.     if ((faFixed in Attributes) or (DataType = ftFixedChar)) and (Result is TStringField) then
  2831.       TStringField(Result).FixedChar := True;
  2832.     if InternalCalcField then
  2833.       Result.FieldKind := fkInternalCalc;
  2834.     if (faUnNamed in Attributes) and (Result is TObjectField) then
  2835.       TObjectField(Result).SetUnNamed(True);
  2836.   except
  2837.     Result.Free;
  2838.     raise;
  2839.   end;
  2840. end;
  2841.  
  2842. function TFieldDef.CreateField(Owner: TComponent; ParentField: TObjectField = nil;
  2843.   const FieldName: string = ''; CreateChildren: Boolean = True): TField;
  2844. var
  2845.   FieldCount, I: Integer;
  2846. begin
  2847.   Result := CreateFieldComponent(Owner, ParentField, FieldName);
  2848.   if CreateChildren and HasChildDefs then
  2849.   begin
  2850.     if (DataType = ftArray) then
  2851.     begin
  2852.       if TFieldDefs(Collection).DataSet.SparseArrays then
  2853.         FieldCount := 1 else
  2854.         FieldCount := Size;
  2855.       for I := 0 to FieldCount - 1 do
  2856.         ChildDefs[0].CreateField(nil, TObjectField(Result), Format('%s[%d]',
  2857.           [Result.FieldName, I]))
  2858.     end else
  2859.       for I := 0 to ChildDefs.Count - 1 do
  2860.         ChildDefs[I].CreateField(nil, TObjectField(Result), '');
  2861.   end;
  2862. end;
  2863.  
  2864. { TFieldDefs }
  2865.  
  2866. constructor TFieldDefs.Create(AOwner: TPersistent);
  2867. var
  2868.   ADataSet: TDataSet;
  2869. begin
  2870.   if AOwner is TFieldDef then
  2871.   begin
  2872.     FParentDef := TFieldDef(AOwner);
  2873.     ADataSet := TFieldDefs(FParentDef.Collection).DataSet
  2874.   end else
  2875.     ADataSet := AOwner as TDataSet;
  2876.   inherited Create(ADataSet, AOwner, TFieldDef);
  2877.   if FParentDef <> nil then
  2878.     OnUpdate := ChildDefUpdate;
  2879. end;
  2880.  
  2881. procedure TFieldDefs.SetItemName(AItem: TCollectionItem);
  2882. begin
  2883.   if GetOwner = DataSet then
  2884.     inherited SetItemName(AItem)
  2885.   else with TNamedItem(AItem) do
  2886.     if Name = '' then
  2887.       Name := TFieldDef(Self.GetOwner).Name + Copy(ClassName, 2, 5) + IntToStr(ID+1);
  2888. end;
  2889.  
  2890. function TFieldDefs.AddFieldDef: TFieldDef;
  2891. begin
  2892.   Result := TFieldDef(inherited Add);
  2893. end;
  2894.  
  2895. procedure TFieldDefs.Add(const Name: string; DataType: TFieldType;
  2896.   Size: Integer; Required: Boolean);
  2897. var
  2898.   FieldDef: TFieldDef;
  2899. begin
  2900.   if Name = '' then DatabaseError(SFieldNameMissing, DataSet);
  2901.   BeginUpdate;
  2902.   try
  2903.     FieldDef := AddFieldDef;
  2904.     try
  2905.       {FieldNo is defaulted}
  2906.       FieldDef.Name := Name;
  2907.       FieldDef.DataType := DataType;
  2908.       FieldDef.Size := Size;
  2909.       { Precision is defaulted }
  2910.       FieldDef.Required := Required;
  2911.     except
  2912.       FieldDef.Free;
  2913.       raise;
  2914.     end;
  2915.   finally
  2916.     EndUpdate;
  2917.   end;
  2918. end;
  2919.  
  2920. function TFieldDefs.Find(const Name: string): TFieldDef;
  2921. begin
  2922.   Result := TFieldDef(inherited Find(Name));
  2923.   if Result = nil then DatabaseErrorFmt(SFieldNotFound, [Name], DataSet);
  2924. end;
  2925.  
  2926. function TFieldDefs.GetFieldDef(Index: Integer): TFieldDef;
  2927. begin
  2928.   Result := TFieldDef(inherited Items[Index]);
  2929. end;
  2930.  
  2931. procedure TFieldDefs.SetFieldDef(Index: Integer; Value: TFieldDef);
  2932. begin
  2933.   inherited Items[Index] := Value;
  2934. end;
  2935.  
  2936. procedure TFieldDefs.SetHiddenFields(Value: Boolean);
  2937. begin
  2938.   FHiddenFields := Value;
  2939.   Updated := False;
  2940. end;
  2941.  
  2942. procedure TFieldDefs.Update;
  2943. begin
  2944.   DataSet.FieldDefList.Updated := False;
  2945.   UpdateDefs(DataSet.InitFieldDefs);
  2946. end;
  2947.  
  2948. procedure TFieldDefs.ChildDefUpdate(Sender: TObject);
  2949. begin
  2950.   { Need to update based on the UpdateCount of the DataSet's FieldDefs }
  2951.   if (DataSet.FieldDefs.UpdateCount = 0) and
  2952.      (DataSet.FieldDefs.FInternalUpdateCount = 0) then
  2953.     DoUpdate(Sender);
  2954. end;
  2955.  
  2956. procedure TFieldDefs.FieldDefUpdate(Sender: TObject);
  2957. begin
  2958.   DoUpdate(Sender);
  2959.   DataSet.FieldDefList.Updated := False;
  2960. end;
  2961.  
  2962. { TLookupList }
  2963.  
  2964. constructor TLookupList.Create;
  2965. begin
  2966.   FList := TList.Create;
  2967. end;
  2968.  
  2969. destructor TLookupList.Destroy;
  2970. begin
  2971.   if FList <> nil then Clear;
  2972.   FList.Free;
  2973. end;
  2974.  
  2975. procedure TLookupList.Add(const AKey, AValue: Variant);
  2976. var
  2977.   ListEntry: PLookupListEntry;
  2978. begin
  2979.   New(ListEntry);
  2980.   ListEntry.Key := AKey;
  2981.   ListEntry.Value := AValue;
  2982.   FList.Add(ListEntry);
  2983. end;
  2984.  
  2985. procedure TLookupList.Clear;
  2986. var
  2987.   I: Integer;
  2988. begin
  2989.   for I := 0 to FList.Count - 1 do
  2990.     Dispose(PLookupListEntry(FList.Items[I]));
  2991.   FList.Clear;
  2992. end;
  2993.  
  2994. function TLookupList.ValueOfKey(const AKey: Variant): Variant;
  2995. var
  2996.   I: Integer;
  2997. begin
  2998.   Result := Null;
  2999.   if not VarIsNull(AKey) then
  3000.     for I := 0 to FList.Count - 1 do
  3001.       if PLookupListEntry(FList.Items[I]).Key = AKey then
  3002.       begin
  3003.         Result := PLookupListEntry(FList.Items[I]).Value;
  3004.         Break;
  3005.       end;
  3006. end;
  3007.  
  3008. { TFlatList }
  3009.  
  3010. constructor TFlatList.Create(ADataSet: TDataSet);
  3011. begin
  3012.   FDataSet := ADataSet;
  3013.   inherited Create;
  3014.   OnChanging := ListChanging;
  3015.   FLocked := True;
  3016. end;
  3017.  
  3018. function TFlatList.FindItem(const Name: string; MustExist: Boolean): TObject;
  3019. var
  3020.   I: Integer;
  3021. begin
  3022.   if not Updated then Update;
  3023.   I := IndexOf(Name);
  3024.   if I > -1 then
  3025.     Result := GetObject(I)
  3026.   else
  3027.   begin
  3028.     if MustExist then
  3029.       DatabaseErrorFmt(SFieldNotFound, [Name], DataSet);
  3030.     Result := nil;
  3031.   end;
  3032. end;
  3033.  
  3034. function TFlatList.GetCount: Integer;
  3035. begin
  3036.   if not Updated then Update;
  3037.   Result := inherited GetCount;
  3038. end;
  3039.  
  3040. function TFlatList.GetUpdated: Boolean;
  3041. begin
  3042.   Result := FUpdated;
  3043. end;
  3044.  
  3045. procedure TFlatList.ListChanging(Sender: TObject);
  3046. begin
  3047.   if Locked then
  3048.     DatabaseError(SReadOnlyProperty, DataSet);
  3049. end;
  3050.  
  3051. procedure TFlatList.Update;
  3052. begin
  3053.   if not Updated then
  3054.   begin
  3055.     Locked := False;
  3056.     BeginUpdate;
  3057.     try
  3058.       Clear;
  3059.       UpdateList;
  3060.       FUpdated := True;
  3061.     finally
  3062.       EndUpdate;
  3063.       Locked := True;
  3064.     end;
  3065.   end;
  3066. end;
  3067.  
  3068. { TFieldDefList }
  3069.  
  3070. function TFieldDefList.GetFieldDef(Index: Integer): TFieldDef;
  3071. begin
  3072.   if not Updated then Update;
  3073.   Result := TFieldDef(Objects[Index]);
  3074. end;
  3075.  
  3076. function TFieldDefList.Find(const Name: string): TFieldDef;
  3077. begin
  3078.   Result := TFieldDef(FindItem(Name, False));
  3079. end;
  3080.  
  3081. function TFieldDefList.FieldByName(const Name: string): TFieldDef;
  3082. begin
  3083.   Result := TFieldDef(FindItem(Name, True));
  3084. end;
  3085.  
  3086. procedure TFieldDefList.UpdateList;
  3087.  
  3088.   procedure AddFieldDefs(const ParentName: string; const FieldDefs: TFieldDefs);
  3089.   var
  3090.     ChildCount, J, I: Integer;
  3091.     ChildDef, FieldDef: TFieldDef;
  3092.     FieldName, ItemName: string;
  3093.   begin
  3094.     for I := 0 to FieldDefs.Count - 1 do
  3095.     begin
  3096.       FieldDef := FieldDefs[I];
  3097.       FieldName := ParentName+FieldDef.Name;
  3098.       AddObject(FieldName, FieldDef);
  3099.       if FieldDef.HasChildDefs then
  3100.         if FieldDef.DataType = ftArray then
  3101.         begin
  3102.           ChildDef := FieldDef.ChildDefs[0];
  3103.           ChildCount := FieldDef.Size;
  3104.           for J := 0 to ChildCount - 1 do
  3105.           begin
  3106.             ItemName := Format('%s[%d]', [FieldName, J]);
  3107.             AddObject(ItemName, ChildDef);
  3108.             if ChildDef.DataType = ftADT then
  3109.               AddFieldDefs(ItemName+'.', ChildDef.ChildDefs);
  3110.           end;
  3111.         end
  3112.         else if faUnNamed in FieldDef.Attributes then
  3113.           AddFieldDefs('',FieldDef.ChildDefs)
  3114.         else
  3115.           AddFieldDefs(ParentName+FieldDef.Name+'.', FieldDef.ChildDefs);
  3116.     end;
  3117.   end;
  3118.  
  3119. begin
  3120.   if DataSet.Active then DataSet.FieldDefs.Update;
  3121.   AddFieldDefs('', DataSet.FieldDefs);
  3122. end;
  3123.  
  3124. function TFieldDefList.GetUpdated: Boolean;
  3125. begin
  3126.   Result := FUpdated and DataSet.FieldDefs.Updated;
  3127. end;
  3128.  
  3129. { TFieldList }
  3130.  
  3131. function TFieldList.Find(const Name: string): TField;
  3132. begin
  3133.   Result := TField(FindItem(Name, False));
  3134. end;
  3135.  
  3136. function TFieldList.FieldByName(const Name: string): TField;
  3137. begin
  3138.   Result := TField(FindItem(Name, True));
  3139. end;
  3140.  
  3141. function TFieldList.GetField(Index: Integer): TField;
  3142. begin
  3143.   if not Updated then Update;
  3144.   Result := TField(Objects[Index]);
  3145. end;
  3146.  
  3147. procedure TFieldList.UpdateList;
  3148.  
  3149.   procedure AddFields(const AFields: TFields);
  3150.   var
  3151.     I: Integer;
  3152.     Field: TField;
  3153.   begin
  3154.     { Using Fields.FList.Count here to exclude sparse fields }
  3155.     for I := 0 to AFields.FList.Count - 1 do
  3156.     begin
  3157.       Field := AFields[I];
  3158.       AddObject(Field.FullName, Field);
  3159.       if Field.DataType in [ftADT, ftArray] then
  3160.         AddFields(TObjectField(Field).FOwnedFields);
  3161.     end;
  3162.   end;
  3163.  
  3164. begin
  3165.   AddFields(DataSet.FFields);
  3166. end;
  3167.  
  3168. { TFields }
  3169.  
  3170. constructor TFields.Create(ADataSet: TDataSet);
  3171. begin
  3172.   FList := TList.Create;
  3173.   FDataSet := ADataSet;
  3174.   FValidFieldKinds := [fkData..fkInternalCalc];
  3175. end;
  3176.  
  3177. destructor TFields.Destroy;
  3178. begin
  3179.   if FList <> nil then Clear;
  3180.   FList.Free;
  3181.   inherited Destroy;
  3182. end;
  3183.  
  3184. procedure TFields.Changed;
  3185. begin
  3186.   if (FDataSet <> nil) and not (csDestroying in FDataSet.ComponentState) then
  3187.     FDataSet.DataEvent(deFieldListChange, 0);
  3188.   if Assigned(OnChange) then OnChange(Self);
  3189. end;
  3190.  
  3191. procedure TFields.CheckFieldKind(FieldKind: TFieldKind; Field: TField);
  3192. begin
  3193.   if not (FieldKind in ValidFieldKinds) then
  3194.     DatabaseError(SInvalidFieldKind, Field);
  3195. end;
  3196.  
  3197. procedure TFields.Add(Field: TField);
  3198. begin
  3199.   CheckFieldKind(Field.FieldKind, Field);
  3200.   FList.Add(Field);
  3201.   Field.FFields := Self;
  3202.   Changed;
  3203. end;
  3204.  
  3205. procedure TFields.Remove(Field: TField);
  3206. begin
  3207.   FList.Remove(Field);
  3208.   Field.FFields := nil;
  3209.   Changed;
  3210. end;
  3211.  
  3212. procedure TFields.Clear;
  3213. var
  3214.   F: TField;
  3215. begin
  3216.   while FList.Count > 0 do
  3217.   begin
  3218.     F := FList.Last;
  3219.     F.FDataSet := nil;
  3220.     F.Free;
  3221.     FList.Delete(FList.Count-1);
  3222.   end;
  3223.   Changed;
  3224. end;
  3225.  
  3226. function TFields.GetField(Index: Integer): TField;
  3227. begin
  3228.   if FSparseFields > 0 then
  3229.   begin
  3230.     if Index >= FSparseFields then
  3231.       DatabaseError(SListIndexError, DataSet);
  3232.     Result := FList[0];
  3233.     Result.FOffset := Index;
  3234.   end else
  3235.     Result := FList[Index];
  3236. end;
  3237.  
  3238. procedure TFields.SetField(Index: Integer; Value: TField);
  3239. begin
  3240.   Fields[Index].Assign(Value);
  3241. end;
  3242.  
  3243. function TFields.GetCount: Integer;
  3244. begin
  3245.   if (FSparseFields > 0) and (FList.Count > 0) then
  3246.     Result := FSparseFields else
  3247.     Result := FList.Count;
  3248. end;
  3249.  
  3250. function TFields.IndexOf(Field: TField): Integer;
  3251. begin
  3252.   Result := FList.IndexOf(Field);
  3253. end;
  3254.  
  3255. procedure TFields.CheckFieldName(const FieldName: string);
  3256. begin
  3257.   if FieldName = '' then DatabaseError(SFieldNameMissing, DataSet);
  3258.   if FindField(FieldName) <> nil then
  3259.     DatabaseErrorFmt(SDuplicateFieldName, [FieldName], DataSet);
  3260. end;
  3261.  
  3262. procedure TFields.CheckFieldNames(const FieldNames: string);
  3263. var
  3264.   Pos: Integer;
  3265. begin
  3266.   Pos := 1;
  3267.   while Pos <= Length(FieldNames) do
  3268.     FieldByName(ExtractFieldName(FieldNames, Pos));
  3269. end;
  3270.  
  3271. procedure TFields.GetFieldNames(List: TStrings);
  3272. var
  3273.   I: Integer;
  3274. begin
  3275.   List.BeginUpdate;
  3276.   try
  3277.     List.Clear;
  3278.     for I := 0 to FList.Count - 1 do
  3279.       List.Add(TField(FList.Items[I]).FieldName)
  3280.   finally
  3281.     List.EndUpdate;
  3282.   end;
  3283. end;
  3284.  
  3285. function TFields.FindField(const FieldName: string): TField;
  3286. var
  3287.   I: Integer;
  3288. begin
  3289.   for I := 0 to FList.Count - 1 do
  3290.   begin
  3291.     Result := FList.Items[I];
  3292.     if AnsiCompareText(Result.FFieldName, FieldName) = 0 then Exit;
  3293.   end;
  3294.   Result := nil;
  3295. end;
  3296.  
  3297. function TFields.FieldByName(const FieldName: string): TField;
  3298. begin
  3299.   Result := FindField(FieldName);
  3300.   if Result = nil then DatabaseErrorFmt(SFieldNotFound, [FieldName], DataSet);
  3301. end;
  3302.  
  3303. function TFields.FieldByNumber(FieldNo: Integer): TField;
  3304. var
  3305.   I: Integer;
  3306. begin
  3307.   for I := 0 to FList.Count - 1 do
  3308.   begin
  3309.     Result := FList.Items[I];
  3310.     if Result.FieldNo = FieldNo then Exit;
  3311.   end;
  3312.   Result := nil;
  3313. end;
  3314.  
  3315. procedure TFields.SetFieldIndex(Field: TField; Value: Integer);
  3316. var
  3317.   CurIndex, Count: Integer;
  3318. begin
  3319.   CurIndex := FList.IndexOf(Field);
  3320.   if CurIndex >= 0 then
  3321.   begin
  3322.     Count := FList.Count;
  3323.     if Value < 0 then Value := 0;
  3324.     if Value >= Count then Value := Count - 1;
  3325.     if Value <> CurIndex then
  3326.     begin
  3327.       FList.Delete(CurIndex);
  3328.       FList.Insert(Value, Field);
  3329.       Field.PropertyChanged(True);
  3330.       Changed;
  3331.     end;
  3332.   end;
  3333. end;
  3334.  
  3335. { TField }
  3336.  
  3337. constructor TField.Create(AOwner: TComponent);
  3338. begin
  3339.   inherited Create(AOwner);
  3340.   FVisible := True;
  3341.   FValidChars := [#0..#255];
  3342.   FProviderFlags := [pfInWhere, pfInUpdate]
  3343. end;
  3344.  
  3345. destructor TField.Destroy;
  3346. begin
  3347.   if FDataSet <> nil then
  3348.   begin
  3349.     FDataSet.Close;
  3350.     if FFields <> nil then
  3351.       FFields.Remove(Self);
  3352.   end;
  3353.   FLookupList.Free;
  3354.   inherited Destroy;
  3355. end;
  3356.  
  3357. function TField.AccessError(const TypeName: string): EDatabaseError;
  3358. begin
  3359.   Result := EDatabaseError.CreateResFmt(@SFieldAccessError,
  3360.     [DisplayName, TypeName]);
  3361. end;
  3362.  
  3363. procedure TField.Assign(Source: TPersistent);
  3364. begin
  3365.   if Source = nil then
  3366.     Clear
  3367.   else if Source is TField then
  3368.     Value := TField(Source).Value
  3369.   else
  3370.     inherited Assign(Source);
  3371. end;
  3372.  
  3373. procedure TField.AssignValue(const Value: TVarRec);
  3374.  
  3375.   procedure Error;
  3376.   begin
  3377.     DatabaseErrorFmt(SFieldValueError, [DisplayName]);
  3378.   end;
  3379.  
  3380. begin
  3381.   with Value do
  3382.     case VType of
  3383.       vtInteger:
  3384.         AsInteger := VInteger;
  3385.       vtBoolean:
  3386.         AsBoolean := VBoolean;
  3387.       vtChar:
  3388.         AsString := VChar;
  3389.       vtExtended:
  3390.         AsFloat := VExtended^;
  3391.       vtString:
  3392.         AsString := VString^;
  3393.       vtPointer:
  3394.         if VPointer <> nil then Error;
  3395.       vtPChar:
  3396.         AsString := VPChar;
  3397.       vtObject:
  3398.         if (VObject = nil) or (VObject is TPersistent) then
  3399.           Assign(TPersistent(VObject))
  3400.         else
  3401.           Error;
  3402.       vtAnsiString:
  3403.         AsString := string(VAnsiString);
  3404.       vtCurrency:
  3405.         AsCurrency := VCurrency^;
  3406.       vtVariant:
  3407.         if not VarIsEmpty(VVariant^) then AsVariant := VVariant^;
  3408.     else
  3409.       Error;
  3410.     end;
  3411. end;
  3412.  
  3413. procedure TField.Bind(Binding: Boolean);
  3414. begin
  3415.   if FFieldKind = fkLookup then
  3416.     if Binding then
  3417.     begin
  3418.       if FLookupCache then
  3419.         RefreshLookupList
  3420.       else
  3421.         ValidateLookupInfo(True);
  3422.    end;
  3423. end;
  3424.  
  3425. procedure TField.CalcLookupValue;
  3426. begin
  3427.   if FLookupCache then
  3428.     Value := LookupList.ValueOfKey(FDataSet.FieldValues[FKeyFields])
  3429.   else if (FLookupDataSet <> nil) and FLookupDataSet.Active then
  3430.     Value := FLookupDataSet.Lookup(FLookupKeyFields,
  3431.       FDataSet.FieldValues[FKeyFields], FLookupResultField);
  3432. end;
  3433.  
  3434. procedure TField.Change;
  3435. begin
  3436.   if Assigned(FOnChange) then FOnChange(Self);
  3437. end;
  3438.  
  3439. procedure TField.CheckInactive;
  3440. begin
  3441.   if FDataSet <> nil then FDataSet.CheckInactive;
  3442. end;
  3443.  
  3444. procedure TField.Clear;
  3445. begin
  3446.   SetData(nil);
  3447. end;
  3448.  
  3449. procedure TField.CopyData(Source, Dest: Pointer);
  3450. begin
  3451.   Move(Source^, Dest^, DataSize);
  3452. end;
  3453.  
  3454. procedure TField.DataChanged;
  3455. begin
  3456.   FDataSet.DataEvent(deFieldChange, Longint(Self));
  3457. end;
  3458.  
  3459. procedure TField.DefineProperties(Filer: TFiler);
  3460.  
  3461.   function AttributeSetStored: Boolean;
  3462.   begin
  3463.     if Assigned(Filer.Ancestor) then
  3464.       Result := CompareText(FAttributeSet, TField(Filer.Ancestor).FAttributeSet) <> 0
  3465.     else
  3466.       Result := FAttributeSet <> '';
  3467.   end;
  3468.  
  3469.   function CalculatedStored: Boolean;
  3470.   begin
  3471.     if Assigned(Filer.Ancestor) then
  3472.       Result := Calculated <> TField(Filer.Ancestor).Calculated else
  3473.       Result := Calculated;
  3474.   end;
  3475.  
  3476.   function LookupStored: Boolean;
  3477.   begin
  3478.     if Assigned(Filer.Ancestor) then
  3479.       Result := Lookup <> TField(Filer.Ancestor).Lookup else
  3480.       Result := Lookup;
  3481.   end;
  3482.  
  3483. begin
  3484.   Filer.DefineProperty('AttributeSet', ReadAttributeSet, WriteAttributeSet,
  3485.     AttributeSetStored);
  3486.   { For backwards compatibility }
  3487.   Filer.DefineProperty('Calculated', ReadCalculated, WriteCalculated,
  3488.     CalculatedStored);
  3489.   Filer.DefineProperty('Lookup', ReadLookup, WriteLookup, LookupStored);
  3490. end;
  3491.  
  3492. procedure TField.FocusControl;
  3493. var
  3494.   Field: TField;
  3495. begin
  3496.   if (FDataSet <> nil) and FDataSet.Active then
  3497.   begin
  3498.     Field := Self;
  3499.     FDataSet.DataEvent(deFocusControl, Longint(@Field));
  3500.   end;
  3501. end;
  3502.  
  3503. procedure TField.FreeBuffers;
  3504. begin
  3505. end;
  3506.  
  3507. function TField.GetAsBoolean: Boolean;
  3508. begin
  3509.   raise AccessError('Boolean'); { Do not localize }
  3510. end;
  3511.  
  3512. function TField.GetAsByteArray: Variant;
  3513. begin
  3514.   if not GetData(@Result, False) then Result := Null;
  3515. end;
  3516.  
  3517. function TField.GetAsCurrency: Currency;
  3518. begin
  3519.   Result := GetAsFloat;
  3520. end;
  3521.  
  3522. function TField.GetAsDateTime: TDateTime;
  3523. begin
  3524.   raise AccessError('DateTime'); { Do not localize }
  3525. end;
  3526.  
  3527. function TField.GetAsFloat: Double;
  3528. begin
  3529.   raise AccessError('Float'); { Do not localize }
  3530. end;
  3531.  
  3532. function TField.GetAsInteger: Longint;
  3533. begin
  3534.   raise AccessError('Integer'); { Do not localize }
  3535. end;
  3536.  
  3537. function TField.GetAsString: string;
  3538. begin
  3539.   Result := GetClassDesc;
  3540. end;
  3541.  
  3542. function TField.GetAsVariant: Variant;
  3543. begin
  3544.   raise AccessError('Variant'); { Do not localize }
  3545. end;
  3546.  
  3547. function TField.GetCalculated: Boolean;
  3548. begin
  3549.   Result := FFieldKind = fkCalculated;
  3550. end;
  3551.  
  3552. function TField.GetCanModify: Boolean;
  3553. begin
  3554.   if FieldNo > 0 then
  3555.     if DataSet.State <> dsSetKey then
  3556.       Result := not ReadOnly and DataSet.CanModify else
  3557.       Result := IsIndexField
  3558.   else
  3559.     Result := False;
  3560. end;
  3561.  
  3562. function TField.GetClassDesc: string;
  3563. var
  3564.   I, L: Integer;
  3565.   S: string[63];
  3566. begin
  3567.   S := ClassName;
  3568.   I := 1;
  3569.   L := Length(S);
  3570.   if S[1] = 'T' then I := 2;
  3571.   if (L-I >= 5) and (CompareText(Copy(S, L - 4, 5), 'FIELD') = 0) then Dec(L, 5);
  3572.   FmtStr(Result, '(%s)', [Copy(S, I, L + 1 - I)]);
  3573.   if not IsNull then Result := AnsiUpperCase(Result);
  3574. end;
  3575.  
  3576. function TField.GetData(Buffer: Pointer; NativeFormat: Boolean = True): Boolean;
  3577. begin
  3578.   if FDataSet = nil then DatabaseErrorFmt(SDataSetMissing, [DisplayName]);
  3579.   if FValidating then
  3580.   begin
  3581.     Result := LongBool(FValueBuffer);
  3582.     if Result and (Buffer <> nil) then
  3583.       CopyData(FValueBuffer, Buffer);
  3584.   end else
  3585.     Result := FDataSet.GetFieldData(Self, Buffer, NativeFormat);
  3586. end;
  3587.  
  3588. function TField.GetDataSize: Integer;
  3589. begin
  3590.   Result := 0;
  3591. end;
  3592.  
  3593. function TField.GetDefaultWidth: Integer;
  3594. begin
  3595.   Result := 10;
  3596. end;
  3597.  
  3598. function TField.GetDisplayLabel: string;
  3599. begin
  3600.   Result := GetDisplayName;
  3601. end;
  3602.  
  3603. function TField.GetDisplayName: string;
  3604. begin
  3605.   if FDisplayLabel <> '' then
  3606.     Result := FDisplayLabel else
  3607.     Result := FFieldName;
  3608. end;
  3609.  
  3610. function TField.GetDisplayText: string;
  3611. begin
  3612.   Result := '';
  3613.   if Assigned(FOnGetText) then
  3614.     FOnGetText(Self, Result, True) else
  3615.     GetText(Result, True);
  3616. end;
  3617.  
  3618. function TField.GetDisplayWidth: Integer;
  3619. begin
  3620.   if FDisplayWidth > 0 then
  3621.     Result := FDisplayWidth else
  3622.     Result := GetDefaultWidth;
  3623. end;
  3624.  
  3625. function TField.GetEditText: string;
  3626. begin
  3627.   Result := '';
  3628.   if Assigned(FOnGetText) then
  3629.     FOnGetText(Self, Result, False) else
  3630.     GetText(Result, False);
  3631. end;
  3632.  
  3633. function TField.GetFieldNo: Integer;
  3634. var
  3635.   ParentField: TObjectField;
  3636. begin
  3637.   Result := FFieldNo;
  3638.   if (FParentField = nil) or IsBlob or (FieldKind <> fkData) then Exit;
  3639.   if Offset > 0 then
  3640.     Inc(Result, Offset) else
  3641.   begin
  3642.     ParentField := FParentField;
  3643.     while ParentField <> nil do
  3644.     begin
  3645.       if ParentField.OffSet > 0 then
  3646.       begin
  3647.         Inc(Result, ParentField.OffSet * (ParentField.Size+1));
  3648.         Break;
  3649.       end;
  3650.       ParentField := ParentField.ParentField;
  3651.     end;
  3652.   end;
  3653. end;
  3654.  
  3655. function TField.GetFullName: string;
  3656. begin
  3657.   if (FParentField = nil) or (DataSet = nil) then
  3658.     Result := FieldName else
  3659.     Result := DataSet.GetFieldFullName(Self);
  3660. end;
  3661.  
  3662. function TField.GetHasConstraints: Boolean;
  3663. begin
  3664.   Result := (CustomConstraint <> '') or (ImportedConstraint <> '') or
  3665.    (DefaultExpression <> '');
  3666. end;
  3667.  
  3668. function TField.GetIndex: Integer;
  3669. begin
  3670.   if FParentField <> nil then
  3671.     Result := FParentField.Fields.IndexOf(Self)
  3672.   else if FDataSet <> nil then
  3673.     Result := DataSet.FFields.IndexOf(Self)
  3674.   else
  3675.     Result := -1;
  3676. end;
  3677.  
  3678. function TField.GetIsIndexField: Boolean;
  3679. begin
  3680.   if (FDataSet <> nil) and (FParentField = nil) then
  3681.     Result := DataSet.GetIsIndexField(Self) else
  3682.     Result := False;
  3683. end;
  3684.  
  3685. class function TField.IsBlob: Boolean;
  3686. begin
  3687.   Result := False;
  3688. end;
  3689.  
  3690. function TField.GetIsNull: Boolean;
  3691. begin
  3692.   Result := not GetData(nil);
  3693. end;
  3694.  
  3695. function TField.GetLookup: Boolean;
  3696. begin
  3697.   Result := FFieldKind = fkLookup;
  3698. end;
  3699.  
  3700. function TField.GetLookupList: TLookupList;
  3701. begin
  3702.   if not Assigned(FLookupList) then
  3703.     FLookupList := TLookupList.Create;
  3704.   Result := FLookupList;
  3705. end;
  3706.  
  3707. procedure TField.GetText(var Text: string; DisplayText: Boolean);
  3708. begin
  3709.   Text := GetAsString;
  3710. end;
  3711.  
  3712. function TField.HasParent: Boolean;
  3713. begin
  3714.   HasParent := True;
  3715. end;
  3716.  
  3717. function TField.GetNewValue: Variant;
  3718. begin
  3719.   Result := DataSet.GetStateFieldValue(dsNewValue, Self);
  3720. end;
  3721.  
  3722. function TField.GetOldValue: Variant;
  3723. begin
  3724.   Result := DataSet.GetStateFieldValue(dsOldValue, Self);
  3725. end;
  3726.  
  3727. function TField.GetCurValue: Variant;
  3728. begin
  3729.   Result := DataSet.GetStateFieldValue(dsCurValue, Self);
  3730. end;
  3731.  
  3732. function TField.GetParentComponent: TComponent;
  3733. begin
  3734.   if ParentField <> nil then
  3735.     Result := ParentField else
  3736.     Result := DataSet;
  3737. end;
  3738.  
  3739. procedure TField.SetParentComponent(AParent: TComponent);
  3740. begin
  3741.   if not (csLoading in ComponentState) then
  3742.     if AParent is TObjectField then
  3743.       ParentField := AParent as TObjectField else
  3744.       DataSet := AParent as TDataSet;
  3745. end;
  3746.  
  3747. function TField.IsValidChar(InputChar: Char): Boolean;
  3748. begin
  3749.   Result := InputChar in ValidChars;
  3750. end;
  3751.  
  3752. function TField.IsDisplayLabelStored: Boolean;
  3753. begin
  3754.   Result := FDisplayLabel <> '';
  3755. end;
  3756.  
  3757. function TField.IsDisplayWidthStored: Boolean;
  3758. begin
  3759.   Result := FDisplayWidth > 0;
  3760. end;
  3761.  
  3762. procedure TField.Notification(AComponent: TComponent;
  3763.   Operation: TOperation);
  3764. begin
  3765.   inherited Notification(AComponent, Operation);
  3766.   if (Operation = opRemove) and (AComponent = FLookupDataSet) then
  3767.     FLookupDataSet := nil;
  3768. end;
  3769.  
  3770. procedure TField.PropertyChanged(LayoutAffected: Boolean);
  3771. const
  3772.   Events: array[Boolean] of TDataEvent = (deDataSetChange, deLayoutChange);
  3773. begin
  3774.   if (FDataSet <> nil) and FDataSet.Active then
  3775.     FDataSet.DataEvent(Events[LayoutAffected], 0);
  3776. end;
  3777.  
  3778. procedure TField.ReadAttributeSet(Reader: TReader);
  3779. begin
  3780.   FAttributeSet := Reader.ReadString;
  3781. end;
  3782.  
  3783. procedure TField.ReadCalculated(Reader: TReader);
  3784. begin
  3785.   if Reader.ReadBoolean then
  3786.     FFieldKind := fkCalculated;
  3787. end;
  3788.  
  3789. procedure TField.ReadLookup(Reader: TReader);
  3790. begin
  3791.   if Reader.ReadBoolean then
  3792.     FFieldKind := fkLookup;
  3793. end;
  3794.  
  3795. procedure TField.ReadState(Reader: TReader);
  3796. begin
  3797.   inherited ReadState(Reader);
  3798.   if Reader.Parent is TObjectField then
  3799.     ParentField := TObjectField(Reader.Parent)
  3800.   else if Reader.Parent is TDataSet then
  3801.     DataSet := TDataSet(Reader.Parent);
  3802. end;
  3803.  
  3804. procedure TField.RefreshLookupList;
  3805. var
  3806.   WasActive: Boolean;
  3807. begin
  3808.   if FLookupDataSet <> nil then
  3809.   begin
  3810.     WasActive := FLookupDataSet.Active;
  3811.     ValidateLookupInfo(True);
  3812.     with FLookupDataSet do
  3813.     try
  3814.       LookupList.Clear;
  3815.       DisableControls;
  3816.       try
  3817.         First;
  3818.         while not Eof do
  3819.         begin
  3820.           FLookupList.Add(FieldValues[FLookupKeyFields],
  3821.             FieldValues[FLookupResultField]);
  3822.           Next;
  3823.         end;
  3824.       finally
  3825.         EnableControls;
  3826.       end;
  3827.     finally
  3828.       Active := WasActive;
  3829.     end;
  3830.   end
  3831.   else
  3832.     ValidateLookupInfo(False);
  3833. end;
  3834.  
  3835. procedure TField.SetAsBoolean(Value: Boolean);
  3836. begin
  3837.   raise AccessError('Boolean'); { Do not localize }
  3838. end;
  3839.  
  3840. procedure TField.SetAsCurrency(Value: Currency);
  3841. begin
  3842.   SetAsFloat(Value);
  3843. end;
  3844.  
  3845. procedure TField.SetAsDateTime(Value: TDateTime);
  3846. begin
  3847.   raise AccessError('DateTime'); { Do not localize }
  3848. end;
  3849.  
  3850. procedure TField.SetAsFloat(Value: Double);
  3851. begin
  3852.   raise AccessError('Float'); { Do not localize }
  3853. end;
  3854.  
  3855. procedure TField.SetAsInteger(Value: Longint);
  3856. begin
  3857.   raise AccessError('Integer'); { Do not localize }
  3858. end;
  3859.  
  3860. procedure TField.SetAsString(const Value: string);
  3861. begin
  3862.   raise AccessError('String'); { Do not localize }
  3863. end;
  3864.  
  3865. procedure TField.SetAsVariant(const Value: Variant);
  3866. begin
  3867.   if VarIsNull(Value) then
  3868.     Clear
  3869.   else
  3870.     try
  3871.       SetVarValue(Value);
  3872.     except
  3873.       on EVariantError do DatabaseErrorFmt(SFieldValueError, [DisplayName]);
  3874.     end;
  3875. end;
  3876.  
  3877. procedure TField.SetAsByteArray(const Value: Variant);
  3878. begin
  3879.   if not (VarIsArray(Value) and (VarArrayDimCount(Value) = 1) and
  3880.      ((VarType(Value) and VarTypeMask) = varByte) and
  3881.      (VarArrayHighBound(Value, 1) <= DataSize)) then
  3882.     DatabaseErrorFmt(SInvalidVarByteArray, [DisplayName]);
  3883.   SetData(@Value, False);
  3884. end;
  3885.  
  3886. procedure TField.SetAlignment(Value: TAlignment);
  3887. begin
  3888.   if FAlignment <> Value then
  3889.   begin
  3890.     FAlignment := Value;
  3891.     PropertyChanged(False);
  3892.   end;
  3893. end;
  3894.  
  3895. procedure TField.SetCalculated(Value: Boolean);
  3896. begin
  3897.   if Value then
  3898.     FieldKind := fkCalculated
  3899.   else if FieldKind = fkCalculated then
  3900.     FieldKind := fkData;
  3901. end;
  3902.  
  3903. procedure TField.SetData(Buffer: Pointer; NativeFormat: Boolean = True);
  3904. begin
  3905.   if FDataSet = nil then DatabaseErrorFmt(SDataSetMissing, [DisplayName]);
  3906.   FValueBuffer := Buffer;
  3907.   try
  3908.     FDataSet.SetFieldData(Self, Buffer, NativeFormat);
  3909.   finally
  3910.     FValueBuffer := nil;
  3911.   end;
  3912. end;
  3913.  
  3914. procedure TField.SetDataSet(ADataSet: TDataSet);
  3915. begin
  3916.   if ADataSet <> FDataSet then
  3917.   begin
  3918.     { Make sure new and old datasets are closed and fieldname is not a dup. }
  3919.     if FDataSet <> nil then FDataSet.CheckInactive;
  3920.     if ADataSet <> nil then
  3921.     begin
  3922.       ADataSet.CheckInactive;
  3923.       if FieldKind = fkAggregate then
  3924.         ADataSet.FAggFields.CheckFieldName(FFieldName) else
  3925.         ADataSet.FFields.CheckFieldName(FFieldName);
  3926.     end;
  3927.     { If ParentField is set and part of a different dataset then clear it }
  3928.     if (FParentField <> nil) and (FParentField.DataSet <> ADataSet) then
  3929.     begin
  3930.       FParentField.FFields.Remove(Self);
  3931.       FParentField := nil;
  3932.     end
  3933.     else if FDataSet <> nil then
  3934.     begin
  3935.       if FieldKind = fkAggregate then
  3936.         FDataSet.FAggFields.Remove(Self) else
  3937.         FDataSet.FFields.Remove(Self);
  3938.     end;
  3939.     { Add to the new dataset's field list, unless parentfield is still set }
  3940.     if (ADataSet <> nil) and (FParentField = nil) then
  3941.     begin
  3942.       if FieldKind = fkAggregate then
  3943.         ADataSet.FAggFields.Add(Self) else
  3944.         ADataSet.FFields.Add(Self);
  3945.     end;
  3946.     FDataSet := ADataSet;
  3947.   end;
  3948. end;
  3949.  
  3950. procedure TField.SetParentField(AField: TObjectField);
  3951. begin
  3952.   if AField <> FParentField then
  3953.   begin
  3954.     if FDataSet <> nil then FDataSet.CheckInactive;
  3955.     if AField <> nil then
  3956.     begin
  3957.       if AField.DataSet <> nil then AField.DataSet.CheckInactive;
  3958.       AField.Fields.CheckFieldName(FFieldName);
  3959.       AField.Fields.Add(Self);
  3960.       if FDataSet <> nil then FDataSet.FFields.Remove(Self);
  3961.       FDataSet := AField.DataSet;
  3962.     end
  3963.     else if FDataSet <> nil then FDataSet.FFields.Add(Self);
  3964.     if FParentField <> nil then FParentField.Fields.Remove(Self);
  3965.     FParentField := AField;
  3966.   end;
  3967. end;
  3968.  
  3969. procedure TField.SetDataType(Value: TFieldType);
  3970. begin
  3971.   FDataType := Value;
  3972. end;
  3973.  
  3974. procedure TField.SetDisplayLabel(Value: string);
  3975. begin
  3976.   if Value = FFieldName then Value := '';
  3977.   if FDisplayLabel <> Value then
  3978.   begin
  3979.     FDisplaylabel := Value;
  3980.     PropertyChanged(True);
  3981.   end;
  3982. end;
  3983.  
  3984. procedure TField.SetDisplayWidth(Value: Integer);
  3985. begin
  3986.   if FDisplayWidth <> Value then
  3987.   begin
  3988.     FDisplayWidth := Value;
  3989.     PropertyChanged(True);
  3990.   end;
  3991. end;
  3992.  
  3993. procedure TField.SetEditMask(const Value: string);
  3994. begin
  3995.   FEditMask := Value;
  3996.   PropertyChanged(False);
  3997. end;
  3998.  
  3999. procedure TField.SetEditText(const Value: string);
  4000. begin
  4001.   if Assigned(FOnSetText) then FOnSetText(Self, Value) else SetText(Value);
  4002. end;
  4003.  
  4004. procedure TField.SetFieldKind(Value: TFieldKind);
  4005. begin
  4006.   if FFieldKind <> Value then
  4007.   begin
  4008.     if FFields <> nil then
  4009.       FFields.CheckFieldKind(Value, Self);
  4010.     if (DataSet <> nil) and (DataSet.FDesigner <> nil) then
  4011.     with DataSet.Designer do
  4012.     begin
  4013.       BeginDesign;
  4014.       try
  4015.         FFieldKind := Value;
  4016.       finally
  4017.         EndDesign;
  4018.       end;
  4019.     end else
  4020.     begin
  4021.       CheckInactive;
  4022.       FFieldKind := Value;
  4023.     end;
  4024.   end;
  4025. end;
  4026.  
  4027. procedure TField.SetFieldName(const Value: string);
  4028. begin
  4029.   CheckInactive;
  4030.   if (FDataSet <> nil) and (AnsiCompareText(Value, FFieldName) <> 0) then
  4031.     FFields.CheckFieldName(Value);
  4032.   FFieldName := Value;
  4033.   if FDisplayLabel = Value then FDisplayLabel := '';
  4034.   if FDataSet <> nil then FDataSet.FFields.Changed;
  4035. end;
  4036.  
  4037. procedure TField.SetFieldType(Value: TFieldType);
  4038. begin
  4039. end;
  4040.  
  4041. procedure TField.SetIndex(Value: Integer);
  4042. begin
  4043.   if FFields <> nil then
  4044.     FFields.SetFieldIndex(Self, Value)
  4045. end;
  4046.  
  4047. procedure TField.SetLookup(Value: Boolean);
  4048. begin
  4049.   if Value then
  4050.     FieldKind := fkLookup
  4051.   else if FieldKind = fkLookup then
  4052.     FieldKind := fkData;
  4053. end;
  4054.  
  4055. procedure TField.SetLookupDataSet(Value: TDataSet);
  4056. begin
  4057.   CheckInactive;
  4058.   if (Value <> nil) and (Value = FDataSet) then
  4059.     DatabaseError(SCircularDataLink, Self);
  4060.   FLookupDataSet := Value;
  4061. end;
  4062.  
  4063. procedure TField.SetLookupKeyFields(const Value: string);
  4064. begin
  4065.   CheckInactive;
  4066.   FLookupKeyFields := Value;
  4067. end;
  4068.  
  4069. procedure TField.SetLookupResultField(const Value: string);
  4070. begin
  4071.   CheckInactive;
  4072.   FLookupResultField := Value;
  4073. end;
  4074.  
  4075. procedure TField.SetKeyFields(const Value: string);
  4076. begin
  4077.   CheckInactive;
  4078.   FKeyFields := Value;
  4079. end;
  4080.  
  4081. procedure TField.SetNewValue(const Value: Variant);
  4082. begin
  4083.   DataSet.SetStateFieldValue(dsNewValue, Self, Value);
  4084. end;
  4085.  
  4086. procedure TField.SetLookupCache(const Value: Boolean);
  4087. begin
  4088.   CheckInactive;
  4089.   FLookupCache := Value;
  4090. end;
  4091.  
  4092. class procedure TField.CheckTypeSize(Value: Integer);
  4093. begin
  4094.   if (Value <> 0) and not IsBlob then
  4095.     DatabaseError(SInvalidFieldSize);
  4096. end;
  4097.  
  4098. procedure TField.SetSize(Value: Integer);
  4099. begin
  4100.   CheckInactive;
  4101.   CheckTypeSize(Value);
  4102.   FSize := Value;
  4103. end;
  4104.  
  4105. function TField.GetSize: Integer;
  4106. begin
  4107.   Result := FSize;
  4108. end;
  4109.  
  4110. procedure TField.SetText(const Value: string);
  4111. begin
  4112.   SetAsString(Value);
  4113. end;
  4114.  
  4115. procedure TField.SetReadOnly(const Value: Boolean);
  4116. begin
  4117.   if FReadOnly <> Value then
  4118.   begin
  4119.     FReadOnly := Value;
  4120.     PropertyChanged(True);
  4121.   end;
  4122. end;
  4123.  
  4124. procedure TField.SetVarValue(const Value: Variant);
  4125. begin
  4126.   raise AccessError('Variant'); { Do not localize }
  4127. end;
  4128.  
  4129. procedure TField.SetVisible(Value: Boolean);
  4130. begin
  4131.   if FVisible <> Value then
  4132.   begin
  4133.     FVisible := Value;
  4134.     PropertyChanged(True);
  4135.   end;
  4136. end;
  4137.  
  4138. procedure TField.Validate(Buffer: Pointer);
  4139. begin
  4140.   if Assigned(OnValidate) then
  4141.   begin
  4142.     { Use the already assigned FValueBuffer if set }
  4143.     if FValueBuffer = nil then
  4144.       FValueBuffer := Buffer;
  4145.     FValidating := True;
  4146.     try
  4147.       OnValidate(Self);
  4148.     finally
  4149.       FValidating := False;
  4150.     end;
  4151.   end;
  4152. end;
  4153.  
  4154. procedure TField.ValidateLookupInfo(All: Boolean);
  4155. begin
  4156.   if (All and ((FLookupDataSet = nil) or (FLookupKeyFields = '') or
  4157.      (FLookupResultField = ''))) or (FKeyFields = '') then
  4158.     DatabaseErrorFmt(SLookupInfoError, [DisplayName]);
  4159.   FFields.CheckFieldNames(FKeyFields);
  4160.   if All then
  4161.   begin
  4162.     FLookupDataSet.Open;
  4163.     FLookupDataSet.FFields.CheckFieldNames(FLookupKeyFields);
  4164.     FLookupDataSet.FieldByName(FLookupResultField);
  4165.   end;
  4166. end;
  4167.  
  4168. procedure TField.WriteAttributeSet(Writer: TWriter);
  4169. begin
  4170.   Writer.WriteString(FAttributeSet);
  4171. end;
  4172.  
  4173. procedure TField.WriteCalculated(Writer: TWriter);
  4174. begin
  4175.   Writer.WriteBoolean(True);
  4176. end;
  4177.  
  4178. procedure TField.WriteLookup(Writer: TWriter);
  4179. begin
  4180.   Writer.WriteBoolean(True);
  4181. end;
  4182.  
  4183. procedure TField.SetAutoGenerateValue(const Value: TAutoRefreshFlag);
  4184. begin
  4185.   CheckInactive;
  4186.   FAutoGenerateValue := Value;
  4187. end;
  4188.  
  4189. { TStringField }
  4190.  
  4191. constructor TStringField.Create(AOwner: TComponent);
  4192. begin
  4193.   inherited Create(AOwner);
  4194.   SetDataType(ftString);
  4195.   if Size = 0 then Size := 20; { Don't reset descendent settings }
  4196.   Transliterate := True;
  4197. end;
  4198.  
  4199. class procedure TStringField.CheckTypeSize(Value: Integer);
  4200. begin
  4201.   if (Value < 0) or (Value > dsMaxStringSize) then
  4202.     DatabaseError(SInvalidFieldSize);
  4203. end;
  4204.  
  4205. function TStringField.GetAsBoolean: Boolean;
  4206. var
  4207.   S: string;
  4208. begin
  4209.   S := GetAsString;
  4210.   Result := (Length(S) > 0) and (S[1] in ['T', 't', 'Y', 'y']);
  4211. end;
  4212.  
  4213. function TStringField.GetAsDateTime: TDateTime;
  4214. begin
  4215.   Result := StrToDateTime(GetAsString);
  4216. end;
  4217.  
  4218. function TStringField.GetAsFloat: Double;
  4219. begin
  4220.   Result := StrToFloat(GetAsString);
  4221. end;
  4222.  
  4223. function TStringField.GetAsInteger: Longint;
  4224. begin
  4225.   Result := StrToInt(GetAsString);
  4226. end;
  4227.  
  4228. function TStringField.GetAsString: string;
  4229. begin
  4230.   if not GetValue(Result) then Result := '';
  4231. end;
  4232.  
  4233. function TStringField.GetAsVariant: Variant;
  4234. var
  4235.   S: string;
  4236. begin
  4237.   if GetValue(S) then Result := S else Result := Null;
  4238. end;
  4239.  
  4240. function TStringField.GetDataSize: Integer;
  4241. begin
  4242.   Result := Size + 1;
  4243. end;
  4244.  
  4245. function TStringField.GetDefaultWidth: Integer;
  4246. begin
  4247.   Result := Size;
  4248. end;
  4249.  
  4250. procedure TStringField.GetText(var Text: string; DisplayText: Boolean);
  4251. begin
  4252.   if DisplayText and (EditMaskPtr <> '') then
  4253.     Text := FormatMaskText(EditMaskPtr, GetAsString) else
  4254.     Text := GetAsString;
  4255. end;
  4256.  
  4257. function TStringField.GetValue(var Value: string): Boolean;
  4258. var
  4259.   Buffer: array[0..dsMaxStringSize] of Char;
  4260. begin
  4261.   Result := GetData(@Buffer);
  4262.   if Result then
  4263.   begin
  4264.     Value := Buffer;
  4265.     if Transliterate and (Value <> '') then
  4266.       DataSet.Translate(PChar(Value), PChar(Value), False);
  4267.   end;
  4268. end;
  4269.  
  4270. procedure TStringField.SetAsBoolean(Value: Boolean);
  4271. const
  4272.   Values: array[Boolean] of string[1] = ('F', 'T');
  4273. begin
  4274.   SetAsString(Values[Value]);
  4275. end;
  4276.  
  4277. procedure TStringField.SetAsDateTime(Value: TDateTime);
  4278. begin
  4279.   SetAsString(DateTimeToStr(Value));
  4280. end;
  4281.  
  4282. procedure TStringField.SetAsFloat(Value: Double);
  4283. begin
  4284.   SetAsString(FloatToStr(Value));
  4285. end;
  4286.  
  4287. procedure TStringField.SetAsInteger(Value: Longint);
  4288. begin
  4289.   SetAsString(IntToStr(Value));
  4290. end;
  4291.  
  4292. procedure TStringField.SetAsString(const Value: string);
  4293. var
  4294.   Buffer: array[0..dsMaxStringSize] of Char;
  4295. begin
  4296.   StrLCopy(Buffer, PChar(Value), Size);
  4297.   if Transliterate then
  4298.     DataSet.Translate(Buffer, Buffer, True);
  4299.   SetData(@Buffer);
  4300. end;
  4301.  
  4302. procedure TStringField.SetVarValue(const Value: Variant);
  4303. begin
  4304.   SetAsString(Value);
  4305. end;
  4306.  
  4307. { TWideStringField }
  4308.  
  4309. class procedure TWideStringField.CheckTypeSize(Value: Integer);
  4310. begin
  4311.   if (Value < 0) then
  4312.     DatabaseError(SInvalidFieldSize);
  4313. end;
  4314.  
  4315. constructor TWideStringField.Create(AOwner: TComponent);
  4316. begin
  4317.   inherited Create(AOwner);
  4318.   SetDataType(ftWideString);
  4319. end;
  4320.  
  4321. function TWideStringField.GetAsString: string;
  4322. begin
  4323.   Result := GetAsWideString;
  4324. end;
  4325.  
  4326. function TWideStringField.GetAsVariant: Variant;
  4327. var
  4328.   S: PWideChar;
  4329. begin
  4330.   S := nil;
  4331.   if GetData(@S, False) then
  4332.   begin
  4333.     TVarData(Result).VOleStr := PWideChar(S);
  4334.     TVarData(Result).VType := varOleStr;
  4335.   end else
  4336.     Result := Null;
  4337. end;
  4338.  
  4339. function TWideStringField.GetAsWideString: WideString;
  4340. begin
  4341.   GetData(@Result, False);
  4342. end;
  4343.  
  4344. function TWideStringField.GetDataSize: Integer;
  4345. begin
  4346.   Result := SizeOf(WideString);
  4347. end;
  4348.  
  4349. procedure TWideStringField.SetAsString(const Value: string);
  4350. begin
  4351.   SetAsWideString(Value);
  4352. end;
  4353.  
  4354. procedure TWideStringField.SetAsWideString(const Value: WideString);
  4355. var
  4356.   TruncValue: WideString;
  4357. begin
  4358.   if Length(Value) > Size then
  4359.   begin
  4360.     TruncValue := Copy(Value, 1, Size);
  4361.     SetData(@TruncValue, False)
  4362.   end else
  4363.     SetData(@Value, False);
  4364. end;
  4365.  
  4366. procedure TWideStringField.SetVarValue(const Value: Variant);
  4367. begin
  4368.   SetAsWideString(Value);
  4369. end;
  4370.  
  4371. { TNumericField }
  4372.  
  4373. constructor TNumericField.Create(AOwner: TComponent);
  4374. begin
  4375.   inherited Create(AOwner);
  4376.   Alignment := taRightJustify;
  4377. end;
  4378.  
  4379. procedure TNumericField.RangeError(Value, Min, Max: Extended);
  4380. begin
  4381.   DatabaseErrorFmt(SFieldRangeError, [Value, DisplayName, Min, Max]);
  4382. end;
  4383.  
  4384. procedure TNumericField.SetDisplayFormat(const Value: string);
  4385. begin
  4386.   if FDisplayFormat <> Value then
  4387.   begin
  4388.     FDisplayFormat := Value;
  4389.     PropertyChanged(False);
  4390.   end;
  4391. end;
  4392.  
  4393. procedure TNumericField.SetEditFormat(const Value: string);
  4394. begin
  4395.   if FEditFormat <> Value then
  4396.   begin
  4397.     FEditFormat := Value;
  4398.     PropertyChanged(False);
  4399.   end;
  4400. end;
  4401.  
  4402. { TIntegerField }
  4403.  
  4404. constructor TIntegerField.Create(AOwner: TComponent);
  4405. begin
  4406.   inherited Create(AOwner);
  4407.   SetDataType(ftInteger);
  4408.   FMinRange := Low(Longint);
  4409.   FMaxRange := High(Longint);
  4410.   ValidChars := ['+', '-', '0'..'9'];
  4411. end;
  4412.  
  4413. procedure TIntegerField.CheckRange(Value, Min, Max: Longint);
  4414. begin
  4415.   if (Value < Min) or (Value > Max) then RangeError(Value, Min, Max);
  4416. end;
  4417.  
  4418. function TIntegerField.GetAsFloat: Double;
  4419. begin
  4420.   Result := GetAsInteger;
  4421. end;
  4422.  
  4423. function TIntegerField.GetAsInteger: Longint;
  4424. begin
  4425.   if not GetValue(Result) then Result := 0;
  4426. end;
  4427.  
  4428. function TIntegerField.GetAsString: string;
  4429. var
  4430.   L: Longint;
  4431. begin
  4432.   if GetValue(L) then Str(L, Result) else Result := '';
  4433. end;
  4434.  
  4435. function TIntegerField.GetAsVariant: Variant;
  4436. var
  4437.   L: Longint;
  4438. begin
  4439.   if GetValue(L) then Result := L else Result := Null;
  4440. end;
  4441.  
  4442. function TIntegerField.GetDataSize: Integer;
  4443. begin
  4444.   Result := SizeOf(Integer);
  4445. end;
  4446.  
  4447. procedure TIntegerField.GetText(var Text: string; DisplayText: Boolean);
  4448. var
  4449.   L: Longint;
  4450.   FmtStr: string;
  4451. begin
  4452.   if GetValue(L) then
  4453.   begin
  4454.     if DisplayText or (FEditFormat = '') then
  4455.       FmtStr := FDisplayFormat else
  4456.       FmtStr := FEditFormat;
  4457.     if FmtStr = '' then Str(L, Text) else Text := FormatFloat(FmtStr, L);
  4458.   end else
  4459.     Text := '';
  4460. end;
  4461.  
  4462. function TIntegerField.GetValue(var Value: Longint): Boolean;
  4463. var
  4464.   Data: record
  4465.     case Integer of
  4466.       0: (I: Smallint);
  4467.       1: (W: Word);
  4468.       2: (L: Longint);
  4469.   end;
  4470. begin
  4471.   Data.L := 0;
  4472.   Result := GetData(@Data);
  4473.   if Result then
  4474.     case DataType of
  4475.       ftSmallint: Value := Data.I;
  4476.       ftWord: Value := Data.W;
  4477.     else
  4478.       Value := Data.L;
  4479.     end;
  4480. end;
  4481.  
  4482. procedure TIntegerField.SetAsFloat(Value: Double);
  4483. begin
  4484.   SetAsInteger(Integer(Round(Value)));
  4485. end;
  4486.  
  4487. procedure TIntegerField.SetAsInteger(Value: Longint);
  4488. begin
  4489.   if (FMinValue <> 0) or (FMaxValue <> 0) then
  4490.     CheckRange(Value, FMinValue, FMaxValue) else
  4491.     CheckRange(Value, FMinRange, FMaxRange);
  4492.   SetData(@Value);
  4493. end;
  4494.  
  4495. procedure TIntegerField.SetAsString(const Value: string);
  4496. var
  4497.   E: Integer;
  4498.   L: Longint;
  4499. begin
  4500.   if Value = '' then Clear else
  4501.   begin
  4502.     Val(Value, L, E);
  4503.     if E <> 0 then DatabaseErrorFmt(SInvalidIntegerValue, [Value, DisplayName]);
  4504.     SetAsInteger(L);
  4505.   end;
  4506. end;
  4507.  
  4508. procedure TIntegerField.SetMaxValue(Value: Longint);
  4509. begin
  4510.   CheckRange(Value, FMinRange, FMaxRange);
  4511.   FMaxValue := Value;
  4512. end;
  4513.  
  4514. procedure TIntegerField.SetMinValue(Value: Longint);
  4515. begin
  4516.   CheckRange(Value, FMinRange, FMaxRange);
  4517.   FMinValue := Value;
  4518. end;
  4519.  
  4520. procedure TIntegerField.SetVarValue(const Value: Variant);
  4521. begin
  4522.   SetAsInteger(Value);
  4523. end;
  4524.  
  4525. { TSmallintField }
  4526.  
  4527. constructor TSmallintField.Create(AOwner: TComponent);
  4528. begin
  4529.   inherited Create(AOwner);
  4530.   SetDataType(ftSmallint);
  4531.   FMinRange := Low(Smallint);
  4532.   FMaxRange := High(Smallint);
  4533. end;
  4534.  
  4535. function TSmallintField.GetDataSize: Integer;
  4536. begin
  4537.   Result := SizeOf(SmallInt);
  4538. end;
  4539.  
  4540. { TLargeintField }
  4541.  
  4542. constructor TLargeintField.Create(AOwner: TComponent);
  4543. begin
  4544.   inherited Create(AOwner);
  4545.   SetDataType(ftLargeint);
  4546.   ValidChars := ['+', '-', '0'..'9'];
  4547. end;
  4548.  
  4549. procedure TLargeintField.CheckRange(Value, Min, Max: Largeint);
  4550. begin
  4551.   if (Value < Min) or (Value > Max) then RangeError(Value, Min, Max);
  4552. end;
  4553.  
  4554. function TLargeintField.GetAsFloat: Double;
  4555. begin
  4556.   Result := GetAsLargeint;
  4557. end;
  4558.  
  4559. function TLargeintField.GetAsInteger: Longint;
  4560. var
  4561.   L: LargeInt;
  4562. begin
  4563.   if GetValue(L) then Result := Longint(L) else Result := 0;
  4564. end;
  4565.  
  4566. function TLargeintField.GetAsLargeint: Largeint;
  4567. begin
  4568.   if not GetValue(Result) then Result := 0;
  4569. end;
  4570.  
  4571. function TLargeintField.GetAsString: string;
  4572. var
  4573.   L: Largeint;
  4574. begin
  4575.   if GetValue(L) then Str(L, Result) else Result := '';
  4576. end;
  4577.  
  4578. function TLargeintField.GetAsVariant: Variant;
  4579. begin
  4580.   if IsNull then
  4581.     Result := Null else
  4582.   begin
  4583.     TVarData(Result).VType := VT_DECIMAL;
  4584.     Decimal(Result).lo64 := GetAsLargeInt;
  4585.   end;
  4586. end;
  4587.  
  4588. function TLargeintField.GetDataSize: Integer;
  4589. begin
  4590.   Result := SizeOf(Largeint);
  4591. end;
  4592.  
  4593. function TLargeintField.GetDefaultWidth: Integer;
  4594. begin
  4595.   Result := 15;
  4596. end;
  4597.  
  4598. procedure TLargeintField.GetText(var Text: string; DisplayText: Boolean);
  4599. var
  4600.   L: Largeint;
  4601.   FmtStr: string;
  4602. begin
  4603.   if GetValue(L) then
  4604.   begin
  4605.     if DisplayText or (FEditFormat = '') then
  4606.       FmtStr := FDisplayFormat else
  4607.       FmtStr := FEditFormat;
  4608.     if FmtStr = '' then Str(L, Text) else Text := FormatFloat(FmtStr, L);
  4609.   end else
  4610.     Text := '';
  4611. end;
  4612.  
  4613. function TLargeintField.GetValue(var Value: Largeint): Boolean;
  4614. begin
  4615.   Result := GetData(@Value);
  4616. end;
  4617.  
  4618. procedure TLargeintField.SetAsFloat(Value: Double);
  4619. begin
  4620.   SetAsLargeint(Round(Value));
  4621. end;
  4622.  
  4623. procedure TLargeintField.SetAsInteger(Value: Longint);
  4624. begin
  4625.   SetAsLargeInt(Value);
  4626. end;
  4627.  
  4628. procedure TLargeintField.SetAsLargeint(Value: Largeint);
  4629. begin
  4630.   if (FMinValue <> 0) or (FMaxValue <> 0) then
  4631.     CheckRange(Value, FMinValue, FMaxValue);
  4632.   SetData(@Value);
  4633. end;
  4634.  
  4635. procedure TLargeintField.SetAsString(const Value: string);
  4636. var
  4637.   E: Integer;
  4638.   L: Largeint;
  4639. begin
  4640.   if Value = '' then Clear else
  4641.   begin
  4642.     Val(Value, L, E);
  4643.     if E <> 0 then DatabaseErrorFmt(SInvalidIntegerValue, [Value, DisplayName]);
  4644.     SetAsLargeint(L);
  4645.   end;
  4646. end;
  4647.  
  4648. procedure TLargeintField.SetVarValue(const Value: Variant);
  4649. begin
  4650.   AccessError('Variant');
  4651. end;
  4652.  
  4653. { TWordField }
  4654.  
  4655. constructor TWordField.Create(AOwner: TComponent);
  4656. begin
  4657.   inherited Create(AOwner);
  4658.   SetDataType(ftWord);
  4659.   FMinRange := Low(Word);
  4660.   FMaxRange := High(Word);
  4661. end;
  4662.  
  4663. function TWordField.GetDataSize: Integer;
  4664. begin
  4665.   Result := SizeOf(Word);
  4666. end;
  4667.  
  4668. { TAutoIncField }
  4669.  
  4670. constructor TAutoIncField.Create(AOwner: TComponent);
  4671. begin
  4672.   inherited Create(AOwner);
  4673.   SetDataType(ftAutoInc);
  4674. end;
  4675.  
  4676. { TFloatField }
  4677.  
  4678. constructor TFloatField.Create(AOwner: TComponent);
  4679. begin
  4680.   inherited Create(AOwner);
  4681.   SetDataType(ftFloat);
  4682.   FPrecision := 15;
  4683.   ValidChars := [DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
  4684. end;
  4685.  
  4686. function TFloatField.GetAsFloat: Double;
  4687. begin
  4688.   if not GetData(@Result) then Result := 0;
  4689. end;
  4690.  
  4691. function TFloatField.GetAsInteger: Longint;
  4692. begin
  4693.   Result := Longint(Round(GetAsFloat));
  4694. end;
  4695.  
  4696. function TFloatField.GetAsString: string;
  4697. var
  4698.   F: Double;
  4699. begin
  4700.   if GetData(@F) then Result := FloatToStr(F) else Result := '';
  4701. end;
  4702.  
  4703. function TFloatField.GetAsVariant: Variant;
  4704. var
  4705.   F: Double;
  4706. begin
  4707.   if GetData(@F) then Result := F else Result := Null;
  4708. end;
  4709.  
  4710. function TFloatField.GetDataSize: Integer;
  4711. begin
  4712.   Result := SizeOf(Double);
  4713. end;
  4714.  
  4715. procedure TFloatField.GetText(var Text: string; DisplayText: Boolean);
  4716. var
  4717.   Format: TFloatFormat;
  4718.   FmtStr: string;
  4719.   Digits: Integer;
  4720.   F: Double;
  4721. begin
  4722.   if GetData(@F) then
  4723.   begin
  4724.     if DisplayText or (FEditFormat = '') then
  4725.       FmtStr := FDisplayFormat else
  4726.       FmtStr := FEditFormat;
  4727.     if FmtStr = '' then
  4728.     begin
  4729.       if FCurrency then
  4730.       begin
  4731.         if DisplayText then Format := ffCurrency else Format := ffFixed;
  4732.         Digits := CurrencyDecimals;
  4733.       end
  4734.       else begin
  4735.         Format := ffGeneral;
  4736.         Digits := 0;
  4737.       end;
  4738.       Text := FloatToStrF(F, Format, FPrecision, Digits);
  4739.     end else
  4740.       Text := FormatFloat(FmtStr, F);
  4741.   end else
  4742.     Text := '';
  4743. end;
  4744.  
  4745. procedure TFloatField.SetAsFloat(Value: Double);
  4746. begin
  4747.   if FCheckRange and ((Value < FMinValue) or (Value > FMaxValue)) then
  4748.     RangeError(Value, FMinValue, FMaxValue);
  4749.   SetData(@Value);
  4750. end;
  4751.  
  4752. procedure TFloatField.SetAsInteger(Value: Longint);
  4753. begin
  4754.   SetAsFloat(Value);
  4755. end;
  4756.  
  4757. procedure TFloatField.SetAsString(const Value: string);
  4758. var
  4759.   F: Extended;
  4760. begin
  4761.   if Value = '' then Clear else
  4762.   begin
  4763.     if not TextToFloat(PChar(Value), F, fvExtended) then
  4764.       DatabaseErrorFmt(SInvalidFloatValue, [Value, DisplayName]);
  4765.     SetAsFloat(F);
  4766.   end;
  4767. end;
  4768.  
  4769. procedure TFloatField.SetCurrency(Value: Boolean);
  4770. begin
  4771.   if FCurrency <> Value then
  4772.   begin
  4773.     FCurrency := Value;
  4774.     PropertyChanged(False);
  4775.   end;
  4776. end;
  4777.  
  4778. procedure TFloatField.SetMaxValue(Value: Double);
  4779. begin
  4780.   FMaxValue := Value;
  4781.   UpdateCheckRange;
  4782. end;
  4783.  
  4784. procedure TFloatField.SetMinValue(Value: Double);
  4785. begin
  4786.   FMinValue := Value;
  4787.   UpdateCheckRange;
  4788. end;
  4789.  
  4790. procedure TFloatField.SetPrecision(Value: Integer);
  4791. begin
  4792.   if Value < 2 then Value := 2;
  4793.   if Value > 15 then Value := 15;
  4794.   if FPrecision <> Value then
  4795.   begin
  4796.     FPrecision := Value;
  4797.     PropertyChanged(False);
  4798.   end;
  4799. end;
  4800.  
  4801. procedure TFloatField.SetVarValue(const Value: Variant);
  4802. begin
  4803.   SetAsFloat(Value);
  4804. end;
  4805.  
  4806. procedure TFloatField.UpdateCheckRange;
  4807. begin
  4808.   FCheckRange := (FMinValue <> 0) or (FMaxValue <> 0);
  4809. end;
  4810.  
  4811. { TCurrencyField }
  4812.  
  4813. constructor TCurrencyField.Create(AOwner: TComponent);
  4814. begin
  4815.   inherited Create(AOwner);
  4816.   SetDataType(ftCurrency);
  4817.   FCurrency := True;
  4818. end;
  4819.  
  4820. { TBooleanField }
  4821.  
  4822. constructor TBooleanField.Create(AOwner: TComponent);
  4823. begin
  4824.   inherited Create(AOwner);
  4825.   SetDataType(ftBoolean);
  4826.   LoadTextValues;
  4827. end;
  4828.  
  4829. function TBooleanField.GetAsBoolean: Boolean;
  4830. var
  4831.   B: WordBool;
  4832. begin
  4833.   if GetData(@B) then Result := B else Result := False;
  4834. end;
  4835.  
  4836. function TBooleanField.GetAsString: string;
  4837. var
  4838.   B: WordBool;
  4839. begin
  4840.   if GetData(@B) then Result := FTextValues[B] else Result := '';
  4841. end;
  4842.  
  4843. function TBooleanField.GetAsVariant: Variant;
  4844. var
  4845.   B: WordBool;
  4846. begin
  4847.   if GetData(@B) then Result := B else Result := Null;
  4848. end;
  4849.  
  4850. function TBooleanField.GetDataSize: Integer;
  4851. begin
  4852.   Result := SizeOf(WordBool);
  4853. end;
  4854.  
  4855. function TBooleanField.GetDefaultWidth: Integer;
  4856. begin
  4857.   if Length(FTextValues[False]) > Length(FTextValues[True]) then
  4858.     Result := Length(FTextValues[False]) else
  4859.     Result := Length(FTextValues[True]);
  4860. end;
  4861.  
  4862. procedure TBooleanField.LoadTextValues;
  4863. begin
  4864.   FTextValues[False] := STextFalse;
  4865.   FTextValues[True] := STextTrue;
  4866. end;
  4867.  
  4868. procedure TBooleanField.SetAsBoolean(Value: Boolean);
  4869. var
  4870.   B: WordBool;
  4871. begin
  4872.   if Value then Word(B) := 1 else Word(B) := 0;
  4873.   SetData(@B);
  4874. end;
  4875.  
  4876. procedure TBooleanField.SetAsString(const Value: string);
  4877. var
  4878.   L: Integer;
  4879. begin
  4880.   L := Length(Value);
  4881.   if L = 0 then
  4882.   begin
  4883.     if Length(FTextValues[False]) = 0 then SetAsBoolean(False) else
  4884.       if Length(FTextValues[True]) = 0 then SetAsBoolean(True) else
  4885.         Clear;
  4886.   end else
  4887.   begin
  4888.     if AnsiCompareText(Value, Copy(FTextValues[False], 1, L)) = 0 then
  4889.       SetAsBoolean(False)
  4890.     else
  4891.       if AnsiCompareText(Value, Copy(FTextValues[True], 1, L)) = 0 then
  4892.         SetAsBoolean(True)
  4893.       else
  4894.         DatabaseErrorFmt(SInvalidBoolValue, [Value, DisplayName]);
  4895.   end;
  4896. end;
  4897.  
  4898. procedure TBooleanField.SetDisplayValues(const Value: string);
  4899. var
  4900.   P: Integer;
  4901. begin
  4902.   if FDisplayValues <> Value then
  4903.   begin
  4904.     FDisplayValues := Value;
  4905.     if Value = '' then LoadTextValues else
  4906.     begin
  4907.       P := Pos(';', Value);
  4908.       if P = 0 then P := 256;
  4909.       FTextValues[False] := Copy(Value, P + 1, 255);
  4910.       FTextValues[True] := Copy(Value, 1, P - 1);
  4911.     end;
  4912.     PropertyChanged(True);
  4913.   end;
  4914. end;
  4915.  
  4916. procedure TBooleanField.SetVarValue(const Value: Variant);
  4917. begin
  4918.   SetAsBoolean(Value);
  4919. end;
  4920.  
  4921. { TDateTimeField }
  4922.  
  4923. constructor TDateTimeField.Create(AOwner: TComponent);
  4924. begin
  4925.   inherited Create(AOwner);
  4926.   SetDataType(ftDateTime);
  4927. end;
  4928.  
  4929. procedure TDateTimeField.CopyData(Source, Dest: Pointer);
  4930. begin
  4931.   TDateTime(Dest^) := TDateTime(Source^);
  4932. end;
  4933.  
  4934. function TDateTimeField.GetAsDateTime: TDateTime;
  4935. begin
  4936.   if not GetValue(Result) then Result := 0;
  4937. end;
  4938.  
  4939. function TDateTimeField.GetAsFloat: Double;
  4940. begin
  4941.   Result := GetAsDateTime;
  4942. end;
  4943.  
  4944. function TDateTimeField.GetAsString: string;
  4945. begin
  4946.   GetText(Result, False);
  4947. end;
  4948.  
  4949. function TDateTimeField.GetAsVariant: Variant;
  4950. var
  4951.   D: TDateTime;
  4952. begin
  4953.   if GetValue(D) then Result := VarFromDateTime(D) else Result := Null;
  4954. end;
  4955.  
  4956. function TDateTimeField.GetDataSize: Integer;
  4957. begin
  4958.   Result := SizeOf(TDateTime);
  4959. end;
  4960.  
  4961. function TDateTimeField.GetDefaultWidth: Integer;
  4962. begin
  4963.   Result := DataSize * 2 + 2;
  4964. end;
  4965.  
  4966. procedure TDateTimeField.GetText(var Text: string; DisplayText: Boolean);
  4967. var
  4968.   F: string;
  4969.   D: TDateTime;
  4970. begin
  4971.   if GetValue(D) then
  4972.   begin
  4973.     if DisplayText and (FDisplayFormat <> '') then
  4974.       F := FDisplayFormat
  4975.     else
  4976.       case DataType of
  4977.         ftDate: F := ShortDateFormat;
  4978.         ftTime: F := LongTimeFormat;
  4979.       end;
  4980.     DateTimeToString(Text, F, D);
  4981.   end else
  4982.     Text := '';
  4983. end;
  4984.  
  4985. function TDateTimeField.GetValue(var Value: TDateTime): Boolean;
  4986. begin
  4987.   Result := GetData(@Value, False);
  4988. end;
  4989.  
  4990. procedure TDateTimeField.SetAsDateTime(Value: TDateTime);
  4991. begin
  4992.   SetData(@Value, False);
  4993. end;
  4994.  
  4995. procedure TDateTimeField.SetAsFloat(Value: Double);
  4996. begin
  4997.   SetAsDateTime(Value);
  4998. end;
  4999.  
  5000. procedure TDateTimeField.SetAsString(const Value: string);
  5001. var
  5002.   DateTime: TDateTime;
  5003. begin
  5004.   if Value = '' then Clear else
  5005.   begin
  5006.     case DataType of
  5007.       ftDate: DateTime := StrToDate(Value);
  5008.       ftTime: DateTime := StrToTime(Value);
  5009.     else
  5010.       DateTime := StrToDateTime(Value);
  5011.     end;
  5012.     SetAsDateTime(DateTime);
  5013.   end;
  5014. end;
  5015.  
  5016. procedure TDateTimeField.SetDisplayFormat(const Value: string);
  5017. begin
  5018.   if FDisplayFormat <> Value then
  5019.   begin
  5020.     FDisplayFormat := Value;
  5021.     PropertyChanged(False);
  5022.   end;
  5023. end;
  5024.  
  5025. procedure TDateTimeField.SetVarValue(const Value: Variant);
  5026. begin
  5027.   SetAsDateTime(VarToDateTime(Value));
  5028. end;
  5029.  
  5030. { TDateField }
  5031.  
  5032. constructor TDateField.Create(AOwner: TComponent);
  5033. begin
  5034.   inherited Create(AOwner);
  5035.   SetDataType(ftDate);
  5036. end;
  5037.  
  5038. function TDateField.GetDataSize: Integer;
  5039. begin
  5040.   Result := SizeOf(Integer);
  5041. end;
  5042.  
  5043. { TTimeField }
  5044.  
  5045. constructor TTimeField.Create(AOwner: TComponent);
  5046. begin
  5047.   inherited Create(AOwner);
  5048.   SetDataType(ftTime);
  5049. end;
  5050.  
  5051. procedure TBinaryField.CopyData(Source, Dest: Pointer);
  5052. begin
  5053.   POleVariant(Dest)^ := POleVariant(Source)^;
  5054. end;
  5055.  
  5056. function TTimeField.GetDataSize: Integer;
  5057. begin
  5058.   Result := SizeOf(Integer);
  5059. end;
  5060.  
  5061. { TBinaryField }
  5062.  
  5063. constructor TBinaryField.Create(AOwner: TComponent);
  5064. begin
  5065.   inherited Create(AOwner);
  5066. end;
  5067.  
  5068. class procedure TBinaryField.CheckTypeSize(Value: Integer);
  5069. begin
  5070.   if (Value = 0) then DatabaseError(SInvalidFieldSize);
  5071. end;
  5072.  
  5073. function TBinaryField.GetAsString: string;
  5074. var
  5075.   Len: Integer;
  5076.   Data: Variant;
  5077.   PData: Pointer;
  5078. begin
  5079.   Data := GetAsByteArray;
  5080.   if VarIsNull(Data) then
  5081.     Result := ''
  5082.   else
  5083.   begin
  5084.     Len := VarArrayHighBound(Data, 1) + 1;
  5085.     PData := VarArrayLock(Data);
  5086.     try
  5087.       SetLength(Result, Len);
  5088.       Move(PData^, Pointer(Result)^, Len);
  5089.     finally
  5090.       VarArrayUnlock(Data);
  5091.     end;
  5092.   end;
  5093. end;
  5094.  
  5095. procedure TBinaryField.SetAsString(const Value: string);
  5096. var
  5097.   Len: Integer;
  5098.   Data: Variant;
  5099.   PData: Pointer;
  5100. begin
  5101.   if Value = '' then Clear else
  5102.   begin
  5103.     Len := Length(Value);
  5104.     if Len > Size then Len := Size;
  5105.     Data := VarArrayCreate([0,Len-1], varByte);
  5106.     PData := VarArrayLock(Data);
  5107.     try
  5108.       Move(Pointer(Value)^, PData^, Len);
  5109.     finally
  5110.       VarArrayUnlock(Data);
  5111.     end;
  5112.     SetAsByteArray(Data);
  5113.   end;
  5114. end;
  5115.  
  5116. function TBinaryField.GetAsVariant: Variant;
  5117. begin
  5118.   Result := GetAsByteArray;
  5119. end;
  5120.  
  5121. procedure TBinaryField.SetVarValue(const Value: Variant);
  5122. begin
  5123.   SetAsByteArray(Value);
  5124. end;
  5125.  
  5126. procedure TBinaryField.GetText(var Text: string; DisplayText: Boolean);
  5127. begin
  5128.   Text := inherited GetAsString;
  5129. end;
  5130.  
  5131. procedure TBinaryField.SetText(const Value: string);
  5132. begin
  5133.   raise AccessError('Text');
  5134. end;
  5135.  
  5136. { TBytesField }
  5137.  
  5138. constructor TBytesField.Create(AOwner: TComponent);
  5139. begin
  5140.   inherited Create(AOwner);
  5141.   SetDataType(ftBytes);
  5142.   Size := 16;
  5143. end;
  5144.  
  5145. function TBytesField.GetDataSize: Integer;
  5146. begin
  5147.   Result := Size;
  5148. end;
  5149.  
  5150. { TVarBytesField }
  5151.  
  5152. constructor TVarBytesField.Create(AOwner: TComponent);
  5153. begin
  5154.   inherited Create(AOwner);
  5155.   SetDataType(ftVarBytes);
  5156.   Size := 16;
  5157. end;
  5158.  
  5159. function TVarBytesField.GetDataSize: Integer;
  5160. begin
  5161.   Result := Size + SizeOf(Word) {Length Prefix};
  5162. end;
  5163.  
  5164. procedure TVarBytesField.SetAsByteArray(const Value: Variant);
  5165. var
  5166.   Data: Pointer;
  5167. begin
  5168.   { If size of variant array is equal to data, assume a length prefix is included }
  5169.   if VarIsArray(Value) and ((VarArrayHighBound(Value, 1) + 1) = DataSize) then
  5170.   begin
  5171.     Data := VarArrayLock(Value);
  5172.     try
  5173.       SetData(Data, True);
  5174.     finally
  5175.       VarArrayUnlock(Value);
  5176.     end
  5177.   end else
  5178.     inherited;
  5179. end;
  5180.  
  5181. { TBCDField }
  5182.  
  5183. constructor TBCDField.Create(AOwner: TComponent);
  5184. begin
  5185.   inherited Create(AOwner);
  5186.   SetDataType(ftBCD);
  5187.   Size := 4;
  5188.   ValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
  5189. end;
  5190.  
  5191. class procedure TBCDField.CheckTypeSize(Value: Integer);
  5192. begin
  5193.   { For BCD fields, the scale is stored in the size property.
  5194.     We allow values up to 32 here even though the currency data type
  5195.     only supports up to 4 digits of scale.  The developer can check
  5196.     for sizes > 4 to determine if the value from the server may have
  5197.     been rounded }
  5198.   if Value > 32 then DatabaseError(SInvalidFieldSize);
  5199. end;
  5200.  
  5201. function TBCDField.GetAsCurrency: Currency;
  5202. begin
  5203.   if not GetValue(Result) then Result := 0;
  5204. end;
  5205.  
  5206. function TBCDField.GetAsFloat: Double;
  5207. begin
  5208.   Result := GetAsCurrency;
  5209. end;
  5210.  
  5211. function TBCDField.GetAsInteger: Longint;
  5212. begin
  5213.   Result := Longint(Round(GetAsCurrency));
  5214. end;
  5215.  
  5216. function TBCDField.GetAsString: string;
  5217. var
  5218.   C: System.Currency;
  5219. begin
  5220.   if GetValue(C) then Result := CurrToStr(C) else Result := '';
  5221. end;
  5222.  
  5223. function TBCDField.GetAsVariant: Variant;
  5224. var
  5225.   C: System.Currency;
  5226. begin
  5227.   if GetValue(C) then Result := C else Result := Null;
  5228. end;
  5229.  
  5230. function TBCDField.GetDataSize: Integer;
  5231. begin
  5232.   Result := SizeOf(TBcd);
  5233. end;
  5234.  
  5235. function TBCDField.GetDefaultWidth: Integer;
  5236. begin
  5237.   if FPrecision > 0 then
  5238.     Result := FPrecision + 1 else
  5239.     Result := inherited GetDefaultWidth;
  5240. end;
  5241.  
  5242. procedure TBCDField.GetText(var Text: string; DisplayText: Boolean);
  5243. var
  5244.   Format: TFloatFormat;
  5245.   Digits: Integer;
  5246.   FmtStr: string;
  5247.   C: System.Currency;
  5248. begin
  5249.   try
  5250.     if GetData(@C, False) then
  5251.     begin
  5252.       if DisplayText or (EditFormat = '') then
  5253.         FmtStr := DisplayFormat else
  5254.         FmtStr := EditFormat;
  5255.       if FmtStr = '' then
  5256.       begin
  5257.         if FCurrency then
  5258.         begin
  5259.           if DisplayText then Format := ffCurrency else Format := ffFixed;
  5260.           Digits := CurrencyDecimals;
  5261.         end
  5262.         else begin
  5263.           Format := ffGeneral;
  5264.           Digits := 0;
  5265.         end;
  5266.         Text := CurrToStrF(C, Format, Digits);
  5267.       end else
  5268.         Text := FormatCurr(FmtStr, C);
  5269.     end else
  5270.       Text := '';
  5271.   except
  5272.     on E: Exception do
  5273.       Text := SBCDOverflow;
  5274.   end;
  5275. end;
  5276.  
  5277. function TBCDField.GetValue(var Value: Currency): Boolean;
  5278. begin
  5279.   Result := GetData(@Value, False);
  5280. end;
  5281.  
  5282. procedure TBCDField.SetAsCurrency(Value: Currency);
  5283. begin
  5284.   if FCheckRange and ((Value < FMinValue) or (Value > FMaxValue)) then
  5285.     RangeError(Value, FMinValue, FMaxValue);
  5286.   SetData(@Value, False);
  5287. end;
  5288.  
  5289. procedure TBCDField.SetAsFloat(Value: Double);
  5290. begin
  5291.   SetAsCurrency(Value);
  5292. end;
  5293.  
  5294. procedure TBCDField.SetAsInteger(Value: Longint);
  5295. begin
  5296.   SetAsCurrency(Value);
  5297. end;
  5298.  
  5299. procedure TBCDField.SetAsString(const Value: string);
  5300. var
  5301.   C: System.Currency;
  5302. begin
  5303.   if Value = '' then Clear else
  5304.   begin
  5305.     if not TextToFloat(PChar(Value), C, fvCurrency) then
  5306.       DatabaseErrorFmt(SInvalidFloatValue, [Value, DisplayName]);
  5307.     SetAsCurrency(C);
  5308.   end;
  5309. end;
  5310.  
  5311. procedure TBCDField.SetCurrency(Value: Boolean);
  5312. begin
  5313.   if FCurrency <> Value then
  5314.   begin
  5315.     FCurrency := Value;
  5316.     PropertyChanged(False);
  5317.   end;
  5318. end;
  5319.  
  5320. procedure TBCDField.SetMaxValue(Value: Currency);
  5321. begin
  5322.   FMaxValue := Value;
  5323.   UpdateCheckRange;
  5324. end;
  5325.  
  5326. procedure TBCDField.SetMinValue(Value: Currency);
  5327. begin
  5328.   FMinValue := Value;
  5329.   UpdateCheckRange;
  5330. end;
  5331.  
  5332. procedure TBCDField.SetPrecision(Value: Integer);
  5333. begin
  5334.   if (DataSet <> nil) then
  5335.     DataSet.CheckInactive;
  5336.   if Value < 0 then Value := 0;
  5337.   if Value > 32 then Value := 32;
  5338.   if FPrecision <> Value then
  5339.   begin
  5340.     FPrecision := Value;
  5341.     PropertyChanged(False);
  5342.   end;
  5343. end;
  5344.  
  5345. procedure TBCDField.SetVarValue(const Value: Variant);
  5346. begin
  5347.   SetAsCurrency(Value);
  5348. end;
  5349.  
  5350. procedure TBCDField.UpdateCheckRange;
  5351. begin
  5352.   FCheckRange := (FMinValue <> 0) or (FMaxValue <> 0);
  5353. end;
  5354.  
  5355. procedure TBCDField.CopyData(Source, Dest: Pointer);
  5356. begin
  5357.   System.Currency(Dest^) := System.Currency(Source^);
  5358. end;
  5359.  
  5360. { TBlobField }
  5361.  
  5362. constructor TBlobField.Create(AOwner: TComponent);
  5363. begin
  5364.   inherited Create(AOwner);
  5365.   SetDataType(ftBlob);
  5366. end;
  5367.  
  5368. procedure TBlobField.Assign(Source: TPersistent);
  5369. begin
  5370.   if Source is TBlobField then
  5371.   begin
  5372.     LoadFromBlob(TBlobField(Source));
  5373.     Exit;
  5374.   end;
  5375.   if Source is TStrings then
  5376.   begin
  5377.     LoadFromStrings(TStrings(Source));
  5378.     Exit;
  5379.   end;
  5380.   if Source is TBitmap then
  5381.   begin
  5382.     LoadFromBitmap(TBitmap(Source));
  5383.     Exit;
  5384.   end;
  5385.   if (Source is TPicture) and (TPicture(Source).Graphic is TBitmap) then
  5386.   begin
  5387.     LoadFromBitmap(TBitmap(TPicture(Source).Graphic));
  5388.     Exit;
  5389.   end;
  5390.   inherited Assign(Source);
  5391. end;
  5392.  
  5393. procedure TBlobField.AssignTo(Dest: TPersistent);
  5394. begin
  5395.   if Dest is TStrings then
  5396.   begin
  5397.     SaveToStrings(TStrings(Dest));
  5398.     Exit;
  5399.   end;
  5400.   if Dest is TBitmap then
  5401.   begin
  5402.     SaveToBitmap(TBitmap(Dest));
  5403.     Exit;
  5404.   end;
  5405.   if Dest is TPicture then
  5406.   begin
  5407.     SaveToBitmap(TPicture(Dest).Bitmap);
  5408.     Exit;
  5409.   end;
  5410.   inherited AssignTo(Dest);
  5411. end;
  5412.  
  5413. procedure TBlobField.Clear;
  5414. begin
  5415.   DataSet.CreateBlobStream(Self, bmWrite).Free;
  5416. end;
  5417.  
  5418. procedure TBlobField.FreeBuffers;
  5419. begin
  5420.   if FModified then
  5421.   begin
  5422.     DataSet.CloseBlob(Self);
  5423.     FModified := False;
  5424.   end;
  5425. end;
  5426.  
  5427. function TBlobField.GetAsString: string;
  5428. var
  5429.   Len: Integer;
  5430. begin
  5431.   with DataSet.CreateBlobStream(Self, bmRead) do
  5432.     try
  5433.       Len := Size;
  5434.       SetString(Result, nil, Len);
  5435.       ReadBuffer(Pointer(Result)^, Len);
  5436.     finally
  5437.       Free;
  5438.     end;
  5439. end;
  5440.  
  5441. function TBlobField.GetAsVariant: Variant;
  5442. begin
  5443.   Result := GetAsString;
  5444. end;
  5445.  
  5446. function TBlobField.GetBlobSize: Integer;
  5447. begin
  5448.   with DataSet.CreateBlobStream(Self, bmRead) do
  5449.     try
  5450.       Result := Size;
  5451.     finally
  5452.       Free;
  5453.     end;
  5454. end;
  5455.  
  5456. function TBlobField.GetClassDesc: string;
  5457. begin
  5458.   Result := Format('(%s)', [FieldtypeNames[Datatype]]);
  5459.   if not IsNull then Result := AnsiUpperCase(Result);
  5460. end;
  5461.  
  5462. function TBlobField.GetBlobType: TBlobType;
  5463. begin
  5464.   Result := TBlobType(DataType);
  5465. end;
  5466.  
  5467. function TBlobField.GetIsNull: Boolean;
  5468. begin
  5469.   if Modified then
  5470.   begin
  5471.     with DataSet.CreateBlobStream(Self, bmRead) do
  5472.     try
  5473.       Result := (Size = 0);
  5474.     finally
  5475.       Free;
  5476.     end;
  5477.   end else
  5478.     Result := inherited GetIsNull;
  5479. end;
  5480.  
  5481. function TBlobField.GetModified: Boolean;
  5482. begin
  5483.   Result := FModified and (FModifiedRecord = DataSet.ActiveRecord);
  5484. end;
  5485.  
  5486. procedure TBlobField.GetText(var Text: string; DisplayText: Boolean);
  5487. begin
  5488.   Text := inherited GetAsString;
  5489. end;
  5490.  
  5491. class function TBlobField.IsBlob: Boolean;
  5492. begin
  5493.   Result := True;
  5494. end;
  5495.  
  5496. procedure TBlobField.LoadFromBitmap(Bitmap: TBitmap);
  5497. var
  5498.   BlobStream: TStream;
  5499.   Header: TGraphicHeader;
  5500. begin
  5501.   BlobStream := DataSet.CreateBlobStream(Self, bmWrite);
  5502.   try
  5503.     if (DataType = ftGraphic) or (DataType = ftTypedBinary) then
  5504.     begin
  5505.       Header.Count := 1;
  5506.       Header.HType := $0100;
  5507.       Header.Size := 0;
  5508.       BlobStream.Write(Header, SizeOf(Header));
  5509.       Bitmap.SaveToStream(BlobStream);
  5510.       Header.Size := BlobStream.Position - SizeOf(Header);
  5511.       BlobStream.Position := 0;
  5512.       BlobStream.Write(Header, SizeOf(Header));
  5513.     end else
  5514.       Bitmap.SaveToStream(BlobStream);
  5515.   finally
  5516.     BlobStream.Free;
  5517.   end;
  5518. end;
  5519.  
  5520. procedure TBlobField.LoadFromBlob(Blob: TBlobField);
  5521. var
  5522.   BlobStream: TStream;
  5523. begin
  5524.   BlobStream := DataSet.CreateBlobStream(Self, bmWrite);
  5525.   try
  5526.     Blob.SaveToStream(BlobStream);
  5527.   finally
  5528.     BlobStream.Free;
  5529.   end;
  5530. end;
  5531.  
  5532. procedure TBlobField.LoadFromFile(const FileName: string);
  5533. var
  5534.   Stream: TStream;
  5535. begin
  5536.   Stream := TFileStream.Create(FileName, fmOpenRead);
  5537.   try
  5538.     LoadFromStream(Stream);
  5539.   finally
  5540.     Stream.Free;
  5541.   end;
  5542. end;
  5543.  
  5544. procedure TBlobField.LoadFromStream(Stream: TStream);
  5545. begin
  5546.   with DataSet.CreateBlobStream(Self, bmWrite) do
  5547.   try
  5548.     CopyFrom(Stream, 0);
  5549.   finally
  5550.     Free;
  5551.   end;
  5552. end;
  5553.  
  5554. procedure TBlobField.LoadFromStrings(Strings: TStrings);
  5555. var
  5556.   BlobStream: TStream;
  5557. begin
  5558.   BlobStream := DataSet.CreateBlobStream(Self, bmWrite);
  5559.   try
  5560.     Strings.SaveToStream(BlobStream);
  5561.   finally
  5562.     BlobStream.Free;
  5563.   end;
  5564. end;
  5565.  
  5566. procedure TBlobField.SaveToBitmap(Bitmap: TBitmap);
  5567. var
  5568.   BlobStream: TStream;
  5569.   Size: Longint;
  5570.   Header: TGraphicHeader;
  5571. begin
  5572.   BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  5573.   try
  5574.     Size := BlobStream.Size;
  5575.     if Size >= SizeOf(TGraphicHeader) then
  5576.     begin
  5577.       BlobStream.Read(Header, SizeOf(Header));
  5578.       if (Header.Count <> 1) or (Header.HType <> $0100) or
  5579.         (Header.Size <> Size - SizeOf(Header)) then
  5580.         BlobStream.Position := 0;
  5581.     end;
  5582.     Bitmap.LoadFromStream(BlobStream);
  5583.   finally
  5584.     BlobStream.Free;
  5585.   end;
  5586. end;
  5587.  
  5588. procedure TBlobField.SaveToFile(const FileName: string);
  5589. var
  5590.   Stream: TStream;
  5591. begin
  5592.   Stream := TFileStream.Create(FileName, fmCreate);
  5593.   try
  5594.     SaveToStream(Stream);
  5595.   finally
  5596.     Stream.Free;
  5597.   end;
  5598. end;
  5599.  
  5600. procedure TBlobField.SaveToStream(Stream: TStream);
  5601. var
  5602.   BlobStream: TStream;
  5603. begin
  5604.   BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  5605.   try
  5606.     Stream.CopyFrom(BlobStream, 0);
  5607.   finally
  5608.     BlobStream.Free;
  5609.   end;
  5610. end;
  5611.  
  5612. procedure TBlobField.SaveToStrings(Strings: TStrings);
  5613. var
  5614.   BlobStream: TStream;
  5615. begin
  5616.   BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  5617.   try
  5618.     Strings.LoadFromStream(BlobStream);
  5619.   finally
  5620.     BlobStream.Free;
  5621.   end;
  5622. end;
  5623.  
  5624. procedure TBlobField.SetAsString(const Value: string);
  5625. begin
  5626.   with DataSet.CreateBlobStream(Self, bmWrite) do
  5627.     try
  5628.       WriteBuffer(Pointer(Value)^, Length(Value));
  5629.     finally
  5630.       Free;
  5631.     end;
  5632. end;
  5633.  
  5634. procedure TBlobField.SetBlobType(Value: TBlobType);
  5635. begin
  5636.   SetFieldType(Value);
  5637. end;
  5638.  
  5639. procedure TBlobField.SetFieldType(Value: TFieldType);
  5640. begin
  5641.   if Value in [Low(TBlobType)..High(TBlobType)] then SetDataType(Value);
  5642. end;
  5643.  
  5644. procedure TBlobField.SetModified(Value: Boolean);
  5645. begin
  5646.   FModified := Value;
  5647.   if FModified then
  5648.     FModifiedRecord := DataSet.ActiveRecord;
  5649. end;
  5650.  
  5651. procedure TBlobField.SetText(const Value: string);
  5652. begin
  5653.   raise AccessError('Text');
  5654. end;
  5655.  
  5656. procedure TBlobField.SetVarValue(const Value: Variant);
  5657. begin
  5658.   SetAsString(Value);
  5659. end;
  5660.  
  5661. { TMemoField }
  5662.  
  5663. constructor TMemoField.Create(AOwner: TComponent);
  5664. begin
  5665.   inherited Create(AOwner);
  5666.   SetDataType(ftMemo);
  5667.   Transliterate := True;
  5668. end;
  5669.  
  5670. { TGraphicField }
  5671.  
  5672. constructor TGraphicField.Create(AOwner: TComponent);
  5673. begin
  5674.   inherited Create(AOwner);
  5675.   SetDataType(ftGraphic);
  5676. end;
  5677.  
  5678. { TObjectField }
  5679.  
  5680. constructor TObjectField.Create(AOwner: TComponent);
  5681. begin
  5682.   FOwnedFields := TFields.Create(nil);
  5683.   FFields := FOwnedFields;
  5684.   inherited Create(AOwner);
  5685. end;
  5686.  
  5687. destructor TObjectField.Destroy;
  5688. begin
  5689.   inherited Destroy;
  5690.   FOwnedFields.Free;
  5691. end;
  5692.  
  5693. procedure TObjectField.ReadUnNamed(Reader: TReader);
  5694. begin
  5695.   SetUnNamed(Reader.ReadBoolean);
  5696. end;
  5697.  
  5698. procedure TObjectField.WriteUnNamed(Writer: TWriter);
  5699. begin
  5700.   Writer.WriteBoolean(UnNamed);
  5701. end;
  5702.  
  5703. procedure TObjectField.DefineProperties(Filer: TFiler);
  5704.  
  5705.   function UnNamedStored: Boolean;
  5706.   begin
  5707.     if Assigned(Filer.Ancestor) then
  5708.       Result := UnNamed <> TObjectField(Filer.Ancestor).UnNamed else
  5709.       Result := UnNamed;
  5710.   end;
  5711.  
  5712. begin
  5713.   inherited;
  5714.   Filer.DefineProperty('UnNamed', ReadUnNamed, WriteUnNamed, UnNamedStored);
  5715. end;
  5716.  
  5717. procedure TObjectField.GetChildren(Proc: TGetChildProc; Root: TComponent);
  5718. var
  5719.   I: Integer;
  5720.   Field: TField;
  5721. begin
  5722.   for I := 0 to FOwnedFields.Count - 1 do
  5723.   begin
  5724.     Field := FOwnedFields[I];
  5725.     if Field.Owner = Root then Proc(Field);
  5726.   end;
  5727. end;
  5728.  
  5729. procedure TObjectField.SetChildOrder(Component: TComponent; Order: Integer);
  5730. var
  5731.   F: TField;
  5732. begin
  5733.   F := Component as TField;
  5734.   if FFields.IndexOf(F) >= 0 then
  5735.     F.Index := Order;
  5736. end;
  5737.  
  5738. function TObjectField.GetDefaultWidth: Integer;
  5739. var
  5740.   I: Integer;
  5741. begin
  5742.   Result := 10;
  5743.   if FOwnedFields.Count > 0 then
  5744.   begin
  5745.     for I := 0 to FOwnedFields.Count - 1 do
  5746.       Inc(Result, FOwnedFields[I].GetDefaultWidth);
  5747.     Result := Result div 2;
  5748.   end;
  5749. end;
  5750.  
  5751. function TObjectField.GetHasConstraints: Boolean;
  5752. var
  5753.   I: Integer;
  5754. begin
  5755.   Result := inherited GetHasConstraints;
  5756.   if not Result then
  5757.     for I := 0 to FFields.Count - 1 do
  5758.     begin
  5759.       Result := FFields[I].HasConstraints;
  5760.       if Result then Break;
  5761.     end;
  5762. end;
  5763.  
  5764. procedure TObjectField.SetFieldKind(Value: TFieldKind);
  5765. var
  5766.   I: Integer;
  5767. begin
  5768.   if FFieldKind <> Value then
  5769.   begin
  5770.     if (DataSet <> nil) and (DataSet.FDesigner <> nil) then
  5771.     with DataSet.Designer do
  5772.     begin
  5773.       BeginDesign;
  5774.       try
  5775.         FFieldKind := Value;
  5776.         for I := 0 to FFields.Count - 1 do
  5777.           FFields[I].FFieldKind := Value;
  5778.       finally
  5779.         EndDesign;
  5780.       end;
  5781.     end else
  5782.     begin
  5783.       CheckInactive;
  5784.       FFieldKind := Value;
  5785.       for I := 0 to FFields.Count - 1 do
  5786.         FFields[I].FFieldKind := Value;
  5787.     end;
  5788.   end;
  5789. end;
  5790.  
  5791. procedure TObjectField.DataSetChanged;
  5792. var
  5793.   I: Integer;
  5794. begin
  5795.   FOwnedFields.FDataSet := DataSet;
  5796.   for I := 0 to FOwnedFields.Count - 1 do
  5797.     FOwnedFields[I].DataSet := DataSet;
  5798.   if (DataSet <> nil) and not DataSet.ObjectView then
  5799.     DataSet.ObjectView := True;
  5800. end;
  5801.  
  5802. procedure TObjectField.SetDataSet(ADataSet: TDataSet);
  5803. begin
  5804.   FFields := FOwnedFields;
  5805.   inherited SetDataSet(ADataSet);
  5806.   DataSetChanged;
  5807. end;
  5808.  
  5809. procedure TObjectField.SetParentField(AField: TObjectField);
  5810. begin
  5811.   FFields := FOwnedFields;
  5812.   inherited SetParentField(AField);
  5813.   DataSetChanged;
  5814. end;
  5815.  
  5816. class procedure TObjectField.CheckTypeSize(Value: Integer);
  5817. begin
  5818.   { Size is computed, no validation }
  5819. end;
  5820.  
  5821. procedure TObjectField.FreeBuffers;
  5822. var
  5823.   I: Integer;
  5824. begin
  5825.   for I := 0 to FOwnedFields.Count - 1 do
  5826.     FOwnedFields[I].FreeBuffers;
  5827. end;
  5828.  
  5829. function TObjectField.GetFieldCount: Integer;
  5830. begin
  5831.   Result := Fields.Count;
  5832. end;
  5833.  
  5834. function TObjectField.GetFields: TFields;
  5835. begin
  5836.   Result := FFields;
  5837. end;
  5838.  
  5839. function TObjectField.GetAsString: string;
  5840.  
  5841.   function ValueToStr(const V: Variant): string;
  5842.   var
  5843.     S: string;
  5844.     V2: Variant;
  5845.     HighBound, I: Integer;
  5846.     Sep: string;
  5847.   begin
  5848.     Result := '';
  5849.     if VarIsArray(V) then
  5850.     begin
  5851.       HighBound := VarArrayHighBound(V, 1);
  5852.       Sep := '';
  5853.       for I := 0 to HighBound do
  5854.       begin
  5855.         V2 := V[I];
  5856.         if VarIsArray(V2) then
  5857.           S := ValueToStr(V2) else
  5858.           S := VarToStr(V2);
  5859.         Result := Result + Sep + S;
  5860.         if I = 0 then Sep := ListSeparator + ' ';
  5861.       end;
  5862.     end else
  5863.       Result := VarToStr(V);
  5864.     if Result <> '' then
  5865.       Result := '('+Result+')';
  5866.   end;
  5867.  
  5868. begin
  5869.   if (FFields = FOwnedFields) and (FFields.Count > 0) then
  5870.     Result := ValueToStr(GetAsVariant) else
  5871.     Result := inherited GetAsString;
  5872. end;
  5873.  
  5874. function TObjectField.GetFieldValue(Index: Integer): Variant;
  5875. begin
  5876.   Result := FFields[Index].Value;
  5877. end;
  5878.  
  5879. procedure TObjectField.SetFieldValue(Index: Integer; const Value: Variant);
  5880. begin
  5881.   FFields[Index].Value := Value;
  5882. end;
  5883.  
  5884. function TObjectField.GetAsVariant: Variant;
  5885. var
  5886.   I: Integer;
  5887. begin
  5888.   if IsNull then Result := Null else
  5889.   begin
  5890.     Result := VarArrayCreate([0, FieldCount - 1], varVariant);
  5891.     for I := 0 to FieldCount - 1 do
  5892.       Result[I] := GetFieldValue(I);
  5893.   end;
  5894. end;
  5895.  
  5896. procedure TObjectField.SetVarValue(const Value: Variant);
  5897. var
  5898.   Count, I: Integer;
  5899. begin
  5900.   Count := VarArrayHighBound(Value, 1) + 1;
  5901.   if Count > Size then Count := Size;
  5902.   for I := 0 to Count - 1  do
  5903.     SetFieldValue(I, Value[I]);
  5904. end;
  5905.  
  5906. procedure TObjectField.SetUnNamed(Value: Boolean);
  5907. begin
  5908.   FUnNamed := Value;
  5909. end;
  5910.  
  5911. { TADTField }
  5912.  
  5913. constructor TADTField.Create(AOwner: TComponent);
  5914. begin
  5915.   inherited Create(AOwner);
  5916.   FFields.OnChange := FieldsChanged;
  5917.   SetDataType(ftADT);
  5918. end;
  5919.  
  5920. procedure TADTField.FieldsChanged(Sender: TObject);
  5921. begin
  5922.   FTotalSize := 0;
  5923. end;
  5924.  
  5925. function TADTField.GetSize: Integer;
  5926.  
  5927.   procedure CalcTotalSize(Fields: TFields; var TotalSize: Integer);
  5928.   var
  5929.     I: Integer;
  5930.   begin
  5931.     Inc(TotalSize, Fields.Count);
  5932.     for I := 0 to Fields.Count - 1 do
  5933.       if Fields[I].DataType = ftADT then
  5934.         CalcTotalSize((Fields[I] as TADTField).Fields, TotalSize);
  5935.   end;
  5936.  
  5937. begin
  5938.   if FTotalSize = 0 then
  5939.   begin
  5940.     CalcTotalSize(FFields, FTotalSize);
  5941.   end;
  5942.   Result := FTotalSize;
  5943. end;
  5944.  
  5945. { TArrayField }
  5946.  
  5947. constructor TArrayField.Create(AOwner: TComponent);
  5948. begin
  5949.   inherited Create(AOwner);
  5950.   SetDataType(ftArray);
  5951.   Size := 10;
  5952. end;
  5953.  
  5954. procedure TArrayField.Bind(Binding: Boolean);
  5955. begin
  5956.   inherited Bind(Binding);
  5957.   if DataSet.SparseArrays then
  5958.     FFields.FSparseFields := FSize;
  5959. end;
  5960.  
  5961. procedure TArrayField.SetSize(Value: Integer);
  5962. begin
  5963.   CheckInactive;
  5964.   FSize := Value;
  5965. end;
  5966.  
  5967. { TDataSetField }
  5968.  
  5969. constructor TDataSetField.Create(AOwner: TComponent);
  5970. begin
  5971.   inherited Create(AOwner);
  5972.   SetDataType(ftDataSet);
  5973. end;
  5974.  
  5975. destructor TDataSetField.Destroy;
  5976. begin
  5977.   AssignNestedDataSet(nil);
  5978.   FOwnedDataSet.Free;
  5979.   inherited Destroy;
  5980. end;
  5981.  
  5982. procedure TDataSetField.SetIncludeObjectField(Value: Boolean);
  5983. begin
  5984.   if Assigned(FNestedDataSet) then
  5985.     FNestedDataSet.CheckInactive;
  5986.   FIncludeObjectField := Value;
  5987. end;
  5988.  
  5989. procedure TDataSetField.Bind(Binding: Boolean);
  5990. begin
  5991.   inherited Bind(Binding);
  5992.   if Assigned(FNestedDataSet) then
  5993.   begin
  5994.     if Binding then
  5995.     begin
  5996.       if FNestedDataSet.State = dsInActive then FNestedDataSet.Open;
  5997.     end
  5998.     else
  5999.       FNestedDataSet.Close;
  6000.   end;
  6001. end;
  6002.  
  6003. function TDataSetField.GetFields: TFields;
  6004. begin
  6005.   if FNestedDataSet = nil then
  6006.     GetNestedDataSet;
  6007.   Result := inherited GetFields;
  6008. end;
  6009.  
  6010. function TDataSetField.GetNestedDataSet: TDataSet;
  6011. begin
  6012.   if (FNestedDataSet = nil) and not (csReading in DataSet.ComponentState) then
  6013.     FNestedDataSet := DataSet.CreateNestedDataSet(Self);
  6014.   Result := FNestedDataSet;
  6015. end;
  6016.  
  6017. procedure TDataSetField.AssignNestedDataSet(Value: TDataSet);
  6018. begin
  6019.   if Assigned(FNestedDataSet) then
  6020.   begin
  6021.     FNestedDataSet.Close;
  6022.     FNestedDataSet.FDataSetField := nil;
  6023.     if Assigned(DataSet) then
  6024.       DataSet.NestedDataSets.Remove(FNestedDataSet);
  6025.   end;
  6026.   if Assigned(Value) then
  6027.   begin
  6028.     DataSet.NestedDataSets.Add(Value);
  6029.     FFields := Value.Fields;
  6030.   end else
  6031.     FFields := FOwnedFields;
  6032.   FNestedDataSet := Value;
  6033. end;
  6034.  
  6035. function TDataSetField.GetCanModify: Boolean;
  6036. begin
  6037.   Result := inherited GetCanModify and Assigned(NestedDataSet) and
  6038.     FNestedDataSet.Active;
  6039. end;
  6040.  
  6041. { TReferenceField }
  6042.  
  6043. constructor TReferenceField.Create(AOwner: TComponent);
  6044. begin
  6045.   inherited Create(AOwner);
  6046.   SetDataType(ftReference);
  6047. end;
  6048.  
  6049. procedure TReferenceField.Assign(Source: TPersistent);
  6050. begin
  6051.   { Assign reference from an object table }
  6052.   if Source is TDataSet then
  6053.     inherited Assign(TDataSet(Source).Fields[0]) else
  6054.     inherited Assign(Source);
  6055. end;
  6056.  
  6057. function TReferenceField.GetDataSize: Integer;
  6058. begin
  6059.   Result := FSize + 2;
  6060. end;
  6061.  
  6062. function TVariantField.GetDefaultWidth: Integer;
  6063. begin
  6064.   Result := 15;
  6065. end;
  6066.  
  6067. function TReferenceField.GetAsVariant: Variant;
  6068. begin
  6069.   Result := GetAsByteArray;
  6070. end;
  6071.  
  6072. procedure TReferenceField.SetVarValue(const Value: Variant);
  6073. begin
  6074.   SetAsByteArray(Value);
  6075. end;
  6076.  
  6077. { TVariantField }
  6078.  
  6079. constructor TVariantField.Create(AOwner: TComponent);
  6080. begin
  6081.   inherited Create(AOwner);
  6082.   SetDataType(ftVariant);
  6083. end;
  6084.  
  6085. class procedure TVariantField.CheckTypeSize(Value: Integer);
  6086. begin
  6087.   { No validation }
  6088. end;
  6089.  
  6090. function TVariantField.GetAsBoolean: Boolean;
  6091. begin
  6092.   Result := GetAsVariant;
  6093. end;
  6094.  
  6095. function TVariantField.GetAsDateTime: TDateTime;
  6096. begin
  6097.   Result := GetAsVariant;
  6098. end;
  6099.  
  6100. function TVariantField.GetAsFloat: Double;
  6101. begin
  6102.   Result := GetAsVariant;
  6103. end;
  6104.  
  6105. function TVariantField.GetAsInteger: Longint;
  6106. begin
  6107.   Result := GetAsVariant;
  6108. end;
  6109.  
  6110. function TVariantField.GetAsString: string;
  6111. begin
  6112.   Result := VarToStr(GetAsVariant);
  6113. end;
  6114.  
  6115. function TVariantField.GetAsVariant: Variant;
  6116. begin
  6117.   if not GetData(@Result) then
  6118.     Result := Null;
  6119. end;
  6120.  
  6121. procedure TVariantField.SetAsBoolean(Value: Boolean);
  6122. begin
  6123.   SetVarValue(Value);
  6124. end;
  6125.  
  6126. procedure TVariantField.SetAsDateTime(Value: TDateTime);
  6127. begin
  6128.   SetVarValue(Value);
  6129. end;
  6130.  
  6131. procedure TVariantField.SetAsFloat(Value: Double);
  6132. begin
  6133.   SetVarValue(Value);
  6134. end;
  6135.  
  6136. procedure TVariantField.SetAsInteger(Value: Longint);
  6137. begin
  6138.   SetVarValue(Value);
  6139. end;
  6140.  
  6141. procedure TVariantField.SetAsString(const Value: string);
  6142. begin
  6143.   SetVarValue(Value);
  6144. end;
  6145.  
  6146. procedure TVariantField.SetVarValue(const Value: Variant);
  6147. begin
  6148.   SetData(@Value);
  6149. end;
  6150.  
  6151. { TInterfaceField }
  6152.  
  6153. constructor TInterfaceField.Create(AOwner: TComponent);
  6154. begin
  6155.   inherited Create(AOwner);
  6156.   SetDataType(ftInterface);
  6157. end;
  6158.  
  6159. class procedure TInterfaceField.CheckTypeSize(Value: Integer);
  6160. begin
  6161.   { No validation }
  6162. end;
  6163.  
  6164. function TInterfaceField.GetAsVariant: Variant;
  6165. var
  6166.   I: IUnknown;
  6167. begin
  6168.   I := GetValue;
  6169.   if not Assigned(I) then
  6170.     Result := Null else
  6171.     Result := GetValue;
  6172. end;
  6173.  
  6174. function TInterfaceField.GetValue: IUnknown;
  6175. begin
  6176.   if not GetData(@Result) then
  6177.     Result := nil;
  6178. end;
  6179.  
  6180. procedure TInterfaceField.SetValue(const Value: IUnknown);
  6181. begin
  6182.   SetData(@Value);
  6183. end;
  6184.  
  6185. procedure TInterfaceField.SetVarValue(const Value: Variant);
  6186. begin
  6187.   SetValue(IUnknown(Value));
  6188. end;
  6189.  
  6190. { TIDispatchField }
  6191.  
  6192. constructor TIDispatchField.Create(AOwner: TComponent);
  6193. begin
  6194.   inherited Create(AOwner);
  6195.   SetDataType(ftIDispatch);
  6196. end;
  6197.  
  6198. function TIDispatchField.GetValue: IDispatch;
  6199. begin
  6200.   if not GetData(@Result) then
  6201.     Result := nil;
  6202. end;
  6203.  
  6204. procedure TIDispatchField.SetValue(const Value: IDispatch);
  6205. begin
  6206.   SetData(@Value);
  6207. end;
  6208.  
  6209. { TGuidField }
  6210.  
  6211. constructor TGuidField.Create(AOwner: TComponent);
  6212. begin
  6213.   Size := 38; { Length(GuidString) }
  6214.   inherited Create(AOwner);
  6215.   SetDataType(ftGuid);
  6216. end;
  6217.  
  6218. class procedure TGuidField.CheckTypeSize(Value: Integer);
  6219. begin
  6220.   if Value <> 38 { Length(GuidString) } then
  6221.     DatabaseError(SInvalidFieldSize);
  6222. end;
  6223.  
  6224. function TGuidField.GetAsGuid: TGUID;
  6225. var
  6226.   S: string;
  6227. begin
  6228.   S := GetAsString;
  6229.   if S <> '' then
  6230.     Result := StringToGuid(S) else
  6231.     Result := GUID_NULL;
  6232. end;
  6233.  
  6234. function TGuidField.GetDefaultWidth: Integer;
  6235. begin
  6236.   Result := 38;
  6237. end;
  6238.  
  6239. procedure TGuidField.SetAsGuid(const Value: TGUID);
  6240. begin
  6241.   SetAsString(GuidToString(Value));
  6242. end;
  6243.  
  6244. { TAggregateField }
  6245.  
  6246. constructor TAggregateField.Create(AOwner: TComponent);
  6247. begin
  6248.   inherited Create(AOwner);
  6249.   SetDataType(ftUnknown);
  6250.   FVisible := False;
  6251.   FFieldKind := fkAggregate;
  6252.   FPrecision := 15;
  6253. end;
  6254.  
  6255. procedure TAggregateField.SetHandle(Value: Pointer);
  6256. begin
  6257.   FHandle := Value;
  6258. end;
  6259.  
  6260. function TAggregateField.GetHandle: Pointer;
  6261. begin
  6262.   Result := FHandle;
  6263. end;
  6264.  
  6265. procedure TAggregateField.Reset;
  6266. begin
  6267.   if (DataSet <> nil) and not (csLoading in ComponentState) then
  6268.     if DataSet.FDesigner <> nil then
  6269.     begin
  6270.       DataSet.Designer.BeginDesign;
  6271.       try
  6272.         DataSet.ResetAggField(Self);
  6273.       finally
  6274.         DataSet.Designer.EndDesign;
  6275.       end;
  6276.     end else
  6277.       DataSet.CheckInactive;
  6278. end;
  6279.  
  6280. procedure TAggregateField.SetActive(Value: Boolean);
  6281. begin
  6282.   if Value <> FActive then
  6283.   begin
  6284.     FActive := Value;
  6285.     try
  6286.       Reset;
  6287.     except
  6288.       FActive := False;
  6289.       raise;
  6290.     end;
  6291.   end;
  6292. end;
  6293.  
  6294. procedure TAggregateField.SetGroupingLevel(Value: Integer);
  6295. var
  6296.   Old: Integer;
  6297. begin
  6298.   if Value <> FGroupingLevel then
  6299.   begin
  6300.     Old := FGroupingLevel;
  6301.     try
  6302.       FGroupingLevel := Value;
  6303.       Reset;
  6304.     except
  6305.       FGroupingLevel := Old;
  6306.       raise;
  6307.     end;
  6308.   end;
  6309. end;
  6310.  
  6311. procedure TAggregateField.SetIndexName(Value: String);
  6312. var
  6313.   Old: String;
  6314. begin
  6315.   if Value <> FIndexName then
  6316.   begin
  6317.     try
  6318.       Old := FIndexName;
  6319.       FIndexName := Value;
  6320.       Reset;
  6321.     except
  6322.       FIndexName := Old;
  6323.       raise;
  6324.     end;
  6325.   end;
  6326. end;
  6327.  
  6328. procedure TAggregateField.SetExpression(Value: String);
  6329. var
  6330.   Old: String;
  6331. begin
  6332.   if Value <> FExpression then
  6333.   begin
  6334.     try
  6335.       Old := FExpression;
  6336.       FExpression := Value;
  6337.       Reset;
  6338.     except
  6339.       FExpression := Old;
  6340.       raise;
  6341.     end;
  6342.   end;
  6343. end;
  6344.  
  6345. procedure TAggregateField.GetText(var Text: string; DisplayText: Boolean);
  6346. var
  6347.   Format: TFloatFormat;
  6348.   FmtStr: string;
  6349.   Digits: Integer;
  6350.   V: Variant;
  6351. begin
  6352.   Text := '';
  6353.   V := Dataset.GetAggregateValue(Self);
  6354.   if VarIsNull(V) then
  6355.     Exit;
  6356.   if FResultType in [ftFloat, ftCurrency] then
  6357.   begin
  6358.     if DisplayText then
  6359.       FmtStr := FDisplayFormat;
  6360.     if FmtStr = '' then
  6361.     begin
  6362.       if FCurrency then
  6363.       begin
  6364.         if DisplayText then Format := ffCurrency else Format := ffFixed;
  6365.         Digits := CurrencyDecimals;
  6366.       end
  6367.       else begin
  6368.         Format := ffGeneral;
  6369.         Digits := 0;
  6370.       end;
  6371.       Text := FloatToStrF(V, Format, FPrecision, Digits);
  6372.     end else
  6373.       Text := FormatFloat(FmtStr, V);
  6374.   end else if FResultType in [ftDate, ftTime, ftDatetime] then
  6375.   begin
  6376.     if DisplayText and (FDisplayFormat <> '') then
  6377.       FmtStr := FDisplayFormat
  6378.     else
  6379.       case DataType of
  6380.         ftDate: FmtStr := ShortDateFormat;
  6381.         ftTime: FmtStr := LongTimeFormat;
  6382.       end;
  6383.     DateTimeToString(Text, FmtStr, V);
  6384.   end else
  6385.     Text := VarToStr(V);
  6386. end;
  6387.  
  6388. function TAggregateField.GetAsString: string;
  6389. begin
  6390.   Result := VarToStr(Dataset.GetAggregateValue(Self));
  6391. end;
  6392.  
  6393. function TAggregateField.GetAsVariant: Variant;
  6394. begin
  6395.   Result := Dataset.GetAggregateValue(Self);
  6396. end;
  6397.  
  6398. procedure TAggregateField.SetDisplayFormat(const Value: string);
  6399. begin
  6400.   if FDisplayFormat <> Value then
  6401.   begin
  6402.     FDisplayFormat := Value;
  6403.     PropertyChanged(False);
  6404.   end;
  6405. end;
  6406.  
  6407. procedure TAggregateField.SetCurrency(Value: Boolean);
  6408. begin
  6409.   if FCurrency <> Value then
  6410.   begin
  6411.     FCurrency := Value;
  6412.     PropertyChanged(False);
  6413.   end;
  6414. end;
  6415.  
  6416. procedure TAggregateField.SetPrecision(Value: Integer);
  6417. begin
  6418.   if Value < 2 then Value := 2;
  6419.   if Value > 15 then Value := 15;
  6420.   if FPrecision <> Value then
  6421.   begin
  6422.     FPrecision := Value;
  6423.     PropertyChanged(False);
  6424.   end;
  6425. end;
  6426.  
  6427.  
  6428. { TIndexDef }
  6429.  
  6430. constructor TIndexDef.Create(Owner: TIndexDefs; const Name, Fields: string;
  6431.   Options: TIndexOptions);
  6432. begin
  6433.   inherited Create(Owner);
  6434.   FName := Name;
  6435.   FFieldExpression := Fields;
  6436.   FOptions := Options;
  6437. end;
  6438.  
  6439. procedure TIndexDef.Assign(ASource: TPersistent);
  6440. var
  6441.   S: TIndexDef;
  6442. begin
  6443.   if ASource is TIndexDef then
  6444.   begin
  6445.     if Collection <> nil then Collection.BeginUpdate;
  6446.     try
  6447.       S := TIndexDef(ASource);
  6448.       Options := S.Options;
  6449.       Name := S.Name;
  6450.       Source := S.Source;
  6451.       Expression := S.Expression;
  6452.       Fields := S.Fields;
  6453.       GroupingLevel := S.GroupingLevel;
  6454.     finally
  6455.       if Collection <> nil then Collection.EndUpdate;
  6456.     end;
  6457.   end else inherited;
  6458. end;
  6459.  
  6460. procedure TIndexDef.SetOptions(Value: TIndexOptions);
  6461. begin
  6462.   if Value <> FOptions then
  6463.   begin
  6464.     FOptions := Value;
  6465.     Changed(False);
  6466.   end;
  6467. end;
  6468.  
  6469. procedure TIndexDef.SetSource(const Value: string);
  6470. begin
  6471.   if Value <> FSource then
  6472.   begin
  6473.     FSource := Value;
  6474.     Changed(False);
  6475.   end;
  6476. end;
  6477.  
  6478. function TIndexDef.GetExpression: string;
  6479. begin
  6480.   if ixExpression in Options then Result := FFieldExpression else Result := '';
  6481. end;
  6482.  
  6483. procedure TIndexDef.SetExpression(const Value: string);
  6484. begin
  6485.   if (Value <> FFieldExpression) or
  6486.     ((Value <> '') and not (ixExpression in Options)) then
  6487.   begin
  6488.     Include(FOptions, ixExpression);
  6489.     FFieldExpression := Value;
  6490.     Changed(False);
  6491.   end;
  6492. end;
  6493.  
  6494. function TIndexDef.GetFields: string;
  6495. begin
  6496.   if ixExpression in Options then Result := '' else Result := FFieldExpression;
  6497. end;
  6498.  
  6499. procedure TIndexDef.SetFields(const Value: string);
  6500. begin
  6501.   if (Value <> FFieldExpression) or (ixExpression in Options) then
  6502.   begin
  6503.     Exclude(FOptions, ixExpression);
  6504.     FFieldExpression := Value;
  6505.     Changed(False);
  6506.   end;
  6507. end;
  6508.  
  6509. procedure TIndexDef.SetDescFields(const Value: string);
  6510. begin
  6511.   if Value <> FDescFields then
  6512.   begin
  6513.     if Value <> '' then
  6514.       Include(FOptions, ixDescending);
  6515.     FDescFields := Value;
  6516.     Changed(False);
  6517.   end;
  6518. end;
  6519.  
  6520. procedure TIndexDef.SetCaseInsFields(const Value: string);
  6521. begin
  6522.   if Value <> FCaseInsFields then
  6523.   begin
  6524.     if Value <> '' then
  6525.       Include(FOptions, ixCaseInsensitive);
  6526.     FCaseInsFields := Value;
  6527.     Changed(False);
  6528.   end;
  6529. end;
  6530.  
  6531. function TIndexDef.GetDisplayName: string;
  6532. begin
  6533.   Result := inherited GetDisplayName;
  6534.   if (Result = '') and
  6535.      (ixPrimary in FOptions) then
  6536.     Result := '<Primary>'; { do not localize }
  6537. end;
  6538.  
  6539. { TIndexDefs }
  6540.  
  6541. constructor TIndexDefs.Create(ADataSet: TDataSet);
  6542. begin
  6543.   inherited Create(ADataSet, ADataSet, TIndexDef);
  6544.   FDataSet := ADataSet;
  6545. end;
  6546.  
  6547. function TIndexDefs.AddIndexDef: TIndexDef;
  6548. begin
  6549.   Result := TIndexDef(inherited Add);
  6550. end;
  6551.  
  6552. procedure TIndexDefs.Add(const Name, Fields: string; Options: TIndexOptions);
  6553. var
  6554.   IndexDef: TIndexDef;
  6555. begin
  6556.   if IndexOf(Name) >= 0 then
  6557.     DatabaseErrorFmt(SDuplicateIndexName, [Name], DataSet);
  6558.   IndexDef := AddIndexDef;
  6559.   IndexDef.Name := Name;
  6560.   IndexDef.Fields := Fields;
  6561.   IndexDef.Options := Options;
  6562. end;
  6563.  
  6564. function TIndexDefs.FindIndexForFields(const Fields: string): TIndexDef;
  6565. begin
  6566.   Result := GetIndexForFields(Fields, False);
  6567.   if Result = nil then
  6568.     DatabaseErrorFmt(SNoIndexForFields, [Fields], DataSet);
  6569. end;
  6570.  
  6571. function TIndexDefs.GetIndexForFields(const Fields: string;
  6572.   CaseInsensitive: Boolean): TIndexDef;
  6573. var
  6574.   Exact: Boolean;
  6575.   I, L: Integer;
  6576. begin
  6577.   Update;
  6578.   L := Length(Fields);
  6579.   Exact := True;
  6580.   while True do
  6581.   begin
  6582.     for I := 0 to Count - 1 do
  6583.     begin
  6584.       Result := Items[I];
  6585.       if (Result.Options * [ixDescending, ixExpression] = []) and
  6586.         (not CaseInsensitive or (ixCaseInsensitive in Result.Options)) then
  6587.         if Exact then
  6588.           if AnsiCompareText(Fields, Result.Fields) = 0 then Exit
  6589.           else { not exact match }
  6590.         else
  6591.           if (AnsiCompareText(Fields, Copy(Result.Fields, 1, L)) = 0) and
  6592.             ((Length(Result.Fields) = L) or
  6593.             (Result.Fields[L + 1] = ';')) then Exit;
  6594.     end;
  6595.     if not Exact then Break;
  6596.     Exact := False;
  6597.   end;
  6598.   Result := nil;
  6599. end;
  6600.  
  6601. function TIndexDefs.Find(const Name: string): TIndexDef;
  6602. begin
  6603.   Result := TIndexDef(inherited Find(Name));
  6604.   if Result = nil then DatabaseErrorFmt(SIndexNotFound, [Name], DataSet);
  6605. end;
  6606.  
  6607. function TIndexDefs.GetIndexDef(Index: Integer): TIndexDef;
  6608. begin
  6609.   Result := TIndexDef(inherited Items[Index]);
  6610. end;
  6611.  
  6612. procedure TIndexDefs.SetIndexDef(Index: Integer; Value: TIndexDef);
  6613. begin
  6614.   inherited Items[Index] := Value;
  6615. end;
  6616.  
  6617. procedure TIndexDefs.Update;
  6618. begin
  6619.   if Assigned(DataSet) then
  6620.     UpdateDefs(DataSet.UpdateIndexDefs);
  6621. end;
  6622.  
  6623. { TDataLink }
  6624.  
  6625. constructor TDataLink.Create;
  6626. begin
  6627.   inherited Create;
  6628.   FBufferCount := 1;
  6629. end;
  6630.  
  6631. destructor TDataLink.Destroy;
  6632. begin
  6633.   FActive := False;
  6634.   FEditing := False;
  6635.   FDataSourceFixed := False;
  6636.   SetDataSource(nil);
  6637.   inherited Destroy;
  6638. end;
  6639.  
  6640. procedure TDataLink.UpdateRange;
  6641. var
  6642.   Min, Max: Integer;
  6643. begin
  6644.   Min := DataSet.FActiveRecord - FBufferCount + 1;
  6645.   if Min < 0 then Min := 0;
  6646.   Max := DataSet.FBufferCount - FBufferCount;
  6647.   if Max < 0 then Max := 0;
  6648.   if Max > DataSet.FActiveRecord then Max := DataSet.FActiveRecord;
  6649.   if FFirstRecord < Min then FFirstRecord := Min;
  6650.   if FFirstRecord > Max then FFirstRecord := Max;
  6651.   if (FFirstRecord <> 0) and
  6652.      (DataSet.FActiveRecord - FFirstRecord < FBufferCount - 1) then
  6653.     Dec(FFirstRecord);
  6654. end;
  6655.  
  6656. function TDataLink.GetDataSet: TDataSet;
  6657. begin
  6658.   if DataSource <> nil then Result := DataSource.DataSet else Result := nil;
  6659. end;
  6660.  
  6661. procedure TDataLink.SetDataSource(ADataSource: TDataSource);
  6662. begin
  6663.   if FDataSource <> ADataSource then
  6664.   begin
  6665.     if FDataSourceFixed then DatabaseError(SDataSourceChange, FDataSource);
  6666.     if FDataSource <> nil then FDataSource.RemoveDataLink(Self);
  6667.     if ADataSource <> nil then ADataSource.AddDataLink(Self);
  6668.   end;
  6669. end;
  6670.  
  6671. procedure TDataLink.SetReadOnly(Value: Boolean);
  6672. begin
  6673.   if FReadOnly <> Value then
  6674.   begin
  6675.     FReadOnly := Value;
  6676.     UpdateState;
  6677.   end;
  6678. end;
  6679.  
  6680. procedure TDataLink.SetActive(Value: Boolean);
  6681. begin
  6682.   if FActive <> Value then
  6683.   begin
  6684.     FActive := Value;
  6685.     if Value then UpdateRange else FFirstRecord := 0;
  6686.     ActiveChanged;
  6687.   end;
  6688. end;
  6689.  
  6690. procedure TDataLink.SetEditing(Value: Boolean);
  6691. begin
  6692.   if FEditing <> Value then
  6693.   begin
  6694.     FEditing := Value;
  6695.     EditingChanged;
  6696.   end;
  6697. end;
  6698.  
  6699. procedure TDataLink.UpdateState;
  6700. begin
  6701.   SetActive((DataSource <> nil) and (DataSource.State <> dsInactive));
  6702.   SetEditing((DataSource <> nil) and (DataSource.State in dsEditModes) and
  6703.     not FReadOnly);
  6704. end;
  6705.  
  6706. procedure TDataLink.UpdateRecord;
  6707. begin
  6708.   FUpdating := True;
  6709.   try
  6710.     UpdateData;
  6711.   finally
  6712.     FUpdating := False;
  6713.   end;
  6714. end;
  6715.  
  6716. function TDataLink.Edit: Boolean;
  6717. begin
  6718.   if not FReadOnly and (DataSource <> nil) then DataSource.Edit;
  6719.   Result := FEditing;
  6720. end;
  6721.  
  6722. function TDataLink.GetActiveRecord: Integer;
  6723. begin
  6724.   if DataSource.State = dsSetKey then
  6725.     Result := 0 else
  6726.     Result := DataSource.DataSet.FActiveRecord - FFirstRecord;
  6727. end;
  6728.  
  6729. procedure TDataLink.SetActiveRecord(Value: Integer);
  6730. begin
  6731.   if DataSource.State <> dsSetKey then
  6732.     DataSource.DataSet.FActiveRecord := Value + FFirstRecord;
  6733. end;
  6734.  
  6735. procedure TDataLink.SetBufferCount(Value: Integer);
  6736. begin
  6737.   if FBufferCount <> Value then
  6738.   begin
  6739.     FBufferCount := Value;
  6740.     if Active then
  6741.     begin
  6742.       UpdateRange;
  6743.       DataSet.UpdateBufferCount;
  6744.       UpdateRange;
  6745.     end;
  6746.   end;
  6747. end;
  6748.  
  6749. function TDataLink.GetRecordCount: Integer;
  6750. begin
  6751.   if DataSource.State = dsSetKey then Result := 1 else
  6752.   begin
  6753.     Result := DataSource.DataSet.FRecordCount;
  6754.     if Result > FBufferCount then Result := FBufferCount;
  6755.   end;
  6756. end;
  6757.  
  6758. procedure TDataLink.DataEvent(Event: TDataEvent; Info: Longint);
  6759. var
  6760.   Active, First, Last, Count: Integer;
  6761. begin
  6762.   if Event = deUpdateState then UpdateState else
  6763.     if FActive then
  6764.       case Event of
  6765.         deFieldChange, deRecordChange:
  6766.           if not FUpdating then RecordChanged(TField(Info));
  6767.         deDataSetChange, deDataSetScroll, deLayoutChange:
  6768.           begin
  6769.             Count := 0;
  6770.             if DataSource.State <> dsSetKey then
  6771.             begin
  6772.               Active := DataSource.DataSet.FActiveRecord;
  6773.               First := FFirstRecord + Info;
  6774.               Last := First + FBufferCount - 1;
  6775.               if Active > Last then Count := Active - Last else
  6776.                 if Active < First then Count := Active - First;
  6777.               FFirstRecord := First + Count;
  6778.             end;
  6779.             case Event of
  6780.               deDataSetChange: DataSetChanged;
  6781.               deDataSetScroll: DataSetScrolled(Count);
  6782.               deLayoutChange: LayoutChanged;
  6783.             end;
  6784.           end;
  6785.         deUpdateRecord:
  6786.           UpdateRecord;
  6787.         deCheckBrowseMode:
  6788.           CheckBrowseMode;
  6789.         deFocusControl:
  6790.           FocusControl(TFieldRef(Info));
  6791.       end;
  6792. end;
  6793.  
  6794. procedure TDataLink.ActiveChanged;
  6795. begin
  6796. end;
  6797.  
  6798. procedure TDataLink.CheckBrowseMode;
  6799. begin
  6800. end;
  6801.  
  6802. procedure TDataLink.DataSetChanged;
  6803. begin
  6804.   RecordChanged(nil);
  6805. end;
  6806.  
  6807. procedure TDataLink.DataSetScrolled(Distance: Integer);
  6808. begin
  6809.   DataSetChanged;
  6810. end;
  6811.  
  6812. procedure TDataLink.EditingChanged;
  6813. begin
  6814. end;
  6815.  
  6816. function TDataLink.ExecuteAction(Action: TBasicAction): Boolean;
  6817. begin
  6818.   if Action.HandlesTarget(DataSource) then
  6819.   begin
  6820.     Action.ExecuteTarget(DataSource);
  6821.     Result := True;
  6822.   end
  6823.   else Result := False;
  6824. end;
  6825.  
  6826. procedure TDataLink.FocusControl(Field: TFieldRef);
  6827. begin
  6828. end;
  6829.  
  6830. procedure TDataLink.LayoutChanged;
  6831. begin
  6832.   DataSetChanged;
  6833. end;
  6834.  
  6835. procedure TDataLink.RecordChanged(Field: TField);
  6836. begin
  6837. end;
  6838.  
  6839. function TDataLink.UpdateAction(Action: TBasicAction): Boolean;
  6840. begin
  6841.   if Action.HandlesTarget(DataSource) then
  6842.   begin
  6843.     Action.UpdateTarget(DataSource);
  6844.     Result := True;
  6845.   end
  6846.   else Result := False;
  6847. end;
  6848.  
  6849. procedure TDataLink.UpdateData;
  6850. begin
  6851. end;
  6852.  
  6853. function TDataLink.GetBOF: Boolean;
  6854. begin
  6855.   Result := DataSet.BOF;
  6856. end;
  6857.  
  6858. function TDataLink.GetEOF: Boolean;
  6859. begin
  6860.   Result := DataSet.EOF;
  6861. end;
  6862.  
  6863. function TDataLink.GetBufferCount: Integer;
  6864. begin
  6865.   Result := FBufferCount;
  6866. end;
  6867.  
  6868. function TDataLink.MoveBy(Distance: Integer): Integer;
  6869. begin
  6870.   Result := DataSet.MoveBy(Distance);
  6871. end;
  6872.  
  6873. { TDetailDataLink }
  6874.  
  6875. function TDetailDataLink.GetDetailDataSet: TDataSet;
  6876. begin
  6877.   Result := nil;
  6878. end;
  6879.  
  6880. { TMasterDataLink }
  6881.  
  6882. constructor TMasterDataLink.Create(DataSet: TDataSet);
  6883. begin
  6884.   inherited Create;
  6885.   FDataSet := DataSet;
  6886.   FFields := TList.Create;
  6887. end;
  6888.  
  6889. destructor TMasterDataLink.Destroy;
  6890. begin
  6891.   FFields.Free;
  6892.   inherited Destroy;
  6893. end;
  6894.  
  6895. procedure TMasterDataLink.ActiveChanged;
  6896. begin
  6897.   FFields.Clear;
  6898.   if Active then
  6899.     try
  6900.       DataSet.GetFieldList(FFields, FFieldNames);
  6901.     except
  6902.       FFields.Clear;
  6903.       raise;
  6904.     end;
  6905.   if FDataSet.Active and not (csDestroying in FDataSet.ComponentState) then
  6906.     if Active and (FFields.Count > 0) then
  6907.     begin
  6908.       if Assigned(FOnMasterChange) then FOnMasterChange(Self);
  6909.     end else
  6910.       if Assigned(FOnMasterDisable) then FOnMasterDisable(Self);
  6911. end;
  6912.  
  6913. procedure TMasterDataLink.CheckBrowseMode;
  6914. begin
  6915.   if FDataSet.Active then FDataSet.CheckBrowseMode;
  6916. end;
  6917.  
  6918. function TMasterDataLink.GetDetailDataSet: TDataSet;
  6919. begin
  6920.   Result := FDataSet;
  6921. end;
  6922.  
  6923. procedure TMasterDataLink.LayoutChanged;
  6924. begin
  6925.   ActiveChanged;
  6926. end;
  6927.  
  6928. procedure TMasterDataLink.RecordChanged(Field: TField);
  6929. begin
  6930.   if (DataSource.State <> dsSetKey) and FDataSet.Active and
  6931.     (FFields.Count > 0) and ((Field = nil) or
  6932.     (FFields.IndexOf(Field) >= 0)) and
  6933.      Assigned(FOnMasterChange) then
  6934.     FOnMasterChange(Self);
  6935. end;
  6936.  
  6937. procedure TMasterDataLink.SetFieldNames(const Value: string);
  6938. begin
  6939.   if FFieldNames <> Value then
  6940.   begin
  6941.     FFieldNames := Value;
  6942.     ActiveChanged;
  6943.   end;
  6944. end;
  6945.  
  6946. { TDataSource }
  6947.  
  6948. constructor TDataSource.Create(AOwner: TComponent);
  6949. begin
  6950.   inherited Create(AOwner);
  6951.   FDataLinks := TList.Create;
  6952.   FEnabled := True;
  6953.   FAutoEdit := True;
  6954.   RPR;
  6955. end;
  6956.  
  6957. destructor TDataSource.Destroy;
  6958. begin
  6959.   FOnStateChange := nil;
  6960.   SetDataSet(nil);
  6961.   while FDataLinks.Count > 0 do RemoveDataLink(FDataLinks.Last);
  6962.   FDataLinks.Free;
  6963.   inherited Destroy;
  6964. end;
  6965.  
  6966. procedure TDataSource.Edit;
  6967. begin
  6968.   if AutoEdit and (State = dsBrowse) then DataSet.Edit;
  6969. end;
  6970.  
  6971. procedure TDataSource.SetState(Value: TDataSetState);
  6972. var
  6973.   PriorState: TDataSetState;
  6974. begin
  6975.   if FState <> Value then
  6976.   begin
  6977.     PriorState := FState;
  6978.     FState := Value;
  6979.     NotifyDataLinks(deUpdateState, 0);
  6980.     if not (csDestroying in ComponentState) then
  6981.     begin
  6982.       if Assigned(FOnStateChange) then FOnStateChange(Self);
  6983.       if PriorState = dsInactive then
  6984.         if Assigned(FOnDataChange) then FOnDataChange(Self, nil);
  6985.     end;
  6986.   end;
  6987. end;
  6988.  
  6989. procedure TDataSource.UpdateState;
  6990. begin
  6991.   if Enabled and (DataSet <> nil) then
  6992.     SetState(DataSet.State) else
  6993.     SetState(dsInactive);
  6994. end;
  6995.  
  6996. function TDataSource.IsLinkedTo(DataSet: TDataSet): Boolean;
  6997. var
  6998.   DataSource: TDataSource;
  6999. begin
  7000.   Result := True;
  7001.   while DataSet <> nil do
  7002.   begin
  7003.     if (DataSet.DataSetField <> nil) and
  7004.        (DataSet.DataSetField.DataSet.GetDataSource = Self) then Exit;
  7005.     DataSource := DataSet.GetDataSource;
  7006.     if DataSource = nil then Break;
  7007.     if DataSource = Self then Exit;
  7008.     DataSet := DataSource.DataSet;
  7009.   end;
  7010.   Result := False;
  7011. end;
  7012.  
  7013. procedure TDataSource.SetDataSet(ADataSet: TDataSet);
  7014. begin
  7015.   if IsLinkedTo(ADataSet) then DatabaseError(SCircularDataLink, Self);
  7016.   if FDataSet <> nil then FDataSet.RemoveDataSource(Self);
  7017.   if ADataSet <> nil then ADataSet.AddDataSource(Self);
  7018. end;
  7019.  
  7020. procedure TDataSource.SetEnabled(Value: Boolean);
  7021. begin
  7022.   FEnabled := Value;
  7023.   UpdateState;
  7024. end;
  7025.  
  7026. procedure TDataSource.AddDataLink(DataLink: TDataLink);
  7027. begin
  7028.   FDataLinks.Add(DataLink);
  7029.   DataLink.FDataSource := Self;
  7030.   if DataSet <> nil then DataSet.UpdateBufferCount;
  7031.   DataLink.UpdateState;
  7032. end;
  7033.  
  7034. procedure TDataSource.RemoveDataLink(DataLink: TDataLink);
  7035. begin
  7036.   DataLink.FDataSource := nil;
  7037.   FDataLinks.Remove(DataLink);
  7038.   DataLink.UpdateState;
  7039.   if DataSet <> nil then DataSet.UpdateBufferCount;
  7040. end;
  7041.  
  7042. procedure TDataSource.NotifyLinkTypes(Event: TDataEvent; Info: Longint;
  7043.   LinkType: Boolean);
  7044. var
  7045.   I: Integer;
  7046. begin
  7047.   for I := FDataLinks.Count - 1 downto 0 do
  7048.     with TDataLink(FDataLinks[I]) do
  7049.       if LinkType = VisualControl then
  7050.         DataEvent(Event, Info);
  7051. end;
  7052.  
  7053. procedure TDataSource.NotifyDataLinks(Event: TDataEvent; Info: Longint);
  7054. begin
  7055.   { Notify non-visual links (i.e. details), before visual controls }
  7056.   NotifyLinkTypes(Event, Info, False);
  7057.   NotifyLinkTypes(Event, Info, True);
  7058. end;
  7059.  
  7060. procedure TDataSource.DataEvent(Event: TDataEvent; Info: Longint);
  7061. begin
  7062.   if Event = deUpdateState then UpdateState else
  7063.     if FState <> dsInactive then
  7064.     begin
  7065.       NotifyDataLinks(Event, Info);
  7066.       case Event of
  7067.         deFieldChange:
  7068.           if Assigned(FOnDataChange) then FOnDataChange(Self, TField(Info));
  7069.         deRecordChange, deDataSetChange, deDataSetScroll, deLayoutChange:
  7070.           if Assigned(FOnDataChange) then FOnDataChange(Self, nil);
  7071.         deUpdateRecord:
  7072.           if Assigned(FOnUpdateData) then FOnUpdateData(Self);
  7073.       end;
  7074.     end;
  7075. end;
  7076.  
  7077. { TCheckConstraint }
  7078.  
  7079. procedure TCheckConstraint.Assign(Source: TPersistent);
  7080. begin
  7081.   if Source is TCheckConstraint then
  7082.   begin
  7083.     ImportedConstraint := TCheckConstraint(Source).ImportedConstraint;
  7084.     CustomConstraint := TCheckConstraint(Source).CustomConstraint;
  7085.     ErrorMessage := TCheckConstraint(Source).ErrorMessage;
  7086.   end
  7087.   else inherited Assign(Source);
  7088. end;
  7089.  
  7090. function TCheckConstraint.GetDisplayName: string;
  7091. begin
  7092.   Result := ImportedConstraint;
  7093.   if Result = '' then Result := CustomConstraint;
  7094.   if Result = '' then Result := inherited GetDisplayName;
  7095. end;
  7096.  
  7097. procedure TCheckConstraint.SetImportedConstraint(const Value: string);
  7098. begin
  7099.   if ImportedConstraint <> Value then
  7100.   begin
  7101.     FImportedConstraint := Value;
  7102.     Changed(True);
  7103.   end;
  7104. end;
  7105.  
  7106. procedure TCheckConstraint.SetCustomConstraint(const Value: string);
  7107. begin
  7108.   if CustomConstraint <> Value then
  7109.   begin
  7110.     FCustomConstraint := Value;
  7111.     Changed(True);
  7112.   end;
  7113. end;
  7114.  
  7115. procedure TCheckConstraint.SetErrorMessage(const Value: string);
  7116. begin
  7117.   if ErrorMessage <> Value then
  7118.   begin
  7119.     FErrorMessage := Value;
  7120.     Changed(True);
  7121.   end;
  7122. end;
  7123.  
  7124. { TCheckConstraints }
  7125.  
  7126. constructor TCheckConstraints.Create(Owner: TPersistent);
  7127. begin
  7128.   inherited Create(TCheckConstraint);
  7129.   FOwner := Owner;
  7130. end;
  7131.  
  7132. function TCheckConstraints.Add: TCheckConstraint;
  7133. begin
  7134.   Result := TCheckConstraint(inherited Add);
  7135. end;
  7136.  
  7137. function TCheckConstraints.GetOwner: TPersistent;
  7138. begin
  7139.   Result := FOwner;
  7140. end;
  7141.  
  7142. function TCheckConstraints.GetItem(Index: Integer): TCheckConstraint;
  7143. begin
  7144.   Result := TCheckConstraint(inherited GetItem(Index));
  7145. end;
  7146.  
  7147. procedure TCheckConstraints.SetItem(Index: Integer; Value: TCheckConstraint);
  7148. begin
  7149.   inherited SetItem(Index, Value);
  7150. end;
  7151.  
  7152. { TParams }
  7153.  
  7154. constructor TParams.Create;
  7155. begin
  7156.   FOwner := nil;
  7157.   inherited Create(TParam);
  7158. end;
  7159.  
  7160. constructor TParams.Create(Owner: TPersistent);
  7161. begin
  7162.   FOwner := Owner;
  7163.   inherited Create(TParam);
  7164. end;
  7165.  
  7166. procedure TParams.Update(Item: TCollectionItem);
  7167. var
  7168.   i: Integer;
  7169. begin
  7170.   for i := 0 to Count - 1 do
  7171.     Items[i].FParamRef := nil;
  7172.   inherited Update(Item);
  7173. end;
  7174.  
  7175. function TParams.GetItem(Index: Integer): TParam;
  7176. begin
  7177.   Result := TParam(inherited Items[Index]);
  7178.   Result := Result.ParamRef;
  7179. end;
  7180.  
  7181. procedure TParams.SetItem(Index: Integer; Value: TParam);
  7182. begin
  7183.   inherited SetItem(Index, TCollectionItem(Value));
  7184. end;
  7185.  
  7186. function TParams.GetOwner: TPersistent;
  7187. begin
  7188.   Result := FOwner;
  7189. end;
  7190.  
  7191. function TParams.GetDataSet: TDataSet;
  7192. begin
  7193.   if FOwner is TDataSet then
  7194.     Result := TDataSet(FOwner) else
  7195.     Result := nil;
  7196. end;
  7197.  
  7198. procedure TParams.AssignTo(Dest: TPersistent);
  7199. begin
  7200.   if Dest is TParams then TParams(Dest).Assign(Self)
  7201.   else inherited AssignTo(Dest);
  7202. end;
  7203.  
  7204. procedure TParams.AssignValues(Value: TParams);
  7205. var
  7206.   I: Integer;
  7207.   P: TParam;
  7208. begin
  7209.   for I := 0 to Value.Count - 1 do
  7210.   begin
  7211.     P := FindParam(Value[I].Name);
  7212.     if P <> nil then
  7213.       P.Assign(Value[I]);
  7214.   end;
  7215. end;
  7216.  
  7217. procedure TParams.AddParam(Value: TParam);
  7218. begin
  7219.   Value.Collection := Self;
  7220. end;
  7221.  
  7222. procedure TParams.RemoveParam(Value: TParam);
  7223. begin
  7224.   Value.Collection := nil;
  7225. end;
  7226.  
  7227. function TParams.CreateParam(FldType: TFieldType; const ParamName: string;
  7228.   ParamType: TParamType): TParam;
  7229. begin
  7230.   Result := Add as TParam;
  7231.   Result.ParamType := ParamType;
  7232.   Result.Name := ParamName;
  7233.   Result.DataType :=  FldType;
  7234. end;
  7235.  
  7236. function TParams.IsEqual(Value: TParams): Boolean;
  7237. var
  7238.   I: Integer;
  7239. begin
  7240.   Result := Count = Value.Count;
  7241.   if Result then
  7242.     for I := 0 to Count - 1 do
  7243.     begin
  7244.       Result := Items[I].IsEqual(Value.Items[I]);
  7245.       if not Result then Break;
  7246.     end
  7247. end;
  7248.  
  7249. function TParams.ParamByName(const Value: string): TParam;
  7250. begin
  7251.   Result := FindParam(Value);
  7252.   if Result = nil then
  7253.     DatabaseErrorFmt(SParameterNotFound, [Value], GetDataSet);
  7254. end;
  7255.  
  7256. function TParams.FindParam(const Value: string): TParam;
  7257. var
  7258.   I: Integer;
  7259. begin
  7260.   for I := 0 to Count - 1 do
  7261.   begin
  7262.     Result := TParam(inherited Items[I]);
  7263.     if AnsiCompareText(Result.Name, Value) = 0 then Exit;
  7264.   end;
  7265.   Result := nil;
  7266. end;
  7267.  
  7268. procedure TParams.DefineProperties(Filer: TFiler);
  7269. begin
  7270.   inherited DefineProperties(Filer);
  7271.   Filer.DefineBinaryProperty('Data', ReadBinaryData, nil, False);
  7272. end;
  7273.  
  7274. procedure TParams.ReadBinaryData(Stream: TStream);
  7275. var
  7276.   I, Temp, NumItems: Integer;
  7277.   Buffer: array[0..2047] of Char;
  7278.   TempStr: string;
  7279.   Version: Word;
  7280.   Bool: Boolean;
  7281. begin
  7282.   Clear;
  7283.   with Stream do
  7284.   begin
  7285.     ReadBuffer(Version, SizeOf(Version));
  7286.     if Version > 2 then DatabaseError(SInvalidVersion);
  7287.     NumItems := 0;
  7288.     if Version = 2 then
  7289.       ReadBuffer(NumItems, SizeOf(NumItems)) else
  7290.       ReadBuffer(NumItems, 2);
  7291.     for I := 0 to NumItems - 1 do
  7292.       with TParam(Add) do
  7293.       begin
  7294.         Temp := 0;
  7295.         if Version = 2 then
  7296.           ReadBuffer(Temp, SizeOf(Temp)) else
  7297.           ReadBuffer(Temp, 1);
  7298.         SetLength(TempStr, Temp);
  7299.         ReadBuffer(PChar(TempStr)^, Temp);
  7300.         Name := TempStr;
  7301.         ReadBuffer(FParamType, SizeOf(FParamType));
  7302.         ReadBuffer(FDataType, SizeOf(FDataType));
  7303.         if DataType <> ftUnknown then
  7304.         begin
  7305.           Temp := 0;
  7306.           if Version = 2 then
  7307.             ReadBuffer(Temp, SizeOf(Temp)) else
  7308.             ReadBuffer(Temp, 2);
  7309.           ReadBuffer(Buffer, Temp);
  7310.           if DataType in [ftBlob, ftGraphic..ftTypedBinary,ftOraBlob,ftOraClob] then
  7311.             SetBlobData(@Buffer, Temp) else
  7312.             SetData(@Buffer);
  7313.         end;
  7314.         ReadBuffer(Bool, SizeOf(Bool));
  7315.         if Bool then FData := NULL;
  7316.         ReadBuffer(FBound, SizeOf(FBound));
  7317.       end;
  7318.   end;
  7319. end;
  7320.  
  7321. function TParams.GetParamValue(const ParamName: string): Variant;
  7322. var
  7323.   I: Integer;
  7324.   Params: TList;
  7325. begin
  7326.   if Pos(';', ParamName) <> 0 then
  7327.   begin
  7328.     Params := TList.Create;
  7329.     try
  7330.       GetParamList(Params, ParamName);
  7331.       Result := VarArrayCreate([0, Params.Count - 1], varVariant);
  7332.       for I := 0 to Params.Count - 1 do
  7333.         Result[I] := TParam(Params[I]).Value;
  7334.     finally
  7335.       Params.Free;
  7336.     end;
  7337.   end else
  7338.     Result := ParamByName(ParamName).Value
  7339. end;
  7340.  
  7341. procedure TParams.SetParamValue(const ParamName: string;
  7342.   const Value: Variant);
  7343. var
  7344.   I: Integer;
  7345.   Params: TList;
  7346. begin
  7347.   if Pos(';', ParamName) <> 0 then
  7348.   begin
  7349.     Params := TList.Create;
  7350.     try
  7351.       GetParamList(Params, ParamName);
  7352.       for I := 0 to Params.Count - 1 do
  7353.         TParam(Params[I]).Value := Value[I];
  7354.     finally
  7355.       Params.Free;
  7356.     end;
  7357.   end else
  7358.     ParamByName(ParamName).Value := Value;
  7359. end;
  7360.  
  7361. procedure TParams.GetParamList(List: TList; const ParamNames: string);
  7362. var
  7363.   Pos: Integer;
  7364. begin
  7365.   Pos := 1;
  7366.   while Pos <= Length(ParamNames) do
  7367.     List.Add(ParamByName(ExtractFieldName(ParamNames, Pos)));
  7368. end;
  7369.  
  7370. function TParams.ParseSQL(SQL: String; DoCreate: Boolean): String;
  7371. const
  7372.   Literals = ['''', '"', '`'];
  7373. var
  7374.   Value, CurPos, StartPos: PChar;
  7375.   CurChar: Char;
  7376.   Literal: Boolean;
  7377.   EmbeddedLiteral: Boolean;
  7378.   Name: string;
  7379.  
  7380.   function NameDelimiter: Boolean;
  7381.   begin
  7382.     Result := CurChar in [' ', ',', ';', ')', #13, #10];
  7383.   end;
  7384.  
  7385.   function IsLiteral: Boolean;
  7386.   begin
  7387.     Result := CurChar in Literals;
  7388.   end;
  7389.  
  7390.   function StripLiterals(Buffer: PChar): string;
  7391.   var
  7392.     Len: Word;
  7393.     TempBuf: PChar;
  7394.  
  7395.     procedure StripChar;
  7396.     begin
  7397.       if TempBuf^ in Literals then
  7398.         StrMove(TempBuf, TempBuf + 1, Len - 1);
  7399.       if TempBuf[StrLen(TempBuf) - 1] in Literals then
  7400.         TempBuf[StrLen(TempBuf) - 1] := #0;
  7401.     end;
  7402.  
  7403.   begin
  7404.     Len := StrLen(Buffer) + 1;
  7405.     TempBuf := AllocMem(Len);
  7406.     Result := '';
  7407.     try
  7408.       StrCopy(TempBuf, Buffer);
  7409.       StripChar;
  7410.       Result := StrPas(TempBuf);
  7411.     finally
  7412.       FreeMem(TempBuf, Len);
  7413.     end;
  7414.   end;
  7415.  
  7416. begin
  7417.   Result := SQL;
  7418.   Value := PChar(Result);
  7419.   if DoCreate then Clear;
  7420.   CurPos := Value;
  7421.   Literal := False;
  7422.   EmbeddedLiteral := False;
  7423.   repeat
  7424.     while (CurPos^ in LeadBytes) do Inc(CurPos, 2);
  7425.     CurChar := CurPos^;
  7426.     if (CurChar = ':') and not Literal and ((CurPos + 1)^ <> ':') then
  7427.     begin
  7428.       StartPos := CurPos;
  7429.       while (CurChar <> #0) and (Literal or not NameDelimiter) do
  7430.       begin
  7431.         Inc(CurPos);
  7432.         while (CurPos^ in LeadBytes) do Inc(CurPos, 2);
  7433.         CurChar := CurPos^;
  7434.         if IsLiteral then
  7435.         begin
  7436.           Literal := Literal xor True;
  7437.           if CurPos = StartPos + 1 then EmbeddedLiteral := True;
  7438.         end;
  7439.       end;
  7440.       CurPos^ := #0;
  7441.       if EmbeddedLiteral then
  7442.       begin
  7443.         Name := StripLiterals(StartPos + 1);
  7444.         EmbeddedLiteral := False;
  7445.       end
  7446.       else Name := StrPas(StartPos + 1);
  7447.       if DoCreate then
  7448.         TParam(Add).Name := Name;
  7449.       CurPos^ := CurChar;
  7450.       StartPos^ := '?';
  7451.       Inc(StartPos);
  7452.       StrMove(StartPos, CurPos, StrLen(CurPos) + 1);
  7453.       CurPos := StartPos;
  7454.     end
  7455.     else if (CurChar = ':') and not Literal and ((CurPos + 1)^ = ':') then
  7456.       StrMove(CurPos, CurPos + 1, StrLen(CurPos) + 1)
  7457.     else if IsLiteral then Literal := Literal xor True;
  7458.     Inc(CurPos);
  7459.   until CurChar = #0;
  7460. end;
  7461.  
  7462. { TParam }
  7463.  
  7464. constructor TParam.Create(Collection: TCollection);
  7465. begin
  7466.   inherited Create(Collection);
  7467.   ParamType := ptUnknown;
  7468.   DataType := ftUnknown;
  7469.   FData := Unassigned;
  7470.   FBound := False;
  7471.   FNull := True;
  7472.   FNativeStr := '';
  7473. end;
  7474.  
  7475. constructor TParam.Create(AParams: TParams; AParamType: TParamType);
  7476. begin
  7477.   Create(AParams);
  7478.   ParamType := ParamType;
  7479. end;
  7480.  
  7481. function TParam.IsEqual(Value: TParam): Boolean;
  7482. begin
  7483.   Result := (VarType(FData) = VarType(Value.FData)) and
  7484.     (VarIsEmpty(FData) or (FData = Value.FData)) and
  7485.     (Name = Value.Name) and (DataType = Value.DataType) and
  7486.     (IsNull = Value.IsNull) and(Bound = Value.Bound) and
  7487.     (ParamType = Value.ParamType);
  7488. end;
  7489.  
  7490. function TParam.IsParamStored: Boolean;
  7491. begin
  7492.   Result := Bound;
  7493. end;
  7494.  
  7495. function TParam.ParamRef: TParam;
  7496. begin
  7497.   if not Assigned(FParamRef) then
  7498.     if Assigned(Collection) and (Name <> '') then
  7499.       FParamRef := TParams(Collection).ParamByName(Name) else
  7500.       FParamRef := Self;
  7501.   Result := FParamRef;
  7502. end;
  7503.  
  7504. function TParam.GetIsNull: Boolean;
  7505. begin
  7506.   Result := FNull or VarIsNull(FData) or VarIsEmpty(FData);
  7507. end;
  7508.  
  7509. function TParam.GetParamType: TParamType;
  7510. begin
  7511.   Result := ParamRef.FParamType;
  7512. end;
  7513.  
  7514. procedure TParam.SetParamType(Value: TParamType);
  7515. begin
  7516.   ParamRef.FParamType := Value;
  7517. end;
  7518.  
  7519. function TParam.GetDataType: TFieldType;
  7520. begin
  7521.   Result := ParamRef.FDataType;
  7522. end;
  7523.  
  7524. procedure TParam.SetDataType(Value: TFieldType);
  7525. const
  7526.   VarTypeMap: array[TFieldType] of Integer = (varError, varOleStr, varSmallint,
  7527.     varInteger, varSmallint, varBoolean, varDouble, varCurrency, varCurrency,
  7528.     varDate, varDate, varDate, varOleStr, varOleStr, varInteger, varOleStr,
  7529.     varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varOleStr, varError,
  7530.     varOleStr, varOleStr, varError, varError, varError, varError, varError,
  7531.     varOleStr, varOleStr, varVariant, varUnknown, varDispatch, varOleStr);
  7532. var
  7533.   vType: Integer;
  7534. begin
  7535.   ParamRef.FDataType := Value;
  7536.   if Assigned(DataSet) and (csDesigning in DataSet.ComponentState) and
  7537.      (not ParamRef.IsNull) then
  7538.   begin
  7539.     vType := VarTypeMap[Value];
  7540.     if vType <> varError then
  7541.     try
  7542.       VarCast(ParamRef.FData, ParamRef.FData, vType);
  7543.     except
  7544.       ParamRef.Clear;
  7545.     end else
  7546.       ParamRef.Clear;
  7547.   end else
  7548.     ParamRef.Clear;
  7549. end;
  7550.  
  7551. function TParam.GetDataSize: Integer;
  7552. begin
  7553.   Result := 0;
  7554.   case DataType of
  7555.     ftUnknown: DatabaseErrorFmt(SUnknownFieldType, [Name], DataSet);
  7556.     ftString, ftFixedChar, ftMemo: Result := Length(VarToStr(FData)) + 1;
  7557.     ftBoolean: Result := SizeOf(WordBool);
  7558.     ftBCD: Result := SizeOf(TBcd);
  7559.     ftDateTime,
  7560.     ftCurrency,
  7561.     ftFloat: Result := SizeOf(Double);
  7562.     ftTime,
  7563.     ftDate,
  7564.     ftAutoInc,
  7565.     ftInteger: Result := SizeOf(Integer);
  7566.     ftSmallint: Result := SizeOf(SmallInt);
  7567.     ftWord: Result := SizeOf(Word);
  7568.     ftBytes, ftVarBytes:
  7569.       if VarIsArray(FData) then
  7570.         Result := VarArrayHighBound(FData, 1) + 1 else
  7571.         Result := 0;
  7572.     ftBlob, ftGraphic..ftTypedBinary,ftOraClob,ftOraBlob: Result := Length(VarToStr(FData));
  7573.     ftADT, ftArray, ftDataSet,
  7574.     ftReference, ftCursor: Result := 0;
  7575.   else
  7576.     DatabaseErrorFmt(SBadFieldType, [Name], DataSet);
  7577.   end;
  7578. end;
  7579.  
  7580. procedure TParam.GetData(Buffer: Pointer);
  7581. var
  7582.   P: Pointer;
  7583. begin
  7584.   case DataType of
  7585.     ftUnknown: DatabaseErrorFmt(SUnknownFieldType, [Name], DataSet);
  7586.     ftString, ftFixedChar, ftMemo:
  7587.       StrMove(Buffer, PChar(GetAsString), Length(GetAsString) + 1);
  7588.     ftSmallint: SmallInt(Buffer^) := GetAsInteger;
  7589.     ftWord: Word(Buffer^) := GetAsInteger;
  7590.     ftAutoInc,
  7591.     ftInteger: Integer(Buffer^) := GetAsInteger;
  7592.     ftTime: Integer(Buffer^) := DateTimeToTimeStamp(AsDateTime).Time;
  7593.     ftDate: Integer(Buffer^) := DateTimeToTimeStamp(AsDateTime).Date;
  7594.     ftDateTime:  Double(Buffer^) := TimeStampToMSecs(DateTimeToTimeStamp(AsDateTime));
  7595.     ftBCD: CurrToBCD(AsBCD, TBcd(Buffer^));
  7596.     ftCurrency,
  7597.     ftFloat: Double(Buffer^) := GetAsFloat;
  7598.     ftBoolean: Word(Buffer^) := Ord(GetAsBoolean);
  7599.     ftBytes, ftVarBytes:
  7600.     begin
  7601.       if VarIsArray(FData) then
  7602.       begin
  7603.         P := VarArrayLock(FData);
  7604.         try
  7605.           Move(P^, Buffer^, VarArrayHighBound(FData, 1) + 1);
  7606.         finally
  7607.           VarArrayUnlock(FData);
  7608.         end;
  7609.       end;
  7610.     end;
  7611.     ftBlob, ftGraphic..ftTypedBinary,ftOraBlob,ftOraClob:
  7612.       Move(PChar(GetAsString)^, Buffer^, Length(GetAsString));
  7613.     ftADT, ftArray, ftDataSet,
  7614.     ftReference, ftCursor: {Nothing};
  7615.   else
  7616.     DatabaseErrorFmt(SBadFieldType, [Name], DataSet);
  7617.   end;
  7618. end;
  7619.  
  7620. procedure TParam.SetBlobData(Buffer: Pointer; Size: Integer);
  7621. var
  7622.   DataStr: string;
  7623. begin
  7624.   SetLength(DataStr, Size);
  7625.   Move(Buffer^, PChar(DataStr)^, Size);
  7626.   AsBlob := DataStr;
  7627. end;
  7628.  
  7629. procedure TParam.SetData(Buffer: Pointer);
  7630. var
  7631.   Value: Currency;
  7632.   TimeStamp: TTimeStamp;
  7633. begin
  7634.   case DataType of
  7635.     ftUnknown: DatabaseErrorFmt(SUnknownFieldType, [Name], DataSet);
  7636.     ftString, ftFixedChar: AsString := StrPas(Buffer);
  7637.     ftWord: AsWord := Word(Buffer^);
  7638.     ftSmallint: AsSmallInt := Smallint(Buffer^);
  7639.     ftInteger, ftAutoInc: AsInteger := Integer(Buffer^);
  7640.     ftTime:
  7641.       begin
  7642.         TimeStamp.Time := LongInt(Buffer^);
  7643.         TimeStamp.Date := DateDelta;
  7644.         AsTime := TimeStampToDateTime(TimeStamp);
  7645.       end;
  7646.     ftDate:
  7647.       begin
  7648.         TimeStamp.Time := 0;
  7649.         TimeStamp.Date := Integer(Buffer^);
  7650.         AsDate := TimeStampToDateTime(TimeStamp);
  7651.       end;
  7652.     ftDateTime:
  7653.       begin
  7654.         TimeStamp.Time := 0;
  7655.         TimeStamp.Date := Integer(Buffer^);
  7656.         AsDateTime := TimeStampToDateTime(MSecsToTimeStamp(Double(Buffer^)));
  7657.       end;
  7658.     ftBCD:
  7659.       if BCDToCurr(TBcd(Buffer^), Value) then
  7660.         AsBCD := Value else
  7661.         AsBCD := 0;
  7662.     ftCurrency: AsCurrency := Double(Buffer^);
  7663.     ftFloat: AsFloat := Double(Buffer^);
  7664.     ftBoolean: AsBoolean := WordBool(Buffer^);
  7665.     ftMemo: AsMemo := StrPas(Buffer);
  7666.     ftCursor: FData := 0;
  7667.   else
  7668.     DatabaseErrorFmt(SBadFieldType, [Name], DataSet);
  7669.   end;
  7670. end;
  7671.  
  7672. procedure TParam.SetText(const Value: string);
  7673. begin
  7674.   Self.Value := Value;
  7675. end;
  7676.  
  7677. procedure TParam.Assign(Source: TPersistent);
  7678.  
  7679.   procedure LoadFromBitmap(Bitmap: TBitmap);
  7680.   var
  7681.     MS: TMemoryStream;
  7682.   begin
  7683.     MS := TMemoryStream.Create;
  7684.     try
  7685.       Bitmap.SaveToStream(MS);
  7686.       LoadFromStream(MS, ftGraphic);
  7687.     finally
  7688.       MS.Free;
  7689.     end;
  7690.   end;
  7691.  
  7692.   procedure LoadFromStrings(Source: TSTrings);
  7693.   begin
  7694.     AsMemo := Source.Text;
  7695.   end;
  7696.  
  7697. begin
  7698.   if Source is TParam then
  7699.     AssignParam(TParam(Source))
  7700.   else if Source is TField then
  7701.     AssignField(TField(Source))
  7702.   else if Source is TStrings then
  7703.     LoadFromStrings(TStrings(Source))
  7704.   else if Source is TBitmap then
  7705.     LoadFromBitmap(TBitmap(Source))
  7706.   else if (Source is TPicture) and (TPicture(Source).Graphic is TBitmap) then
  7707.     LoadFromBitmap(TBitmap(TPicture(Source).Graphic))
  7708.   else
  7709.     inherited Assign(Source);
  7710. end;
  7711.  
  7712. procedure TParam.AssignTo(Dest: TPersistent);
  7713. begin
  7714.   if Dest is TField then
  7715.     TField(Dest).Value := FData else
  7716.     inherited AssignTo(Dest);
  7717. end;
  7718.  
  7719. procedure TParam.AssignParam(Param: TParam);
  7720. begin
  7721.   if Param <> nil then
  7722.   begin
  7723.     FDataType := Param.DataType;
  7724.     if Param.IsNull then
  7725.       Clear else
  7726.       Value := Param.FData;
  7727.     FBound := Param.Bound;
  7728.     Name := Param.Name;
  7729.     if ParamType = ptUnknown then ParamType := Param.ParamType;
  7730.   end;
  7731. end;
  7732.  
  7733. procedure TParam.AssignFieldValue(Field: TField; const Value: Variant);
  7734. begin
  7735.   if Field <> nil then
  7736.   begin
  7737.     if (Field.DataType = ftString) and TStringField(Field).FixedChar then
  7738.       DataType := ftFixedChar
  7739.     else if (Field.DataType = ftMemo) and (Field.Size > 255) then
  7740.       DataType := ftString
  7741.     else
  7742.       DataType := Field.DataType;
  7743.     if VarIsNull(Value) then
  7744.       Clear else
  7745.       Self.Value := Value;
  7746.     FBound := True;
  7747.   end;
  7748. end;
  7749.  
  7750. procedure TParam.AssignField(Field: TField);
  7751. begin
  7752.   if Field <> nil then
  7753.   begin
  7754.     AssignFieldValue(Field, Field.Value);
  7755.     Name := Field.FieldName;
  7756.   end;
  7757. end;
  7758.  
  7759. procedure TParam.Clear;
  7760. begin
  7761.   FNull := True;
  7762.   FData := Unassigned;
  7763. end;
  7764.  
  7765. function TParam.GetDataSet: TDataSet;
  7766. begin
  7767.   if not Assigned(Collection) then
  7768.     Result := nil else
  7769.     Result := TParams(Collection).GetDataSet;
  7770. end;
  7771.  
  7772. function TParam.GetDisplayName: string;
  7773. begin
  7774.   if FName = '' then
  7775.     Result := inherited GetDisplayName else
  7776.     Result := FName;
  7777. end;
  7778.  
  7779. procedure TParam.SetAsBoolean(Value: Boolean);
  7780. begin
  7781.   FDataType := ftBoolean;
  7782.   Self.Value := Value;
  7783. end;
  7784.  
  7785. function TParam.GetAsBoolean: Boolean;
  7786. begin
  7787.   if IsNull then
  7788.     Result := False else
  7789.     Result := FData;
  7790. end;
  7791.  
  7792. procedure TParam.SetAsFloat(const Value: Double);
  7793. begin
  7794.   FDataType := ftFloat;
  7795.   Self.Value := Value;
  7796. end;
  7797.  
  7798. function TParam.GetAsFloat: Double;
  7799. begin
  7800.   if IsNull then
  7801.     Result := 0 else
  7802.     Result := FData;
  7803. end;
  7804.  
  7805. procedure TParam.SetAsCurrency(const Value: Currency);
  7806. begin
  7807.   FDataType := ftCurrency;
  7808.   Self.Value := Value;
  7809. end;
  7810.  
  7811. function TParam.GetAsCurrency: Currency;
  7812. begin
  7813.   if IsNull then
  7814.     Result := 0 else
  7815.     Result := FData;
  7816. end;
  7817.  
  7818. procedure TParam.SetAsBCD(const Value: Currency);
  7819. begin
  7820.   FDataType := ftBCD;
  7821.   Self.Value := Value;
  7822. end;
  7823.  
  7824. function TParam.GetAsBCD: Currency;
  7825. begin
  7826.   if IsNull then
  7827.     Result := 0 else
  7828.     Result := FData;
  7829. end;
  7830.  
  7831. procedure TParam.SetAsInteger(Value: Longint);
  7832. begin
  7833.   FDataType := ftInteger;
  7834.   Self.Value := Value;
  7835. end;
  7836.  
  7837. function TParam.GetAsInteger: Longint;
  7838. begin
  7839.   if IsNull then
  7840.     Result := 0 else
  7841.     Result := FData;
  7842. end;
  7843.  
  7844. procedure TParam.SetAsWord(Value: LongInt);
  7845. begin
  7846.   FDataType := ftWord;
  7847.   Self.Value := Value;
  7848. end;
  7849.  
  7850. procedure TParam.SetAsSmallInt(Value: LongInt);
  7851. begin
  7852.   FDataType := ftSmallint;
  7853.   Self.Value := Value;
  7854. end;
  7855.  
  7856. procedure TParam.SetAsString(const Value: string);
  7857. begin
  7858.   FDataType := ftString;
  7859.   Self.Value := Value;
  7860. end;
  7861.  
  7862. function TParam.GetAsString: string;
  7863. begin
  7864.   if IsNull then
  7865.     Result := ''
  7866.   else if DataType = ftBoolean then
  7867.   begin
  7868.     if FData then
  7869.       Result := STextTrue else
  7870.       Result := STextFalse;
  7871.   end else
  7872.     Result := FData;
  7873. end;
  7874.  
  7875. procedure TParam.SetAsDate(const Value: TDateTime);
  7876. begin
  7877.   FDataType := ftDate;
  7878.   Self.Value := Value;
  7879. end;
  7880.  
  7881. procedure TParam.SetAsTime(const Value: TDateTime);
  7882. begin
  7883.   FDataType := ftTime;
  7884.   Self.Value := Value
  7885. end;
  7886.  
  7887. procedure TParam.SetAsDateTime(const Value: TDateTime);
  7888. begin
  7889.   FDataType := ftDateTime;
  7890.   Self.Value := Value
  7891. end;
  7892.  
  7893. function TParam.GetAsDateTime: TDateTime;
  7894. begin
  7895.   if IsNull then
  7896.     Result := 0 else
  7897.     Result := VarToDateTime(FData);
  7898. end;
  7899.  
  7900. procedure TParam.SetAsVariant(const Value: Variant);
  7901. begin
  7902.   if ParamRef = Self then
  7903.   begin
  7904.     FBound := not VarIsEmpty(Value);
  7905.     FNull := VarIsEmpty(Value) or VarIsNull(Value);
  7906.     if FDataType = ftUnknown then
  7907.       case VarType(Value) of
  7908.         varSmallint, varByte: FDataType := ftSmallInt;
  7909.         varInteger: FDataType := ftInteger;
  7910.         varCurrency: FDataType := ftBCD;
  7911.         varSingle, varDouble: FDataType := ftFloat;
  7912.         varDate: FDataType := ftDateTime;
  7913.         varBoolean: FDataType := ftBoolean;
  7914.         varString, varOleStr: FDataType := ftString;
  7915.       else
  7916.         FDataType := ftUnknown;
  7917.       end;
  7918.     FData := Value;
  7919.   end else
  7920.     ParamRef.SetAsVariant(Value);
  7921. end;
  7922.  
  7923. function TParam.GetAsVariant: Variant;
  7924. begin
  7925.   Result := ParamRef.FData;
  7926. end;
  7927.  
  7928. procedure TParam.SetAsMemo(const Value: string);
  7929. begin
  7930.   FDataType := ftMemo;
  7931.   Self.Value := Value;
  7932. end;
  7933.  
  7934. function TParam.GetAsMemo: string;
  7935. begin
  7936.   if IsNull then
  7937.     Result := '' else
  7938.     Result := FData;
  7939. end;
  7940.  
  7941. procedure TParam.SetAsBlob(const Value: TBlobData);
  7942. begin
  7943.   FDataType := ftBlob;
  7944.   Self.Value := Value;
  7945. end;
  7946.  
  7947. procedure TParam.LoadFromFile(const FileName: string; BlobType: TBlobType);
  7948. var
  7949.   Stream: TStream;
  7950. begin
  7951.   Stream := TFileStream.Create(FileName, fmOpenRead);
  7952.   try
  7953.     LoadFromStream(Stream, BlobType);
  7954.   finally
  7955.     Stream.Free;
  7956.   end;
  7957. end;
  7958.  
  7959. procedure TParam.LoadFromStream(Stream: TStream; BlobType: TBlobType);
  7960. var
  7961.   DataStr: string;
  7962.   Len: Integer;
  7963. begin
  7964.   with Stream do
  7965.   begin
  7966.     FDataType := BlobType;
  7967.     Position := 0;
  7968.     Len := Size;
  7969.     SetLength(DataStr, Len);
  7970.     ReadBuffer(Pointer(DataStr)^, Len);
  7971.     Self.Value := DataStr;
  7972.   end;
  7973. end;
  7974.  
  7975. { TDataSet }
  7976.  
  7977. constructor TDataSet.Create(AOwner: TComponent);
  7978. begin
  7979.   inherited Create(AOwner);
  7980.   FFieldDefs := TFieldDefs.Create(Self);
  7981.   FFieldDefList := TFieldDefList.Create(Self);
  7982.   FFields := TFields.Create(Self);
  7983.   FFieldList := TFieldList.Create(Self);
  7984.   FDataSources := TList.Create;
  7985.   FAutoCalcFields := True;
  7986.   FConstraints := TCheckConstraints.Create(Self);
  7987.   FNestedDataSetClass := Self.ClassType;
  7988.   FAggFields := TFields.Create(Self);
  7989.   FAggFields.ValidFieldKinds := [fkAggregate];
  7990.   FFieldNoOfs := 1;
  7991.   ClearBuffers;
  7992.   RPR;
  7993. end;
  7994.  
  7995. destructor TDataSet.Destroy;
  7996. begin
  7997.   Destroying;
  7998.   Close;
  7999.   SetDataSetField(nil);
  8000.   FDesigner.Free;
  8001.   if FDataSources <> nil then
  8002.     while FDataSources.Count > 0 do
  8003.       RemoveDataSource(FDataSources.Last);
  8004.   FDataSources.Free;
  8005.   FFields.Free;
  8006.   FAggFields.Free;
  8007.   FAggFields := nil;
  8008.   FFieldList.Free;
  8009.   FFieldDefList.Free;
  8010.   FFieldDefs.Free;
  8011.   FConstraints.Free;
  8012.   FNestedDataSets.Free;
  8013.   inherited Destroy;
  8014. end;
  8015.  
  8016. procedure TDataSet.SetName(const Value: TComponentName);
  8017. var
  8018.   OldName: TComponentName;
  8019.  
  8020.   procedure RenameFields(Fields: TFields);
  8021.   var
  8022.     I: Integer;
  8023.     Field: TField;
  8024.     FieldName, NamePrefix: TComponentName;
  8025.   begin
  8026.     for I := 0 to Fields.Count - 1 do
  8027.     begin
  8028.       Field := Fields[I];
  8029.       if Field.Owner = Owner then
  8030.       begin
  8031.         FieldName := Field.Name;
  8032.         NamePrefix := FieldName;
  8033.         if Length(NamePrefix) > Length(OldName) then
  8034.         begin
  8035.           SetLength(NamePrefix, Length(OldName));
  8036.           if CompareText(OldName, NamePrefix) = 0 then
  8037.           begin
  8038.             System.Delete(FieldName, 1, Length(OldName));
  8039.             System.Insert(Value, FieldName, 1);
  8040.             try
  8041.               Field.Name := FieldName;
  8042.             except
  8043.               on EComponentError do {Ignore rename errors };
  8044.             end;
  8045.           end;
  8046.         end;
  8047.         if Field.DataType in [ftADT, ftArray] then
  8048.           RenameFields(TObjectField(Field).Fields);
  8049.       end;
  8050.     end;
  8051.   end;
  8052.  
  8053. begin
  8054.   OldName := Name;
  8055.   inherited SetName(Value);
  8056.   { In design mode the name of the fields should track the data set name }
  8057.   if (csDesigning in ComponentState) and (Name <> OldName) then
  8058.   begin
  8059.     RenameFields(Fields);
  8060.     RenameFields(AggFields);
  8061.   end;
  8062. end;
  8063.  
  8064. procedure TDataSet.GetChildren(Proc: TGetChildProc; Root: TComponent);
  8065. var
  8066.   I: Integer;
  8067.   Field: TField;
  8068. begin
  8069.   for I := 0 to FFields.Count - 1 do
  8070.   begin
  8071.     Field := FFields[I];
  8072.     if Field.Owner = Root then Proc(Field);
  8073.   end;
  8074.   for I := 0 to FAggFields.Count - 1 do
  8075.   begin
  8076.     Field := FAggFields[I];
  8077.     if Field.Owner = Root then Proc(Field);
  8078.   end;
  8079. end;
  8080.  
  8081. procedure TDataSet.SetChildOrder(Component: TComponent; Order: Integer);
  8082. var
  8083.   F: TField;
  8084. begin
  8085.   F := Component as TField;
  8086.   if FFields.IndexOf(F) >= 0 then
  8087.     F.Index := Order;
  8088. end;
  8089.  
  8090. procedure TDataSet.Loaded;
  8091. begin
  8092.   inherited Loaded;
  8093.   try
  8094.     if FStreamedActive then Active := True;
  8095.   except
  8096.     if csDesigning in ComponentState then
  8097.       InternalHandleException else
  8098.       raise;
  8099.   end;
  8100. end;
  8101.  
  8102. procedure TDataSet.SetState(Value: TDataSetState);
  8103. begin
  8104.   if FState <> Value then
  8105.   begin
  8106.     FState := Value;
  8107.     FModified := False;
  8108.     DataEvent(deUpdateState, 0);
  8109.   end;
  8110. end;
  8111.  
  8112. procedure TDataSet.SetModified(Value: Boolean);
  8113. begin
  8114.   FModified := Value;
  8115. end;
  8116.  
  8117. function TDataSet.CreateNestedDataSet(DataSetField: TDataSetField): TDataSet;
  8118. begin
  8119.   Result := TDataSet(NestedDataSetClass.NewInstance);
  8120.   Result.Create(DataSetField);
  8121.   try
  8122.     Result.ObjectView := True;
  8123.     Result.DataSetField := DataSetField;
  8124.   except
  8125.     Result.Free;
  8126.     raise;
  8127.   end;
  8128. end;
  8129.  
  8130. procedure TDataSet.SetDataSetField(const Value: TDataSetField);
  8131. begin
  8132.   if Value <> FDataSetField then
  8133.   begin
  8134.     if (Value <> nil) and ((Value.DataSet = Self) or
  8135.        ((Value.DataSet.GetDataSource <> nil) and
  8136.         (Value.DataSet.GetDataSource.DataSet = Self))) then
  8137.       DatabaseError(SCircularDataLink, Self);
  8138.     if Assigned(Value) and not InheritsFrom(Value.DataSet.FNestedDataSetClass) then
  8139.       DatabaseErrorFmt(SNestedDataSetClass, [Value.DataSet.FNestedDataSetClass.ClassName], Self);
  8140.     if Active then Close;
  8141.     if Assigned(FDataSetField) then
  8142.       FDataSetField.AssignNestedDataSet(nil);
  8143.     FDataSetField := Value;
  8144.     if Assigned(Value) then
  8145.     begin
  8146.       Value.AssignNestedDataSet(Self);
  8147.       if Value.DataSet.Active then Open;
  8148.     end;
  8149.   end;
  8150. end;
  8151.  
  8152. function TDataSet.GetNestedDataSets: TList;
  8153. begin
  8154.   if FNestedDataSets = nil then
  8155.     FNestedDataSets := TList.Create;
  8156.   Result := FNestedDataSets;
  8157. end;
  8158.  
  8159. function TDataSet.GetFound: Boolean;
  8160. begin
  8161.   Result := FFound;
  8162. end;
  8163.  
  8164. procedure TDataSet.SetFound(const Value: Boolean);
  8165. begin
  8166.   FFound := Value;
  8167. end;
  8168.  
  8169. procedure TDataSet.SetObjectView(const Value: Boolean);
  8170. begin
  8171.   CheckInactive;
  8172.   FObjectView := Value;
  8173. end;
  8174.  
  8175. procedure TDataSet.SetSparseArrays(Value: Boolean);
  8176. begin
  8177.   CheckInactive;
  8178.   FSparseArrays := Value;
  8179. end;
  8180.  
  8181. procedure TDataSet.SetConstraints(Value: TCheckConstraints);
  8182. begin
  8183.   FConstraints.Assign(Value);
  8184. end;
  8185.  
  8186. function TDataSet.SetTempState(const Value: TDataSetState): TDataSetState;
  8187. begin
  8188.   Result := FState;
  8189.   FState := Value;
  8190.   Inc(FDisableCount);
  8191.   FModified := False;
  8192. end;
  8193.  
  8194. procedure TDataSet.RestoreState(const Value: TDataSetState);
  8195. begin
  8196.   FState := Value;
  8197.   Dec(FDisableCount);
  8198.   FModified := False;
  8199. end;
  8200.  
  8201. procedure TDataSet.Open;
  8202. begin
  8203.   Active := True;
  8204. end;
  8205.  
  8206. procedure TDataSet.Close;
  8207. begin
  8208.   Active := False;
  8209. end;
  8210.  
  8211. procedure TDataSet.CheckInactive;
  8212. begin
  8213.   if Active then
  8214.     if ([csUpdating, csDesigning] * ComponentState) <> [] then
  8215.       Close else
  8216.       DatabaseError(SDataSetOpen, Self);
  8217. end;
  8218.  
  8219. procedure TDataSet.CheckActive;
  8220. begin
  8221.   if State = dsInactive then DatabaseError(SDataSetClosed, Self);
  8222. end;
  8223.  
  8224. function TDataSet.GetActive: Boolean;
  8225. begin
  8226.   Result := not (State in [dsInactive, dsOpening]);
  8227. end;
  8228.  
  8229. procedure TDataSet.SetActive(Value: Boolean);
  8230. begin
  8231.   if (csReading in ComponentState) then
  8232.   begin
  8233.     FStreamedActive := Value;
  8234.   end
  8235.   else
  8236.     if Active <> Value then
  8237.     begin
  8238.       if Value then
  8239.       begin
  8240.         DoBeforeOpen;
  8241.         try
  8242.           OpenCursor;
  8243.         finally
  8244.           if State <> dsOpening then
  8245.             OpenCursorComplete;
  8246.         end;
  8247.       end else
  8248.       begin
  8249.         if not (csDestroying in ComponentState) then DoBeforeClose;
  8250.         SetState(dsInactive);
  8251.         CloseCursor;
  8252.         if not (csDestroying in ComponentState) then DoAfterClose;
  8253.       end;
  8254.     end;
  8255. end;
  8256.  
  8257. procedure TDataSet.DoInternalOpen;
  8258. begin
  8259.   FDefaultFields := FieldCount = 0;
  8260.   InternalOpen;
  8261.   FInternalOpenComplete := True;
  8262.   UpdateBufferCount;
  8263.   FBOF := True;
  8264. end;
  8265.  
  8266. procedure TDataSet.OpenCursorComplete;
  8267. begin
  8268.   try
  8269.     if State = dsOpening then
  8270.       DoInternalOpen;
  8271.   finally
  8272.     if FInternalOpenComplete then
  8273.     begin
  8274.       SetState(dsBrowse);
  8275.       DoAfterOpen;
  8276.     end else
  8277.     begin
  8278.       SetState(dsInactive);
  8279.       CloseCursor;
  8280.     end;
  8281.   end;
  8282. end;
  8283.  
  8284. procedure TDataSet.OpenCursor(InfoQuery: Boolean = False);
  8285. begin
  8286.   if InfoQuery then
  8287.     InternalInitFieldDefs
  8288.   else if State <> dsOpening then
  8289.     DoInternalOpen;
  8290. end;
  8291.  
  8292. procedure TDataSet.CloseCursor;
  8293. begin
  8294.   BlockReadSize := 0;
  8295.   FInternalOpenComplete := False;
  8296.   FreeFieldBuffers;
  8297.   ClearBuffers;
  8298.   SetBufListSize(0);
  8299.   InternalClose;
  8300.   FBufferCount := 0;
  8301.   FDefaultFields := False;
  8302. end;
  8303.  
  8304. procedure TDataSet.OpenParentDataSet(ParentDataSet: TDataSet);
  8305. begin
  8306.   if not ParentDataSet.IsCursorOpen then
  8307.   begin
  8308.     { Temporarily set the our State to dsOpening to prevent recursive calls to
  8309.       Open by TDataSetField.Bind }
  8310.     FState := dsOpening;
  8311.     try
  8312.       ParentDataSet.Open;
  8313.     finally
  8314.       FState := dsInActive;
  8315.     end;
  8316.   end;
  8317.   ParentDataSet.UpdateCursorPos;
  8318. end;
  8319.  
  8320. { Provider helpers }
  8321.  
  8322. procedure TDataSet.GetDetailDataSets(List: TList);
  8323. var
  8324.   I, J: Integer;
  8325. begin
  8326.   List.Clear;
  8327.   for I := FDataSources.Count - 1 downto 0 do
  8328.     with TDataSource(FDataSources[I]) do
  8329.       for J := FDataLinks.Count - 1 downto 0 do
  8330.         if (TDataLink(FDataLinks[J]) is TDetailDataLink) and
  8331.            (TDetailDataLink(FDataLinks[J]).DetailDataSet <> nil) and
  8332.            (TDetailDataLink(FDataLinks[J]).DetailDataSet.DataSetField = nil) then
  8333.           List.Add(TDetailDataLink(FDataLinks[J]).DetailDataSet);
  8334. end;
  8335.  
  8336. procedure TDataSet.GetDetailLinkFields(MasterFields, DetailFields: TList);
  8337. begin
  8338. end;
  8339.  
  8340. { Field Management }
  8341.  
  8342. procedure TDataSet.DefChanged(Sender: TObject);
  8343. begin
  8344. end;
  8345.  
  8346. procedure TDataSet.InitFieldDefs;
  8347. begin
  8348.   if IsCursorOpen or (Assigned(FDesigner) and FDesigner.FSaveActive) then
  8349.     InternalInitFieldDefs
  8350.   else
  8351.     try
  8352.       OpenCursor(True);
  8353.     finally
  8354.       CloseCursor;
  8355.     end;
  8356. end;
  8357.  
  8358. procedure TDataSet.InitFieldDefsFromFields;
  8359.  
  8360.   procedure CreateFieldDefs(Fields: TFields; FieldDefs: TFieldDefs);
  8361.   var
  8362.     I: Integer;
  8363.     F: TField;
  8364.     FieldDef: TFieldDef;
  8365.   begin
  8366.     for I := 0 to Fields.Count - 1 do
  8367.     begin
  8368.       F := Fields[I];
  8369.       with F do
  8370.       if FieldKind = fkData then
  8371.       begin
  8372.         FieldDef := FieldDefs.AddFieldDef;
  8373.         FieldDef.Name := FieldName;
  8374.         FieldDef.DataType := DataType;
  8375.         FieldDef.Size := Size;
  8376.         if Required then
  8377.           FieldDef.Attributes := [faRequired];
  8378.         if ReadOnly then
  8379.           FieldDef.Attributes := FieldDef.Attributes + [faReadonly];
  8380.         if (DataType = ftBCD) and (F is TBCDField) then
  8381.           FieldDef.Precision := TBCDField(F).Precision;
  8382.         if F is TObjectField then
  8383.           CreateFieldDefs(TObjectField(F).Fields, FieldDef.ChildDefs);
  8384.       end;
  8385.     end;
  8386.   end;
  8387.  
  8388. begin
  8389.   { Create FieldDefs from persistent fields if needed }
  8390.   if FieldDefs.Count = 0 then
  8391.   begin
  8392.     Inc(FieldDefs.FInternalUpdateCount);
  8393.     FieldDefs.BeginUpdate;
  8394.     try
  8395.       CreateFieldDefs(FFields, FieldDefs);
  8396.     finally
  8397.       FieldDefs.EndUpdate;
  8398.       Dec(FieldDefs.FInternalUpdateCount);
  8399.     end;
  8400.   end;
  8401. end;
  8402.  
  8403. procedure TDataSet.SetFieldDefs(Value: TFieldDefs);
  8404. begin
  8405.   FieldDefs.Assign(Value);
  8406. end;
  8407.  
  8408. function TDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
  8409. begin
  8410.   Result := DefaultFieldClasses[FieldType];
  8411. end;
  8412.  
  8413. function TDataSet.GetFieldFullName(Field: TField): string;
  8414. var
  8415.   ParentField: TObjectField;
  8416. begin
  8417.   Result := Field.FieldName;
  8418.   ParentField := Field.ParentField;
  8419.   while ParentField <> nil do
  8420.   begin
  8421.     if (ParentField.DataType <> ftArray) and not ParentField.UnNamed then
  8422.       Result := Format('%s.%s', [ParentField.FieldName, Result]);
  8423.     ParentField := ParentField.ParentField;
  8424.   end;
  8425. end;
  8426.  
  8427. procedure TDataSet.CreateFields;
  8428. var
  8429.   I: Integer;
  8430. begin
  8431.   if ObjectView then
  8432.   begin
  8433.     for I := 0 to FieldDefs.Count - 1 do
  8434.       with FieldDefs[I] do
  8435.         if (DataType <> ftUnknown) and
  8436.           not ((faHiddenCol in Attributes) and not FIeldDefs.HiddenFields) then
  8437.           CreateField(Self);
  8438.   end else
  8439.   begin
  8440.     for I := 0 to FieldDefList.Count - 1 do
  8441.       with FieldDefList[I] do
  8442.         if (DataType <> ftUnknown) and not (DataType in ObjectFieldTypes) and
  8443.           not ((faHiddenCol in Attributes) and not FIeldDefs.HiddenFields) then
  8444.           CreateField(Self, nil, FieldDefList.Strings[I]);
  8445.   end;
  8446. end;
  8447.  
  8448. procedure TDataSet.DestroyFields;
  8449. begin
  8450.   FFields.Clear;
  8451.   if Assigned(FNestedDataSets) then
  8452.     FNestedDataSets.Clear;
  8453. end;
  8454.  
  8455. procedure TDataSet.CheckFieldCompatibility(Field: TField; FieldDef: TFieldDef);
  8456. const
  8457.   BaseFieldTypes: array[TFieldType] of TFieldType = (
  8458.     ftUnknown, ftString, ftInteger, ftInteger, ftInteger, ftBoolean, ftFloat,
  8459.     ftFloat, ftBCD, ftDateTime, ftDateTime, ftDateTime, ftBytes, ftVarBytes,
  8460.     ftInteger, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftBlob, ftUnknown,
  8461.     ftString, ftUnknown, ftLargeInt, ftADT, ftArray, ftReference, ftDataSet,
  8462.     ftBlob, ftBlob, ftVariant, ftInterface, ftInterface, ftString);
  8463.  
  8464.   CheckTypeSizes = [ftBytes, ftVarBytes, ftBCD, ftReference];
  8465.  
  8466. begin
  8467.   with Field do
  8468.   begin
  8469.     if (BaseFieldTypes[DataType] <> BaseFieldTypes[FieldDef.DataType]) then
  8470.       DatabaseErrorFmt(SFieldTypeMismatch, [DisplayName,
  8471.         FieldTypeNames[DataType], FieldTypeNames[FieldDef.DataType]], Self);
  8472.     if (DataType in CheckTypeSizes) and (Size <> FieldDef.Size) then
  8473.         DatabaseErrorFmt(SFieldSizeMismatch, [DisplayName, Size,
  8474.           FieldDef.Size], Self);
  8475.   end;
  8476. end;
  8477.  
  8478. procedure TDataSet.BindFields(Binding: Boolean);
  8479. const
  8480.   CalcFieldTypes = [ftString, ftSmallint, ftInteger, ftWord, ftBoolean,
  8481.     ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime, ftVariant];
  8482.  
  8483.   procedure DoBindFields(Fields: TFields);
  8484.   var
  8485.     I, FieldIndex: Integer;
  8486.     FieldDef: TFieldDef;
  8487.   begin
  8488.     for I := 0 to Fields.Count - 1 do
  8489.     with Fields[I] do
  8490.     begin
  8491.       if Binding then
  8492.       begin
  8493.         if FieldKind in [fkCalculated, fkLookup] then
  8494.         begin
  8495.           if not (DataType in CalcFieldTypes) then
  8496.             DatabaseErrorFmt(SInvalidCalcType, [DisplayName], Self);
  8497.           FFieldNo := -1;
  8498.           FOffset := FCalcFieldsSize;
  8499.           Inc(FCalcFieldsSize, DataSize + 1);
  8500.         end else
  8501.         if FieldKind = fkAggregate then
  8502.           FFieldNo := -1
  8503.         else
  8504.         begin
  8505.           FieldDef := nil;
  8506.           FieldIndex := FieldDefList.IndexOf(FullName);
  8507.           if FieldIndex <> -1 then
  8508.             FieldDef := FieldDefList[FieldIndex] else
  8509.             DatabaseErrorFmt(SFieldNotFound, [DisplayName], Self);
  8510.           if FieldKind = fkInternalCalc then
  8511.             FFieldNo := FieldDef.FieldNo else
  8512.             FFieldNo := FieldIndex + FFieldNoOfs;
  8513.           CheckFieldCompatibility(Fields[I], FieldDef);
  8514.           if FieldDef.InternalCalcField then
  8515.             FInternalCalcFields := True;
  8516.           if IsBlob then
  8517.           begin
  8518.             FSize := FieldDef.Size;
  8519.             FOffset := FBlobFieldCount;
  8520.             Inc(FBlobFieldCount);
  8521.           end;
  8522.         end;
  8523.         Bind(True);
  8524.       end else
  8525.       begin
  8526.         Bind(False);
  8527.         FFieldNo := 0;
  8528.       end;
  8529.       if Fields[I].DataType in [ftADT, ftArray] then
  8530.         DoBindFields(TObjectField(Fields[I]).Fields);
  8531.     end;
  8532.   end;
  8533.  
  8534. begin
  8535.   FCalcFieldsSize := 0;
  8536.   FBlobFieldCount := 0;
  8537.   FInternalCalcFields := False;
  8538.   DoBindFields(Fields);
  8539. end;
  8540.  
  8541. procedure TDataSet.FreeFieldBuffers;
  8542. var
  8543.   I: Integer;
  8544. begin
  8545.   for I := 0 to FFields.Count - 1 do FFields[I].FreeBuffers;
  8546. end;
  8547.  
  8548. function TDataSet.GetFieldCount: Integer;
  8549. begin
  8550.   Result := FFields.Count;
  8551. end;
  8552.  
  8553. function TDataSet.GetBlobFieldData(FieldNo: Integer; var Buffer: TBlobByteData): Integer;
  8554. var
  8555.   Stream: TStream;
  8556. begin
  8557.   Stream := CreateBlobStream(FieldByNumber(FieldNo) as TBlobField, bmRead);
  8558.   try
  8559.     Result := Stream.Size;
  8560.     if Result > 0 then
  8561.     begin
  8562.       if Length(Buffer) < (Result+1) then
  8563.         SetLength(Buffer, Result + Result div 4);
  8564.       Stream.Read(Buffer[0], Result);
  8565.     end;
  8566.   finally
  8567.     Stream.Free;
  8568.   end;
  8569. end;
  8570.  
  8571. function TDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
  8572. begin
  8573.   Result := False;
  8574. end;
  8575.  
  8576. function TDataSet.GetFieldData(FieldNo: Integer; Buffer: Pointer): Boolean;
  8577. begin
  8578.   Result := GetFieldData(FieldByNumber(FieldNo), Buffer);
  8579. end;
  8580.  
  8581. function TDataSet.GetFieldData(Field: TField; Buffer: Pointer;
  8582.   NativeFormat: Boolean): Boolean;
  8583. var
  8584.   NativeBuf: array[0..dsMaxStringSize] of Char;
  8585. begin
  8586.   if NativeFormat then
  8587.     Result := GetFieldData(Field, Buffer) else
  8588.   begin
  8589.     Result := GetFieldData(Field, @NativeBuf);
  8590.     if Result then
  8591.       DataConvert(Field, @NativeBuf, Buffer, False);
  8592.   end;
  8593. end;
  8594.  
  8595. procedure TDataSet.SetFieldData(Field: TField; Buffer: Pointer;
  8596.   NativeFormat: Boolean);
  8597. var
  8598.   NativeBuf: array[0..dsMaxStringSize] of Char;
  8599. begin
  8600.   if NativeFormat then
  8601.     SetFieldData(Field, Buffer)
  8602.   else
  8603.   begin
  8604.     if Buffer <> nil then
  8605.       DataConvert(Field, Buffer, @NativeBuf, True);
  8606.     SetFieldData(Field, @NativeBuf);
  8607.   end;
  8608. end;
  8609.  
  8610. function TDataSet.GetFieldValue(const FieldName: string): Variant;
  8611. var
  8612.   I: Integer;
  8613.   Fields: TList;
  8614. begin
  8615.   if Pos(';', FieldName) <> 0 then
  8616.   begin
  8617.     Fields := TList.Create;
  8618.     try
  8619.       GetFieldList(Fields, FieldName);
  8620.       Result := VarArrayCreate([0, Fields.Count - 1], varVariant);
  8621.       for I := 0 to Fields.Count - 1 do
  8622.         Result[I] := TField(Fields[I]).Value;
  8623.     finally
  8624.       Fields.Free;
  8625.     end;
  8626.   end else
  8627.     Result := FieldByName(FieldName).Value
  8628. end;
  8629.  
  8630. procedure TDataSet.SetFieldValue(const FieldName: string;
  8631.   const Value: Variant);
  8632. var
  8633.   I: Integer;
  8634.   Fields: TList;
  8635. begin
  8636.   if Pos(';', FieldName) <> 0 then
  8637.   begin
  8638.     Fields := TList.Create;
  8639.     try
  8640.       GetFieldList(Fields, FieldName);
  8641.       for I := 0 to Fields.Count - 1 do
  8642.         TField(Fields[I]).Value := Value[I];
  8643.     finally
  8644.       Fields.Free;
  8645.     end;
  8646.   end else
  8647.     FieldByName(FieldName).Value := Value;
  8648. end;
  8649.  
  8650. function TDataSet.FieldByName(const FieldName: string): TField;
  8651. begin
  8652.   Result := FindField(FieldName);
  8653.   if Result = nil then DatabaseErrorFmt(SFieldNotFound, [FieldName], Self);
  8654. end;
  8655.  
  8656. function TDataSet.FieldByNumber(FieldNo: Integer): TField;
  8657. begin
  8658.   Result := FFields.FieldByNumber(FieldNo);
  8659. end;
  8660.  
  8661. function TDataSet.FindField(const FieldName: string): TField;
  8662. begin
  8663.   Result := FFields.FindField(FieldName);
  8664.   if (Result = nil) and ObjectView then
  8665.     Result := FieldList.Find(FieldName);
  8666.   if Result = nil then
  8667.     Result := FAggFields.FindField(FieldName);
  8668. end;
  8669.  
  8670. procedure TDataSet.GetFieldNames(List: TStrings);
  8671. begin
  8672.   if FFields.Count > 0 then
  8673.     List.Assign(FieldList)
  8674.   else
  8675.   begin
  8676.     FieldDefs.Update;
  8677.     List.Assign(FieldDefList);
  8678.   end;
  8679. end;
  8680.  
  8681. function TDataSet.GetStateFieldValue(State: TDataSetState; Field: TField): Variant;
  8682. var
  8683.   SaveState: TDataSetState;
  8684. begin
  8685.   if Field.FieldKind in [fkData, fkInternalCalc] then
  8686.   begin
  8687.     SaveState := FState;
  8688.     FState := State;
  8689.     try
  8690.       Result := Field.AsVariant;
  8691.     finally
  8692.       FState := SaveState;
  8693.     end;
  8694.   end else
  8695.     Result := NULL;
  8696. end;
  8697.  
  8698. procedure TDataSet.SetStateFieldValue(State: TDataSetState; Field: TField; const Value: Variant);
  8699. var
  8700.   SaveState: TDataSetState;
  8701. begin
  8702.   if Field.FieldKind <> fkData then Exit;
  8703.   SaveState := FState;
  8704.   FState := State;
  8705.   try
  8706.     Field.AsVariant := Value;
  8707.   finally
  8708.     FState := SaveState;
  8709.   end;
  8710. end;
  8711.  
  8712. procedure TDataSet.CloseBlob(Field: TField);
  8713. begin
  8714. end;
  8715.  
  8716. function TDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  8717. begin
  8718.   Result := nil;
  8719. end;
  8720.  
  8721. procedure TDataSet.SetDefaultFields(const Value: Boolean);
  8722. begin
  8723.   FDefaultFields := Value;
  8724. end;
  8725.  
  8726. procedure TDataSet.DataConvert(Field: TField; Source, Dest: Pointer; ToNative: Boolean);
  8727.  
  8728.   { DateTime Conversions }
  8729.  
  8730.   function NativeToDateTime(DataType: TFieldType; Data: TDateTimeRec): TDateTime;
  8731.   var
  8732.     TimeStamp: TTimeStamp;
  8733.   begin
  8734.     case DataType of
  8735.       ftDate:
  8736.         begin
  8737.           TimeStamp.Time := 0;
  8738.           TimeStamp.Date := Data.Date;
  8739.         end;
  8740.       ftTime:
  8741.         begin
  8742.           TimeStamp.Time := Data.Time;
  8743.           TimeStamp.Date := DateDelta;
  8744.         end;
  8745.     else
  8746.       try
  8747.         TimeStamp := MSecsToTimeStamp(Data.DateTime);
  8748.       except
  8749.         TimeStamp.Time := 0;
  8750.         TimeStamp.Date := 0;
  8751.       end;
  8752.     end;
  8753.     Result := TimeStampToDateTime(TimeStamp);
  8754.   end;
  8755.  
  8756.   function DateTimeToNative(DataType: TFieldType; Data: TDateTime): TDateTimeRec;
  8757.   var
  8758.     TimeStamp: TTimeStamp;
  8759.   begin
  8760.     TimeStamp := DateTimeToTimeStamp(Data);
  8761.     case DataType of
  8762.       ftDate: Result.Date := TimeStamp.Date;
  8763.       ftTime: Result.Time := TimeStamp.Time;
  8764.     else
  8765.       Result.DateTime := TimeStampToMSecs(TimeStamp);
  8766.     end;
  8767.   end;
  8768.  
  8769.   { Byte Field Conversions }
  8770.  
  8771.   procedure BufferToByteArray(Data: Pointer; DataSize: Integer; var VarArray: OleVariant);
  8772.   var
  8773.     PVarData: Pointer;
  8774.   begin
  8775.     VarArray := VarArrayCreate([0, DataSize - 1], varByte);
  8776.     PVarData := VarArrayLock(VarArray);
  8777.     try
  8778.       Move(Data^, PVarData^, DataSize);
  8779.     finally
  8780.       VarArrayUnlock(VarArray);
  8781.     end;
  8782.   end;
  8783.  
  8784.   procedure ByteArrayToBuffer(const Data: OleVariant; Buffer: Pointer; var DataSize: Word);
  8785.   var
  8786.     PVarData: Pointer;
  8787.   begin
  8788.     DataSize := VarArrayHighBound(Data, 1)+1;
  8789.     PVarData := VarArrayLock(Data);
  8790.     try
  8791.       Move(PVarData^, Buffer^, DataSize);
  8792.     finally
  8793.       VarArrayUnlock(Data);
  8794.     end;
  8795.   end;
  8796.  
  8797. var
  8798.   DataSize: Word;
  8799. begin
  8800.   case Field.DataType of
  8801.     ftDate, ftTime, ftDateTime:
  8802.       if ToNative then
  8803.         TDateTimeRec(Dest^) := DateTimeToNative(Field.DataType, TDateTime(Source^)) else
  8804.         TDateTime(Dest^) := NativeToDateTime(Field.DataType, TDateTimeRec(Source^));
  8805.     ftBCD:
  8806.       if ToNative then
  8807.         CurrToBCD(Currency(Source^), TBcd(Dest^), 32, Field.Size) else
  8808.         if not BCDToCurr(TBcd(Source^), Currency(Dest^)) then
  8809.           raise EOverFlow.CreateFmt(SFieldOutOfRange, [Field.DisplayName]);
  8810.     ftBytes:
  8811.       if ToNative then
  8812.         ByteArrayToBuffer(POleVariant(Source)^, Dest, DataSize) else
  8813.         BufferToByteArray(Source, Field.DataSize, POleVariant(Dest)^);
  8814.     ftVarBytes:
  8815.       if ToNative then
  8816.         ByteArrayToBuffer(POleVariant(Source)^, PChar(Dest)+2, PWord(Dest)^) else
  8817.         BufferToByteArray(PChar(Source)+2, PWord(Source)^, POleVariant(Dest)^);
  8818.   end;
  8819. end;
  8820.  
  8821. { Index Related }
  8822.  
  8823. function TDataSet.GetIsIndexField(Field: TField): Boolean;
  8824. begin
  8825.   Result := False;
  8826. end;
  8827.  
  8828. procedure TDataSet.UpdateIndexDefs;
  8829. begin
  8830. end;
  8831.  
  8832. { Datasource/Datalink Interaction }
  8833.  
  8834. function TDataSet.GetDataSource: TDataSource;
  8835. begin
  8836.   Result := nil;
  8837. end;
  8838.  
  8839. function TDataSet.IsLinkedTo(DataSource: TDataSource): Boolean;
  8840. var
  8841.   DataSet: TDataSet;
  8842. begin
  8843.   Result := True;
  8844.   while DataSource <> nil do
  8845.   begin
  8846.     DataSet := DataSource.DataSet;
  8847.     if DataSet = nil then Break;
  8848.     if DataSet = Self then Exit;
  8849.     if (DataSet.DataSetField <> nil) and
  8850.        (DataSet.DataSetField.DataSet = Self) then Exit;
  8851.     DataSource := DataSet.DataSource;
  8852.   end;
  8853.   Result := False;
  8854. end;
  8855.  
  8856. procedure TDataSet.AddDataSource(DataSource: TDataSource);
  8857. begin
  8858.   FDataSources.Add(DataSource);
  8859.   DataSource.FDataSet := Self;
  8860.   UpdateBufferCount;
  8861.   DataSource.UpdateState;
  8862. end;
  8863.  
  8864. procedure TDataSet.RemoveDataSource(DataSource: TDataSource);
  8865. begin
  8866.   DataSource.FDataSet := nil;
  8867.   FDataSources.Remove(DataSource);
  8868.   DataSource.UpdateState;
  8869.   UpdateBufferCount;
  8870. end;
  8871.  
  8872. procedure TDataSet.DataEvent(Event: TDataEvent; Info: Longint);
  8873.  
  8874.   procedure UpdateCalcFields;
  8875.   begin
  8876.     if State <> dsSetKey then
  8877.     begin
  8878.       if FInternalCalcFields and (TField(Info).FieldKind = fkData) then
  8879.         RefreshInternalCalcFields(ActiveBuffer)
  8880.       else if (FCalcFieldsSize <> 0) and FAutoCalcFields and
  8881.         (TField(Info).FieldKind = fkData) then
  8882.         CalculateFields(ActiveBuffer);
  8883.       TField(Info).Change;
  8884.     end;
  8885.   end;
  8886.  
  8887.   procedure NotifyDetails;
  8888.   var
  8889.     I: Integer;
  8890.   begin
  8891.     if Assigned(FNestedDataSets) then
  8892.     begin
  8893.       if State <> dsInsert then UpdateCursorPos;
  8894.       for I := 0 to FNestedDataSets.Count - 1 do
  8895.         with TDataSet(FNestedDataSets[I]) do
  8896.           if Active then DataEvent(deParentScroll, 0);
  8897.     end;
  8898.     if (State = dsBlockRead) then
  8899.       for I := 0 to FDataSources.Count - 1 do
  8900.         TDataSource(FDataSources[I]).NotifyLinkTypes(Event, Info, False);
  8901.   end;
  8902.  
  8903.   procedure CheckNestedBrowseMode;
  8904.   var
  8905.     I: Integer;
  8906.   begin
  8907.     if Assigned(FNestedDataSets) then
  8908.       for I := 0 to FNestedDataSets.Count - 1 do
  8909.         with TDataSet(FNestedDataSets[I]) do
  8910.           if Active then CheckBrowseMode;
  8911.   end;
  8912.  
  8913. var
  8914.   I: Integer;
  8915. begin
  8916.   case Event of
  8917.     deFieldChange:
  8918.       begin
  8919.         if TField(Info).FieldKind in [fkData, fkInternalCalc] then
  8920.           SetModified(True);
  8921.         UpdateCalcFields;
  8922.       end;
  8923.     deFieldListChange, deLayoutChange:
  8924.       FieldList.Updated := False;
  8925.     dePropertyChange:
  8926.       FieldDefs.Updated := False;
  8927.     deCheckBrowseMode:
  8928.       CheckNestedBrowseMode;
  8929.     deDataSetChange, deDataSetScroll:
  8930.       NotifyDetails;
  8931.   end;
  8932.   if (FDisableCount = 0) and (State <> dsBlockRead) then
  8933.   begin
  8934.     for I := 0 to FDataSources.Count - 1 do
  8935.       TDataSource(FDataSources[I]).DataEvent(Event, Info);
  8936.     if FDesigner <> nil then FDesigner.DataEvent(Event, Info);
  8937.   end
  8938.   else if (Event = deUpdateState) and (State = dsInactive) or
  8939.     (Event = deLayoutChange) then FEnableEvent := deLayoutChange;
  8940. end;
  8941.  
  8942. function TDataSet.ControlsDisabled: Boolean;
  8943. begin
  8944.   Result := FDisableCount <> 0;
  8945. end;
  8946.  
  8947. procedure TDataSet.DisableControls;
  8948. begin
  8949.   if FDisableCount = 0 then
  8950.   begin
  8951.     FDisableState := FState;
  8952.     FEnableEvent := deDataSetChange;
  8953.   end;
  8954.   Inc(FDisableCount);
  8955. end;
  8956.  
  8957. procedure TDataSet.EnableControls;
  8958. begin
  8959.   if FDisableCount <> 0 then
  8960.   begin
  8961.     Dec(FDisableCount);
  8962.     if FDisableCount = 0 then
  8963.     begin
  8964.       if FDisableState <> FState then DataEvent(deUpdateState, 0);
  8965.       if (FDisableState <> dsInactive) and (FState <> dsInactive) then
  8966.         DataEvent(FEnableEvent, 0);
  8967.     end;
  8968.   end;
  8969. end;
  8970.  
  8971. procedure TDataSet.UpdateRecord;
  8972. begin
  8973.   if not (State in dsEditModes) then DatabaseError(SNotEditing, Self);
  8974.   DataEvent(deUpdateRecord, 0);
  8975. end;
  8976.  
  8977. { Buffer Management }
  8978.  
  8979. procedure TDataSet.SetBufListSize(Value: Integer);
  8980. var
  8981.   FBufListSize, I: Integer;
  8982.   NewList: TBufferList;
  8983. begin
  8984.   FBufListSize := High(FBuffers) + 1;
  8985.   if FBufListSize <> Value then
  8986.   begin
  8987.     if Value > 0 then
  8988.       SetLength(NewList, Value) else
  8989.       NewList := nil;
  8990.     if FBufListSize > Value then
  8991.     begin
  8992.       { Shrinking the list }
  8993.       if Value <> 0 then
  8994.         Move(Pointer(FBuffers)^, Pointer(NewList)^, Value * SizeOf(PChar));
  8995.       { Free the buffers we no longer need }
  8996.       for I := Value to FBufListSize - 1 do
  8997.         FreeRecordBuffer(FBuffers[I]);
  8998.     end else
  8999.     begin
  9000.       { Growing the list }
  9001.       if FBufListSize <> 0 then
  9002.         Move(Pointer(FBuffers)^, Pointer(NewList)^, FBufListSize * SizeOf(PChar));
  9003.       I := FBufListSize;
  9004.       try
  9005.         while I < Value do
  9006.         begin
  9007.           NewList[I] := AllocRecordBuffer;
  9008.           Inc(I);
  9009.         end;
  9010.       except
  9011.         while I > FBufListSize do
  9012.         begin
  9013.           FreeRecordBuffer(NewList[I]);
  9014.           Dec(I);
  9015.         end;
  9016.         raise;
  9017.       end;
  9018.     end;
  9019.     FBuffers := NewList;
  9020.   end;
  9021. end;
  9022.  
  9023. procedure TDataSet.SetBufferCount(Value: Integer);
  9024. var
  9025.   I, Delta: Integer;
  9026.   DataLink: TDataLink;
  9027.  
  9028.   procedure AdjustFirstRecord(Delta: Integer);
  9029.   var
  9030.     DataLink: TDataLink;
  9031.   begin
  9032.     if Delta <> 0 then
  9033.     begin
  9034.       DataLink := FFirstDataLink;
  9035.       while DataLink <> nil do
  9036.       begin
  9037.         if DataLink.Active then Inc(DataLink.FFirstRecord, Delta);
  9038.         DataLink := DataLink.FNext;
  9039.       end;
  9040.     end;
  9041.   end;
  9042.  
  9043. begin
  9044.   if FBufferCount <> Value then
  9045.   begin
  9046.     if (FBufferCount > Value) and (FRecordCount > 0) then
  9047.     begin
  9048.       Delta := FActiveRecord;
  9049.       DataLink := FFirstDataLink;
  9050.       while DataLink <> nil do
  9051.       begin
  9052.         if DataLink.Active and (DataLink.FFirstRecord < Delta) then
  9053.           Delta := DataLink.FFirstRecord;
  9054.         DataLink := DataLink.FNext;
  9055.       end;
  9056.       for I := 0 to Value - 1 do MoveBuffer(I + Delta, I);
  9057.       Dec(FActiveRecord, Delta);
  9058.       if FCurrentRecord <> -1 then Dec(FCurrentRecord, Delta);
  9059.       if FRecordCount > Value then FRecordCount := Value;
  9060.       AdjustFirstRecord(-Delta);
  9061.     end;
  9062.     SetBufListSize(Value + 1);
  9063.     FBufferCount := Value;
  9064.     if not (csDestroying in ComponentState) then
  9065.     begin
  9066.       GetNextRecords;
  9067.       AdjustFirstRecord(GetPriorRecords);
  9068.     end;
  9069.   end;
  9070. end;
  9071.  
  9072. procedure TDataSet.UpdateBufferCount;
  9073. var
  9074.   I, J, MaxBufferCount: Integer;
  9075.   DataLink: TDataLink;
  9076. begin
  9077.   if IsCursorOpen then
  9078.   begin
  9079.     MaxBufferCount := 1;
  9080.     FFirstDataLink := nil;
  9081.     for I := FDataSources.Count - 1 downto 0 do
  9082.       with TDataSource(FDataSources[I]) do
  9083.         for J := FDataLinks.Count - 1 downto 0 do
  9084.         begin
  9085.           DataLink := FDataLinks[J];
  9086.           DataLink.FNext := FFirstDataLink;
  9087.           FFirstDataLink := DataLink;
  9088.           if DataLink.FBufferCount > MaxBufferCount then
  9089.             MaxBufferCount := DataLink.FBufferCount;
  9090.         end;
  9091.     SetBufferCount(MaxBufferCount);
  9092.   end;
  9093. end;
  9094.  
  9095. procedure TDataSet.SetCurrentRecord(Index: Integer);
  9096. var
  9097.   Buffer: PChar;
  9098. begin
  9099.   if (FCurrentRecord <> Index) or (FDataSetField <> nil) then
  9100.   begin
  9101.     if DataSetField <> nil then
  9102.       DataSetField.DataSet.UpdateCursorPos;
  9103.     Buffer := FBuffers[Index];
  9104.     case GetBookmarkFlag(Buffer) of
  9105.       bfCurrent,
  9106.       bfInserted: InternalSetToRecord(Buffer);
  9107.       bfBOF: InternalFirst;
  9108.       bfEOF: InternalLast;
  9109.     end;
  9110.     FCurrentRecord := Index;
  9111.   end;
  9112. end;
  9113.  
  9114. function TDataSet.GetBuffer(Index: Integer): PChar;
  9115. begin
  9116.   Result := FBuffers[Index];
  9117. end;
  9118.  
  9119. function TDataSet.GetNextRecord: Boolean;
  9120. var
  9121.   GetMode: TGetMode;
  9122. begin
  9123.   GetMode := gmNext;
  9124.   if FRecordCount > 0 then
  9125.   begin
  9126.     SetCurrentRecord(FRecordCount - 1);
  9127.     if (State = dsInsert) and (FCurrentRecord = FActiveRecord) and
  9128.       (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then GetMode := gmCurrent;
  9129.   end;
  9130.   Result := (GetRecord(FBuffers[FRecordCount], GetMode, True) = grOK);
  9131.   if Result then
  9132.   begin
  9133.     if FRecordCount = 0 then
  9134.       ActivateBuffers
  9135.     else
  9136.       if FRecordCount < FBufferCount then
  9137.         Inc(FRecordCount) else
  9138.         MoveBuffer(0, FRecordCount);
  9139.     FCurrentRecord := FRecordCount - 1;
  9140.     Result := True;
  9141.   end else
  9142.     CursorPosChanged;
  9143. end;
  9144.  
  9145. function TDataSet.GetPriorRecord: Boolean;
  9146. begin
  9147.   if FRecordCount > 0 then SetCurrentRecord(0);
  9148.   Result := (GetRecord(FBuffers[FRecordCount], gmPrior, True) = grOK);
  9149.   if Result then
  9150.   begin
  9151.     if FRecordCount = 0 then
  9152.       ActivateBuffers else
  9153.     begin
  9154.       MoveBuffer(FRecordCount, 0);
  9155.       if FRecordCount < FBufferCount then
  9156.       begin
  9157.         Inc(FRecordCount);
  9158.         Inc(FActiveRecord);
  9159.       end;
  9160.     end;
  9161.     FCurrentRecord := 0;
  9162.   end else
  9163.     CursorPosChanged;
  9164. end;
  9165.  
  9166. procedure TDataSet.Resync(Mode: TResyncMode);
  9167. var
  9168.   Count: Integer;
  9169. begin
  9170.   if rmExact in Mode then
  9171.   begin
  9172.     CursorPosChanged;
  9173.     if GetRecord(FBuffers[FRecordCount], gmCurrent, True) <> grOK then
  9174.       DatabaseError(SRecordNotFound, Self);
  9175.   end else
  9176.     if (GetRecord(FBuffers[FRecordCount], gmCurrent, False) <> grOK) and
  9177.       (GetRecord(FBuffers[FRecordCount], gmNext, False) <> grOK) and
  9178.       (GetRecord(FBuffers[FRecordCount], gmPrior, False) <> grOK) then
  9179.     begin
  9180.       ClearBuffers;
  9181.       DataEvent(deDataSetChange, 0);
  9182.       Exit;
  9183.     end;
  9184.   if rmCenter in Mode then
  9185.     Count := (FBufferCount - 1) div 2 else
  9186.     Count := FActiveRecord;
  9187.   MoveBuffer(FRecordCount, 0);
  9188.   ActivateBuffers;
  9189.   try
  9190.     while (Count > 0) and GetPriorRecord do Dec(Count);
  9191.     GetNextRecords;
  9192.     GetPriorRecords;
  9193.   finally
  9194.     DataEvent(deDataSetChange, 0);
  9195.   end;
  9196. end;
  9197.  
  9198. procedure TDataSet.MoveBuffer(CurIndex, NewIndex: Integer);
  9199. var
  9200.   Buffer: PChar;
  9201. begin
  9202.   if CurIndex <> NewIndex then
  9203.   begin
  9204.     Buffer := FBuffers[CurIndex];
  9205.     if CurIndex < NewIndex then
  9206.       Move(FBuffers[CurIndex + 1], FBuffers[CurIndex],
  9207.         (NewIndex - CurIndex) * SizeOf(Pointer))
  9208.     else
  9209.       Move(FBuffers[NewIndex], FBuffers[NewIndex + 1],
  9210.         (CurIndex - NewIndex) * SizeOf(Pointer));
  9211.     FBuffers[NewIndex] := Buffer;
  9212.   end;
  9213. end;
  9214.  
  9215. function TDataSet.ActiveBuffer: PChar;
  9216. begin
  9217.   Result := FBuffers[FActiveRecord];
  9218. end;
  9219.  
  9220. function TDataSet.TempBuffer: PChar;
  9221. begin
  9222.   Result := FBuffers[FRecordCount];
  9223. end;
  9224.  
  9225. procedure TDataSet.ClearBuffers;
  9226. begin
  9227.   FRecordCount := 0;
  9228.   FActiveRecord := 0;
  9229.   FCurrentRecord := -1;
  9230.   FBOF := True;
  9231.   FEOF := True;
  9232. end;
  9233.  
  9234. procedure TDataSet.ActivateBuffers;
  9235. begin
  9236.   FRecordCount := 1;
  9237.   FActiveRecord := 0;
  9238.   FCurrentRecord := 0;
  9239.   FBOF := False;
  9240.   FEOF := False;
  9241. end;
  9242.  
  9243. procedure TDataSet.UpdateCursorPos;
  9244. begin
  9245.   if FRecordCount > 0 then SetCurrentRecord(FActiveRecord);
  9246. end;
  9247.  
  9248. procedure TDataSet.CursorPosChanged;
  9249. begin
  9250.   FCurrentRecord := -1;
  9251. end;
  9252.  
  9253. function TDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
  9254. begin
  9255.   Result := False;
  9256. end;
  9257.  
  9258. function TDataSet.GetNextRecords: Integer;
  9259. begin
  9260.   Result := 0;
  9261.   while (FRecordCount < FBufferCount) and GetNextRecord do Inc(Result);
  9262. end;
  9263.  
  9264. function TDataSet.GetPriorRecords: Integer;
  9265. begin
  9266.   Result := 0;
  9267.   while (FRecordCount < FBufferCount) and GetPriorRecord do Inc(Result);
  9268. end;
  9269.  
  9270. procedure TDataSet.InitRecord(Buffer: PChar);
  9271. begin
  9272.   InternalInitRecord(Buffer);
  9273.   ClearCalcFields(Buffer);
  9274.   SetBookmarkFlag(Buffer, bfInserted);
  9275. end;
  9276.  
  9277. function TDataSet.IsEmpty: Boolean;
  9278. begin
  9279.   Result := FActiveRecord >= FRecordCount;
  9280. end;
  9281.  
  9282. procedure TDataSet.GetCalcFields(Buffer: PChar);
  9283. var
  9284.   SaveState: TDataSetState;
  9285. begin
  9286.   if (FCalcFieldsSize > 0) or FInternalCalcFields then
  9287.   begin
  9288.     SaveState := FState;
  9289.     FState := dsCalcFields;
  9290.     try
  9291.       CalculateFields(Buffer);
  9292.     finally
  9293.       FState := SaveState;
  9294.     end;
  9295.   end;
  9296. end;
  9297.  
  9298. procedure TDataSet.CalculateFields(Buffer: PChar);
  9299. var
  9300.   I: Integer;
  9301. begin
  9302.   FCalcBuffer := Buffer;
  9303.   if State <> dsInternalCalc then
  9304.   begin
  9305.     ClearCalcFields(CalcBuffer);
  9306.     for I := 0 to FFields.Count - 1 do
  9307.       with FFields[I] do
  9308.         if FieldKind = fkLookup then CalcLookupValue;
  9309.   end;
  9310.   DoOnCalcFields;
  9311. end;
  9312.  
  9313. procedure TDataSet.ClearCalcFields(Buffer: PChar);
  9314. begin
  9315. end;
  9316.  
  9317. procedure TDataSet.RefreshInternalCalcFields(Buffer: PChar);
  9318. var
  9319.   I: Integer;
  9320. begin
  9321.   for I := 0 to FieldCount - 1 do
  9322.     with Fields[I] do
  9323.       if (FieldKind = fkInternalCalc) then Value := Value;
  9324. end;
  9325.  
  9326. { Navigation }
  9327.  
  9328. procedure TDataSet.First;
  9329. begin
  9330.   CheckBrowseMode;
  9331.   DoBeforeScroll;
  9332.   ClearBuffers;
  9333.   try
  9334.     InternalFirst;
  9335.     GetNextRecord;
  9336.     GetNextRecords;
  9337.   finally
  9338.     FBOF := True;
  9339.     DataEvent(deDataSetChange, 0);
  9340.     DoAfterScroll;
  9341.   end;
  9342. end;
  9343.  
  9344. procedure TDataSet.Last;
  9345. begin
  9346.   CheckBrowseMode;
  9347.   DoBeforeScroll;
  9348.   ClearBuffers;
  9349.   try
  9350.     InternalLast;
  9351.     GetPriorRecord;
  9352.     GetPriorRecords;
  9353.   finally
  9354.     FEOF := True;
  9355.     DataEvent(deDataSetChange, 0);
  9356.     DoAfterScroll;
  9357.   end;
  9358. end;
  9359.  
  9360. function TDataSet.MoveBy(Distance: Integer): Integer;
  9361. var
  9362.   OldRecordCount, ScrollCount, I: Integer;
  9363. begin
  9364.   CheckBrowseMode;
  9365.   Result := 0;
  9366.   DoBeforeScroll;
  9367.   if ((Distance > 0) and not FEOF) or ((Distance < 0) and not FBOF) then
  9368.   begin
  9369.     FBOF := False;
  9370.     FEOF := False;
  9371.     OldRecordCount := FRecordCount;
  9372.     ScrollCount := 0;
  9373.     try
  9374.       while Distance > 0 do
  9375.       begin
  9376.         if FActiveRecord < FRecordCount - 1 then Inc(FActiveRecord) else
  9377.         begin
  9378.           if FRecordCount < FBufferCount then I := 0 else I := 1;
  9379.           if GetNextRecord then
  9380.           begin
  9381.             Dec(ScrollCount, I);
  9382.             if FActiveRecord < FRecordCount - 1 then Inc(FActiveRecord);
  9383.           end else
  9384.           begin
  9385.             FEOF := True;
  9386.             Break;
  9387.           end;
  9388.         end;
  9389.         Dec(Distance);
  9390.         Inc(Result);
  9391.       end;
  9392.       while Distance < 0 do
  9393.       begin
  9394.         if FActiveRecord > 0 then Dec(FActiveRecord) else
  9395.         begin
  9396.           if FRecordCount < FBufferCount then I := 0 else I := 1;
  9397.           if GetPriorRecord then
  9398.           begin
  9399.             Inc(ScrollCount, I);
  9400.             if FActiveRecord > 0 then Dec(FActiveRecord);
  9401.           end else
  9402.           begin
  9403.             FBOF := True;
  9404.             Break;
  9405.           end;
  9406.         end;
  9407.         Inc(Distance);
  9408.         Dec(Result);
  9409.       end;
  9410.     finally
  9411.       if FRecordCount <> OldRecordCount then
  9412.         DataEvent(deDataSetChange, 0) else
  9413.         DataEvent(deDataSetScroll, ScrollCount);
  9414.       DoAfterScroll;
  9415.     end;
  9416.   end;
  9417. end;
  9418.  
  9419. procedure TDataSet.Next;
  9420. begin
  9421.   if BlockReadSize > 0 then
  9422.     BlockReadNext else
  9423.     MoveBy(1);
  9424. end;
  9425.  
  9426. procedure TDataSet.BlockReadNext;
  9427. begin
  9428.   MoveBy(1);
  9429. end;
  9430.  
  9431. procedure TDataSet.Prior;
  9432. begin
  9433.   MoveBy(-1);
  9434. end;
  9435.  
  9436. procedure TDataSet.Refresh;
  9437. begin
  9438.   DoBeforeRefresh;
  9439.   CheckBrowseMode;
  9440.   UpdateCursorPos;
  9441.   InternalRefresh;
  9442.   Resync([]);
  9443.   DoAfterRefresh;
  9444. end;
  9445.  
  9446. procedure TDataSet.SetBlockReadSize(Value: Integer);
  9447. begin
  9448.   if Value > 0 then
  9449.   begin
  9450.     CheckActive;
  9451.     SetState(dsBlockRead);
  9452.   end else
  9453.     if State = dsBlockRead then SetState(dsBrowse);
  9454.   FBlockReadSize := Value;
  9455. end;
  9456.  
  9457. { Editing }
  9458.  
  9459. procedure TDataSet.CheckParentState;
  9460. begin
  9461.   if DataSetField <> nil then
  9462.     DataSetField.DataSet.Edit;
  9463. end;
  9464.  
  9465. procedure TDataSet.Edit;
  9466. begin
  9467.   if not (State in [dsEdit, dsInsert]) then
  9468.     if FRecordCount = 0 then Insert else
  9469.     begin
  9470.       CheckBrowseMode;
  9471.       CheckCanModify;
  9472.       DoBeforeEdit;
  9473.       CheckParentState;
  9474.       CheckOperation(InternalEdit, FOnEditError);
  9475.       GetCalcFields(ActiveBuffer);
  9476.       SetState(dsEdit);
  9477.       DataEvent(deRecordChange, 0);
  9478.       DoAfterEdit;
  9479.     end;
  9480. end;
  9481.  
  9482. procedure TDataSet.Insert;
  9483. var
  9484.   Buffer: PChar;
  9485.   OldCurrent: TBookmarkStr;
  9486. begin
  9487.   BeginInsertAppend;
  9488.   OldCurrent := Bookmark;
  9489.   MoveBuffer(FRecordCount, FActiveRecord);
  9490.   Buffer := ActiveBuffer;
  9491.   InitRecord(Buffer);
  9492.   if FRecordCount = 0 then
  9493.     SetBookmarkFlag(Buffer, bfBOF) else
  9494.     SetBookmarkData(Buffer, Pointer(OldCurrent));
  9495.   if FRecordCount < FBufferCount then Inc(FRecordCount);
  9496.   InternalInsert;
  9497.   EndInsertAppend;
  9498. end;
  9499.  
  9500. procedure TDataSet.Append;
  9501. var
  9502.   Buffer: PChar;
  9503. begin
  9504.   BeginInsertAppend;
  9505.   ClearBuffers;
  9506.   Buffer := FBuffers[0];
  9507.   InitRecord(Buffer);
  9508.   SetBookmarkFlag(Buffer, bfEOF);
  9509.   FRecordCount := 1;
  9510.   FBOF := False;
  9511.   GetPriorRecords;
  9512.   InternalInsert;
  9513.   EndInsertAppend;
  9514. end;
  9515.  
  9516. procedure TDataSet.Post;
  9517. begin
  9518.   UpdateRecord;
  9519.   case State of
  9520.     dsEdit, dsInsert:
  9521.       begin
  9522.         DataEvent(deCheckBrowseMode, 0);
  9523.         CheckRequiredFields;
  9524.         DoBeforePost;
  9525.         CheckOperation(InternalPost, FOnPostError);
  9526.         FreeFieldBuffers;
  9527.         SetState(dsBrowse);
  9528.         Resync([]);
  9529.         DoAfterPost;
  9530.       end;
  9531.   end;
  9532. end;
  9533.  
  9534. procedure TDataSet.Cancel;
  9535.  
  9536.   procedure CancelNestedDataSets;
  9537.   var
  9538.     I: Integer;
  9539.   begin
  9540.     if Assigned(FNestedDataSets) then
  9541.       for I := 0 to FNestedDataSets.Count - 1 do
  9542.         with TDataSet(FNestedDataSets[I]) do
  9543.           if Active then Cancel;
  9544.   end;
  9545.  
  9546. var
  9547.   DoScrollEvents: Boolean;
  9548. begin
  9549.   case State of
  9550.     dsEdit, dsInsert:
  9551.       begin
  9552.         CancelNestedDataSets;
  9553.         DataEvent(deCheckBrowseMode, 0);
  9554.         DoBeforeCancel;
  9555.         DoScrollEvents := (State = dsInsert);
  9556.         if DoScrollEvents then DoBeforeScroll;
  9557.         UpdateCursorPos;
  9558.         InternalCancel;
  9559.         FreeFieldBuffers;
  9560.         SetState(dsBrowse);
  9561.         Resync([]);
  9562.         DoAfterCancel;
  9563.         if DoScrollEvents then DoAfterScroll;
  9564.       end;
  9565.   end;
  9566. end;
  9567.  
  9568. procedure TDataSet.Delete;
  9569. begin
  9570.   CheckActive;
  9571.   if State in [dsInsert, dsSetKey] then Cancel else
  9572.   begin
  9573.     if FRecordCount = 0 then DatabaseError(SDataSetEmpty, Self);
  9574.     DataEvent(deCheckBrowseMode, 0);
  9575.     DoBeforeDelete;
  9576.     DoBeforeScroll;
  9577.     CheckOperation(InternalDelete, FOnDeleteError);
  9578.     FreeFieldBuffers;
  9579.     SetState(dsBrowse);
  9580.     Resync([]);
  9581.     DoAfterDelete;
  9582.     DoAfterScroll;
  9583.   end;
  9584. end;
  9585.  
  9586. procedure TDataSet.BeginInsertAppend;
  9587. begin
  9588.   CheckBrowseMode;
  9589.   CheckCanModify;
  9590.   DoBeforeInsert;
  9591.   CheckParentState;
  9592.   DoBeforeScroll;
  9593. end;
  9594.  
  9595. procedure TDataSet.EndInsertAppend;
  9596. begin
  9597.   SetState(dsInsert);
  9598.   try
  9599.     DoOnNewRecord;
  9600.   except
  9601.     UpdateCursorPos;
  9602.     FreeFieldBuffers;
  9603.     SetState(dsBrowse);
  9604.     Resync([]);
  9605.     raise;
  9606.   end;
  9607.   FModified := False;
  9608.   DataEvent(deDataSetChange, 0);
  9609.   DoAfterInsert;
  9610.   DoAfterScroll;
  9611. end;
  9612.  
  9613. procedure TDataSet.AddRecord(const Values: array of const; Append: Boolean);
  9614. var
  9615.   Buffer: PChar;
  9616. begin
  9617.   BeginInsertAppend;
  9618.   if not Append then UpdateCursorPos;
  9619.   DisableControls;
  9620.   try
  9621.     MoveBuffer(FRecordCount, FActiveRecord);
  9622.     try
  9623.       Buffer := ActiveBuffer;
  9624.       InitRecord(Buffer);
  9625.       FState := dsInsert;
  9626.       try
  9627.         DoOnNewRecord;
  9628.         DoAfterInsert;
  9629.         SetFields(Values);
  9630.         DoBeforePost;
  9631.         InternalAddRecord(Buffer, Append);
  9632.       finally
  9633.         FreeFieldBuffers;
  9634.         FState := dsBrowse;
  9635.         FModified := False;
  9636.       end;
  9637.     except
  9638.       MoveBuffer(FActiveRecord, FRecordCount);
  9639.       raise;
  9640.     end;
  9641.     Resync([]);
  9642.     DoAfterPost;
  9643.   finally
  9644.     EnableControls;
  9645.   end;
  9646. end;
  9647.  
  9648. procedure TDataSet.InsertRecord(const Values: array of const);
  9649. begin
  9650.   AddRecord(Values, False);
  9651. end;
  9652.  
  9653. procedure TDataSet.AppendRecord(const Values: array of const);
  9654. begin
  9655.   AddRecord(Values, True);
  9656. end;
  9657.  
  9658. procedure TDataSet.CheckOperation(Operation: TDataOperation;
  9659.   ErrorEvent: TDataSetErrorEvent);
  9660. var
  9661.   Done: Boolean;
  9662.   Action: TDataAction;
  9663. begin
  9664.   Done := False;
  9665.   repeat
  9666.     try
  9667.       UpdateCursorPos;
  9668.       Operation;
  9669.       Done := True;
  9670.     except
  9671.       on E: EDatabaseError do
  9672.       begin
  9673.         Action := daFail;
  9674.         if Assigned(ErrorEvent) then ErrorEvent(Self, E, Action);
  9675.         if Action = daFail then raise;
  9676.         if Action = daAbort then SysUtils.Abort;
  9677.       end;
  9678.     end;
  9679.   until Done;
  9680. end;
  9681.  
  9682. procedure TDataSet.SetFields(const Values: array of const);
  9683. var
  9684.   I: Integer;
  9685. begin
  9686.   for I := 0 to High(Values) do Fields[I].AssignValue(Values[I]);
  9687. end;
  9688.  
  9689. procedure TDataSet.ClearFields;
  9690. begin
  9691.   if not (State in dsEditModes) then DatabaseError(SNotEditing, Self);
  9692.   DataEvent(deCheckBrowseMode, 0);
  9693.   FreeFieldBuffers;
  9694.   InternalInitRecord(ActiveBuffer);
  9695.   if State <> dsSetKey then GetCalcFields(ActiveBuffer);
  9696.   DataEvent(deRecordChange, 0);
  9697. end;
  9698.  
  9699. procedure TDataSet.CheckRequiredFields;
  9700. var
  9701.   I: Integer;
  9702. begin
  9703.   for I := 0 to FFields.Count - 1 do
  9704.     with FFields[I] do
  9705.       if Required and not ReadOnly and (FieldKind = fkData) and IsNull then
  9706.       begin
  9707.         FocusControl;
  9708.         DatabaseErrorFmt(SFieldRequired, [DisplayName]);
  9709.       end;
  9710. end;
  9711.  
  9712. { Bookmarks }
  9713.  
  9714. function TDataSet.BookmarkAvailable: Boolean;
  9715. begin
  9716.   Result := (State in [dsBrowse, dsEdit, dsInsert]) and not IsEmpty
  9717.     and (GetBookmarkFlag(ActiveBuffer) = bfCurrent);
  9718. end;
  9719.  
  9720. function TDataSet.GetBookmark: TBookmark;
  9721. begin
  9722.   if BookmarkAvailable then
  9723.   begin
  9724.     GetMem(Result, FBookmarkSize);
  9725.     GetBookmarkData(ActiveBuffer, Result);
  9726.   end else
  9727.     Result := nil;
  9728. end;
  9729.  
  9730. function TDataSet.GetBookmarkStr: TBookmarkStr;
  9731. begin
  9732.   if BookmarkAvailable then
  9733.   begin
  9734.     SetLength(Result, BookmarkSize);
  9735.     GetBookmarkData(ActiveBuffer, Pointer(Result));
  9736.   end else
  9737.     Result := '';
  9738. end;
  9739.  
  9740. procedure TDataSet.GotoBookmark(Bookmark: TBookmark);
  9741. begin
  9742.   if Bookmark <> nil then
  9743.   begin
  9744.     CheckBrowseMode;
  9745.     DoBeforeScroll;
  9746.     InternalGotoBookmark(Bookmark);
  9747.     Resync([rmExact, rmCenter]);
  9748.     DoAfterScroll;
  9749.   end;
  9750. end;
  9751.  
  9752. procedure TDataSet.SetBookmarkStr(const Value: TBookmarkStr);
  9753. begin
  9754.   GotoBookmark(Pointer(Value));
  9755. end;
  9756.  
  9757. function TDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
  9758. begin
  9759.   Result := False;
  9760. end;
  9761.  
  9762. function TDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
  9763. begin
  9764.   Result := 0;
  9765. end;
  9766.  
  9767. procedure TDataSet.FreeBookmark(Bookmark: TBookmark);
  9768. begin
  9769.   FreeMem(Bookmark);
  9770. end;
  9771.  
  9772. procedure TDataSet.InternalCancel;
  9773. begin
  9774. end;
  9775.  
  9776. procedure TDataSet.InternalEdit;
  9777. begin
  9778. end;
  9779.  
  9780. procedure TDataSet.InternalInsert;
  9781. begin
  9782. end;
  9783.  
  9784. procedure TDataSet.InternalRefresh;
  9785. begin
  9786. end;
  9787.  
  9788. function TDataSet.Translate(Src, Dest: PChar; ToOem: Boolean): Integer;
  9789. begin
  9790.   if (Src <> nil) then
  9791.   begin
  9792.     if (Src <> Dest) then
  9793.     StrCopy(Dest, Src);
  9794.     Result := StrLen(Dest);
  9795.   end else
  9796.     Result := 0;
  9797. end;
  9798.  
  9799. { Filter / Locate / Find }
  9800.  
  9801. function TDataSet.FindRecord(Restart, GoForward: Boolean): Boolean;
  9802. begin
  9803.   Result := False;
  9804. end;
  9805.  
  9806. function TDataSet.FindFirst: Boolean;
  9807. begin
  9808.   Result := FindRecord(True, True);
  9809. end;
  9810.  
  9811. function TDataSet.FindLast: Boolean;
  9812. begin
  9813.   Result := FindRecord(True, False);
  9814. end;
  9815.  
  9816. function TDataSet.FindNext: Boolean;
  9817. begin
  9818.   Result := FindRecord(False, True);
  9819. end;
  9820.  
  9821. function TDataSet.FindPrior: Boolean;
  9822. begin
  9823.   Result := FindRecord(False, False);
  9824. end;
  9825.  
  9826. procedure TDataSet.SetFiltered(Value: Boolean);
  9827. begin
  9828.   FFiltered := Value;
  9829. end;
  9830.  
  9831. procedure TDataSet.SetFilterOptions(Value: TFilterOptions);
  9832. begin
  9833.   FFilterOptions := Value;
  9834. end;
  9835.  
  9836. procedure TDataSet.SetFilterText(const Value: string);
  9837. begin
  9838.   FFilterText := Value;
  9839. end;
  9840.  
  9841. procedure TDataSet.SetOnFilterRecord(const Value: TFilterRecordEvent);
  9842. begin
  9843.   FOnFilterRecord := Value;
  9844. end;
  9845.  
  9846. function TDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
  9847.   Options: TLocateOptions): Boolean;
  9848. begin
  9849.   Result := False;
  9850. end;
  9851.  
  9852. function TDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
  9853.   const ResultFields: string): Variant;
  9854. begin
  9855.   Result := False;
  9856. end;
  9857.  
  9858. { Aggregates }
  9859.  
  9860. function TDataSet.GetAggregateValue(Field: TField): Variant;
  9861. begin
  9862.   Result := NULL;
  9863. end;
  9864.  
  9865. function TDataSet.GetAggRecordCount(Grp: TGroupPosInd): Integer;
  9866. begin
  9867.   Result := 0;
  9868. end;
  9869.  
  9870. procedure TDataSet.ResetAggField(Field: TField);
  9871. begin
  9872. end;
  9873.  
  9874. { Informational }
  9875.  
  9876. procedure TDataSet.CheckBrowseMode;
  9877. begin
  9878.   CheckActive;
  9879.   DataEvent(deCheckBrowseMode, 0);
  9880.   case State of
  9881.     dsEdit, dsInsert:
  9882.       begin
  9883.         UpdateRecord;
  9884.         if Modified then Post else Cancel;
  9885.       end;
  9886.     dsSetKey:
  9887.       Post;
  9888.   end;
  9889. end;
  9890.  
  9891. function TDataSet.GetCanModify: Boolean;
  9892. begin
  9893.   Result := True;
  9894. end;
  9895.  
  9896. procedure TDataSet.CheckCanModify;
  9897. begin
  9898.   if not CanModify then DatabaseError(SDataSetReadOnly, Self);
  9899. end;
  9900.  
  9901. procedure TDataSet.GetFieldList(List: TList; const FieldNames: string);
  9902. var
  9903.   Pos: Integer;
  9904.   Field: TField;
  9905. begin
  9906.   Pos := 1;
  9907.   while Pos <= Length(FieldNames) do
  9908.   begin
  9909.     Field := FieldByName(ExtractFieldName(FieldNames, Pos));
  9910.     if Assigned(List) then List.Add(Field);
  9911.   end;
  9912. end;
  9913.  
  9914. function TDataSet.GetRecordCount: Longint;
  9915. begin
  9916.   Result := -1;
  9917. end;
  9918.  
  9919. function TDataSet.GetRecNo: Integer;
  9920. begin
  9921.   Result := -1;
  9922. end;
  9923.  
  9924. procedure TDataSet.SetRecNo(Value: Integer);
  9925. begin
  9926. end;
  9927.  
  9928. function TDataSet.IsSequenced: Boolean;
  9929. begin
  9930.   Result := True;
  9931. end;
  9932.  
  9933. function TDataSet.UpdateStatus: TUpdateStatus;
  9934. begin
  9935.   Result := usUnmodified;
  9936. end;
  9937.  
  9938. { Event Handler Helpers }
  9939.  
  9940. procedure TDataSet.DoAfterCancel;
  9941. begin
  9942.   if Assigned(FAfterCancel) then FAfterCancel(Self);
  9943. end;
  9944.  
  9945. procedure TDataSet.DoAfterClose;
  9946. begin
  9947.   if Assigned(FAfterClose) then FAfterClose(Self);
  9948. end;
  9949.  
  9950. procedure TDataSet.DoAfterDelete;
  9951. begin
  9952.   if Assigned(FAfterDelete) then FAfterDelete(Self);
  9953. end;
  9954.  
  9955. procedure TDataSet.DoAfterEdit;
  9956. begin
  9957.   if Assigned(FAfterEdit) then FAfterEdit(Self);
  9958. end;
  9959.  
  9960. procedure TDataSet.DoAfterInsert;
  9961. begin
  9962.   if Assigned(FAfterInsert) then FAfterInsert(Self);
  9963. end;
  9964.  
  9965. procedure TDataSet.DoAfterOpen;
  9966. begin
  9967.   if Assigned(FAfterOpen) then FAfterOpen(Self);
  9968.   if not IsEmpty then DoAfterScroll;
  9969. end;
  9970.  
  9971. procedure TDataSet.DoAfterPost;
  9972. begin
  9973.   if Assigned(FAfterPost) then FAfterPost(Self);
  9974. end;
  9975.  
  9976. procedure TDataSet.DoAfterRefresh;
  9977. begin
  9978.   if Assigned(FAfterRefresh) then FAfterRefresh(Self);
  9979. end;
  9980.  
  9981. procedure TDataSet.DoAfterScroll;
  9982. begin
  9983.   if Assigned(FAfterScroll) then FAfterScroll(Self);
  9984. end;
  9985.  
  9986. procedure TDataSet.DoBeforeCancel;
  9987. begin
  9988.   if Assigned(FBeforeCancel) then FBeforeCancel(Self);
  9989. end;
  9990.  
  9991. procedure TDataSet.DoBeforeClose;
  9992. begin
  9993.   if Assigned(FBeforeClose) then FBeforeClose(Self);
  9994. end;
  9995.  
  9996. procedure TDataSet.DoBeforeDelete;
  9997. begin
  9998.   if Assigned(FBeforeDelete) then FBeforeDelete(Self);
  9999. end;
  10000.  
  10001. procedure TDataSet.DoBeforeEdit;
  10002. begin
  10003.   if Assigned(FBeforeEdit) then FBeforeEdit(Self);
  10004. end;
  10005.  
  10006. procedure TDataSet.DoBeforeInsert;
  10007. begin
  10008.   if Assigned(FBeforeInsert) then FBeforeInsert(Self);
  10009. end;
  10010.  
  10011. procedure TDataSet.DoBeforeOpen;
  10012. begin
  10013.   if Assigned(FBeforeOpen) then FBeforeOpen(Self);
  10014. end;
  10015.  
  10016. procedure TDataSet.DoBeforePost;
  10017. begin
  10018.   if Assigned(FBeforePost) then FBeforePost(Self);
  10019. end;
  10020.  
  10021. procedure TDataSet.DoBeforeRefresh;
  10022. begin
  10023.   if Assigned(FBeforeRefresh) then FBeforeRefresh(Self);
  10024. end;
  10025.  
  10026. procedure TDataSet.DoBeforeScroll;
  10027. begin
  10028.   if Assigned(FBeforeScroll) then FBeforeScroll(Self);
  10029. end;
  10030.  
  10031. procedure TDataSet.DoOnCalcFields;
  10032. begin
  10033.   if Assigned(FOnCalcFields) then FOnCalcFields(Self);
  10034. end;
  10035.  
  10036. procedure TDataSet.DoOnNewRecord;
  10037. begin
  10038.   if Assigned(FOnNewRecord) then FOnNewRecord(Self);
  10039. end;
  10040.  
  10041. { IProviderSupport implementation }
  10042.  
  10043. procedure TDataSet.PSEndTransaction(Commit: Boolean);
  10044. begin
  10045. end;
  10046.  
  10047. procedure TDataSet.PSExecute;
  10048. begin
  10049.   DatabaseError(SProviderExecuteNotSupported, Self);
  10050. end;
  10051.  
  10052. function TDataSet.PSExecuteStatement(const ASQL: string; AParams: TParams;
  10053.   ResultSet: Pointer = nil): Integer;
  10054. begin
  10055.   Result := 0;
  10056.   DatabaseError(SProviderSQLNotSupported, Self);
  10057. end;
  10058.  
  10059. procedure TDataSet.PSGetAttributes(List: TList);
  10060. begin
  10061. end;
  10062.  
  10063. function TDataSet.PSGetDefaultOrder: TIndexDef;
  10064. begin
  10065.   Result := nil;
  10066. end;
  10067.  
  10068. function TDataSet.PSGetKeyFields: string;
  10069. var
  10070.   i: integer;
  10071. begin
  10072.   for i := 0 to Fields.Count - 1 do
  10073.     if pfInKey in Fields[i].ProviderFlags then
  10074.     begin
  10075.       if Result <> '' then
  10076.         Result := Result + ';';
  10077.       Result := Result + Fields[i].FieldName;
  10078.     end;
  10079. end;
  10080.  
  10081. function TDataSet.PSGetParams: TParams;
  10082. begin
  10083.   Result := nil;
  10084. end;
  10085.  
  10086. function TDataSet.PSGetQuoteChar: string;
  10087. begin
  10088.   Result := '';
  10089. end;
  10090.  
  10091. function TDataSet.PSGetTableName: string;
  10092. begin
  10093.   Result := '';
  10094. end;
  10095.  
  10096. function TDataSet.GetIndexDefs(IndexDefs: TIndexDefs;
  10097.   IndexTypes: TIndexOptions): TIndexDefs;
  10098. var
  10099.   i: Integer;
  10100. begin
  10101.   Result := nil;
  10102.   try
  10103.     IndexDefs.Update;
  10104.     if IndexDefs.Count = 0 then Exit;
  10105.     Result := TIndexDefs.Create(nil);
  10106.     Result.Assign(IndexDefs);
  10107.     for i := Result.Count - 1 downto 0 do
  10108.       if (Result[i].Options * IndexTypes) = [] then
  10109.         Result[i].Free else
  10110.       try
  10111.         GetFieldList(nil, Result[i].Fields);
  10112.       except
  10113.         Result[i].Free;
  10114.       end;
  10115.   except
  10116.     if Assigned(Result) then
  10117.       Result.Clear;
  10118.   end;
  10119.   if Result.Count = 0 then
  10120.   begin
  10121.     Result.Free;
  10122.     Result := nil;
  10123.   end;
  10124. end;
  10125.  
  10126. function TDataSet.PSGetIndexDefs(IndexTypes: TIndexOptions): TIndexDefs;
  10127. begin
  10128.   Result := nil;
  10129. end;
  10130.  
  10131. function TDataSet.PSGetUpdateException(E: Exception; Prev: EUpdateError): EUpdateError;
  10132. var
  10133.   PrevErr: Integer;
  10134. begin
  10135.   if Prev <> nil then
  10136.     PrevErr := Prev.ErrorCode else
  10137.     PrevErr := 0;
  10138.   Result := EUpdateError.Create(E.Message, '', 1, PrevErr, E);
  10139. end;
  10140.  
  10141. function TDataSet.PSInTransaction: Boolean;
  10142. begin
  10143.   Result := False;
  10144. end;
  10145.  
  10146. function TDataSet.PSIsSQLBased: Boolean;
  10147. begin
  10148.   Result := False;
  10149. end;
  10150.  
  10151. function TDataSet.PSIsSQLSupported: Boolean;
  10152. begin
  10153.   Result := False;
  10154. end;
  10155.  
  10156. procedure TDataSet.PSReset;
  10157. begin
  10158. end;
  10159.  
  10160. procedure TDataSet.PSSetCommandText(const CommandText: string);
  10161. begin
  10162. end;
  10163.  
  10164. procedure TDataSet.PSSetParams(AParams: TParams);
  10165. begin
  10166. end;
  10167.  
  10168. procedure TDataSet.PSStartTransaction;
  10169. begin
  10170. end;
  10171.  
  10172. function TDataSet.PSUpdateRecord(UpdateKind: TUpdateKind; Delta: TDataSet): Boolean;
  10173. begin
  10174.   Result := False;
  10175. end;
  10176.  
  10177. end.
  10178.