home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / SOURCE / VCL / DB.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-03  |  147.7 KB  |  5,767 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       Core Database                                   }
  6. {                                                       }
  7. {       Copyright (c) 1995,97 Borland International     }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit Db;
  12.  
  13. {$R-}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Classes, Graphics;
  18.  
  19. const
  20.  
  21. { TDataSet maximum number of record buffers }
  22.  
  23.   dsMaxBufferCount = MAXINT div 8;
  24.  
  25. { Maximum string field size }
  26.  
  27.   dsMaxStringSize = 8192;
  28.  
  29. type
  30.  
  31. { Misc Dataset types }
  32.  
  33.   TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
  34.     dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue);
  35.  
  36.   TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
  37.     deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
  38.     deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);
  39.  
  40.   TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
  41.  
  42. { Forward declarations }
  43.  
  44.   TFieldDef = class;
  45.   TFieldDefs = class;
  46.   TField = class;
  47.   TDataLink = class;
  48.   TDataSource = class;
  49.   TDataSet = class;
  50.  
  51. { Exception classes }
  52.  
  53.   EDatabaseError = class(Exception);
  54.  
  55. { TFieldDef }
  56.  
  57.   TFieldClass = class of TField;
  58.  
  59.   TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  60.     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  61.     ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
  62.     ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);
  63.  
  64.   TFieldDef = class
  65.   private
  66.     FOwner: TFieldDefs;
  67.     FName: string;
  68.     FFieldNo: Integer;
  69.     FDataType: TFieldType;
  70.     FPrecision: Integer;
  71.     FSize: Word;
  72.     FRequired: Boolean;
  73.     FInternalCalcField: Boolean;
  74.     function GetFieldClass: TFieldClass;
  75.   public
  76.     constructor Create(Owner: TFieldDefs; const Name: string;
  77.       DataType: TFieldType; Size: Word; Required: Boolean; FieldNo: Integer);
  78.     destructor Destroy; override;
  79.     function CreateField(Owner: TComponent): TField;
  80.     property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
  81.     property DataType: TFieldType read FDataType;
  82.     property FieldClass: TFieldClass read GetFieldClass;
  83.     property FieldNo: Integer read FFieldNo;
  84.     property Name: string read FName;
  85.     property Precision: Integer read FPrecision write FPrecision; 
  86.     property Required: Boolean read FRequired;
  87.     property Size: Word read FSize;
  88.   end;
  89.  
  90. { TFieldDefs }
  91.  
  92.   TFieldDefs = class
  93.   private
  94.     FDataSet: TDataSet;
  95.     FItems: TList;
  96.     FUpdated: Boolean;
  97.     function GetCount: Integer;
  98.     function GetItem(Index: Integer): TFieldDef;
  99.   public
  100.     constructor Create(DataSet: TDataSet);
  101.     destructor Destroy; override;
  102.     procedure Add(const Name: string; DataType: TFieldType; Size: Word;
  103.       Required: Boolean);
  104.     procedure Assign(FieldDefs: TFieldDefs);
  105.     procedure Clear;
  106.     function Find(const Name: string): TFieldDef;
  107.     function IndexOf(const Name: string): Integer;
  108.     procedure Update;
  109.     property Count: Integer read GetCount;
  110.     property Items[Index: Integer]: TFieldDef read GetItem; default;
  111.   end;
  112.  
  113. { TField }
  114.  
  115.   TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
  116.  
  117.   TFieldNotifyEvent = procedure(Sender: TField) of object;
  118.   TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
  119.     DisplayText: Boolean) of object;
  120.   TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  121.   TFieldRef = ^TField;
  122.   TFieldChars = set of Char;
  123.  
  124.   PLookupListEntry = ^TLookupListEntry;
  125.   TLookupListEntry = record
  126.     Key: Variant;
  127.     Value: Variant;
  128.   end;
  129.  
  130.   TLookupList = class(TObject)
  131.   private
  132.     FList: TList;
  133.   public
  134.     constructor Create;
  135.     destructor Destroy; override;
  136.     procedure Add(const AKey, AValue: Variant);
  137.     procedure Clear;
  138.     function ValueOfKey(const AKey: Variant): Variant;
  139.   end;
  140.  
  141.   TField = class(TComponent)
  142.   private
  143.     FDataSet: TDataSet;
  144.     FFieldName: string;
  145.     FDataType: TFieldType;
  146.     FReadOnly: Boolean;
  147.     FFieldKind: TFieldKind;
  148.     FAlignment: TAlignment;
  149.     FVisible: Boolean;
  150.     FRequired: Boolean;
  151.     FValidating: Boolean;
  152.     FSize: Word;
  153.     FOffset: Word;
  154.     FFieldNo: Integer;
  155.     FDisplayWidth: Integer;
  156.     FDisplayLabel: string;
  157.     FEditMask: string;
  158.     FValueBuffer: Pointer;
  159.     FLookupDataSet: TDataSet;
  160.     FKeyFields: string;
  161.     FLookupKeyFields: string;
  162.     FLookupResultField: string;
  163.     FLookupCache: Boolean;
  164.     FLookupList: TLookupList;
  165.     FAttributeSet: string;
  166.     FCustomConstraint: string;
  167.     FImportedConstraint: string;
  168.     FConstraintErrorMessage: string;
  169.     FDefaultExpression: string;
  170.     FOrigin: string;
  171.     FValidChars: TFieldChars;
  172.     FOnChange: TFieldNotifyEvent;
  173.     FOnValidate: TFieldNotifyEvent;
  174.     FOnGetText: TFieldGetTextEvent;
  175.     FOnSetText: TFieldSetTextEvent;
  176.     procedure Bind(Binding: Boolean);
  177.     procedure CalcLookupValue;
  178.     function FieldKindStored: Boolean;
  179.     function GetCalculated: Boolean;
  180.     function GetDisplayLabel: string;
  181.     function GetDisplayName: string;
  182.     function GetDisplayText: string;
  183.     function GetDisplayWidth: Integer;
  184.     function GetEditText: string;
  185.     function GetHasConstraints: Boolean;
  186.     function GetIndex: Integer;
  187.     function GetIsIndexField: Boolean;
  188.     function GetLookup: Boolean;
  189.     function GetLookupList: TLookupList;
  190.     function GetCurValue: Variant;
  191.     function GetNewValue: Variant;
  192.     function GetOldValue: Variant;
  193.     function IsDisplayLabelStored: Boolean;
  194.     function IsDisplayWidthStored: Boolean;
  195.     procedure ReadAttributeSet(Reader: TReader);
  196.     procedure ReadCalculated(Reader: TReader);
  197.     procedure ReadLookup(Reader: TReader);
  198.     procedure SetAlignment(Value: TAlignment);
  199.     procedure SetCalculated(Value: Boolean);
  200.     procedure SetDataSet(ADataSet: TDataSet);
  201.     procedure SetDisplayLabel(Value: string);
  202.     procedure SetDisplayWidth(Value: Integer);
  203.     procedure SetEditMask(const Value: string);
  204.     procedure SetEditText(const Value: string);
  205.     procedure SetFieldKind(Value: TFieldKind);
  206.     procedure SetFieldName(const Value: string);
  207.     procedure SetIndex(Value: Integer);
  208.     procedure SetLookup(Value: Boolean);
  209.     procedure SetLookupDataSet(Value: TDataSet);
  210.     procedure SetLookupKeyFields(const Value: string);
  211.     procedure SetLookupResultField(const Value: string);
  212.     procedure SetKeyFields(const Value: string);
  213.     procedure SetLookupCache(const Value: Boolean);
  214.     procedure SetNewValue(const Value: Variant);
  215.     procedure SetReadOnly(const Value: Boolean);
  216.     procedure SetVisible(Value: Boolean);
  217.     procedure ValidateLookupInfo(All: Boolean);
  218.     procedure WriteAttributeSet(Writer: TWriter);
  219.     procedure WriteCalculated(Writer: TWriter);
  220.     procedure WriteLookup(Writer: TWriter);
  221.   protected
  222.     function AccessError(const TypeName: string): EDatabaseError; dynamic;
  223.     procedure CheckInactive;
  224.     class procedure CheckTypeSize(Value: Integer); virtual;
  225.     procedure Change; virtual;
  226.     procedure DataChanged;
  227.     procedure DefineProperties(Filer: TFiler); override;
  228.     procedure FreeBuffers; virtual;
  229.     function GetAsBoolean: Boolean; virtual;
  230.     function GetAsCurrency: Currency; virtual;
  231.     function GetAsDateTime: TDateTime; virtual;
  232.     function GetAsFloat: Double; virtual;
  233.     function GetAsInteger: Longint; virtual;
  234.     function GetAsString: string; virtual;
  235.     function GetAsVariant: Variant; virtual;
  236.     function GetCanModify: Boolean; virtual;
  237.     function GetDataSize: Word; virtual;
  238.     function GetDefaultWidth: Integer; virtual;
  239.     function GetIsNull: Boolean; virtual;
  240.     function GetParentComponent: TComponent; override;
  241.     procedure GetText(var Text: string; DisplayText: Boolean); virtual;
  242.     function HasParent: Boolean; override;
  243.     procedure Notification(AComponent: TComponent;
  244.       Operation: TOperation); override;
  245.     procedure PropertyChanged(LayoutAffected: Boolean);
  246.     procedure ReadState(Reader: TReader); override;
  247.     procedure SetAsBoolean(Value: Boolean); virtual;
  248.     procedure SetAsCurrency(Value: Currency); virtual;
  249.     procedure SetAsDateTime(Value: TDateTime); virtual;
  250.     procedure SetAsFloat(Value: Double); virtual;
  251.     procedure SetAsInteger(Value: Longint); virtual;
  252.     procedure SetAsString(const Value: string); virtual;
  253.     procedure SetAsVariant(const Value: Variant); virtual;
  254.     procedure SetDataType(Value: TFieldType);
  255.     procedure SetSize(Value: Word); virtual;
  256.     procedure SetParentComponent(AParent: TComponent); override;
  257.     procedure SetText(const Value: string); virtual;
  258.     procedure SetVarValue(const Value: Variant); virtual;
  259.   public
  260.     constructor Create(AOwner: TComponent); override;
  261.     destructor Destroy; override;
  262.     procedure Assign(Source: TPersistent); override;
  263.     procedure AssignValue(const Value: TVarRec);
  264.     procedure Clear; virtual;
  265.     procedure FocusControl;
  266.     function GetData(Buffer: Pointer): Boolean;
  267.     class function IsBlob: Boolean; virtual;
  268.     function IsValidChar(InputChar: Char): Boolean; virtual;
  269.     procedure RefreshLookupList;
  270.     procedure SetData(Buffer: Pointer);
  271.     procedure SetFieldType(Value: TFieldType); virtual;
  272.     procedure Validate(Buffer: Pointer);
  273.     property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
  274.     property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
  275.     property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
  276.     property AsFloat: Double read GetAsFloat write SetAsFloat;
  277.     property AsInteger: Longint read GetAsInteger write SetAsInteger;
  278.     property AsString: string read GetAsString write SetAsString;
  279.     property AsVariant: Variant read GetAsVariant write SetAsVariant;
  280.     property AttributeSet: string read FAttributeSet write FAttributeSet;
  281.     property Calculated: Boolean read GetCalculated write SetCalculated default False;
  282.     property CanModify: Boolean read GetCanModify;
  283.     property CurValue: Variant read GetCurValue;
  284.     property DataSet: TDataSet read FDataSet write SetDataSet stored False;
  285.     property DataSize: Word read GetDataSize;
  286.     property DataType: TFieldType read FDataType;
  287.     property DisplayName: string read GetDisplayName;
  288.     property DisplayText: string read GetDisplayText;
  289.     property EditMask: string read FEditMask write SetEditMask;
  290.     property EditMaskPtr: string read FEditMask;
  291.     property FieldNo: Integer read FFieldNo;
  292.     property IsIndexField: Boolean read GetIsIndexField;
  293.     property IsNull: Boolean read GetIsNull;
  294.     property Lookup: Boolean read GetLookup write SetLookup;
  295.     property LookupList: TLookupList read GetLookupList;
  296.     property NewValue: Variant read GetNewValue write SetNewValue;
  297.     property Offset: word read FOffset;
  298.     property OldValue: Variant read GetOldValue;
  299.     property Size: Word read FSize write SetSize;
  300.     property Text: string read GetEditText write SetEditText;
  301.     property ValidChars: TFieldChars read FValidChars write FValidChars;
  302.     property Value: Variant read GetAsVariant write SetAsVariant;
  303.   published
  304.     property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
  305.     property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
  306.     property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
  307.     property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
  308.     property DisplayLabel: string read GetDisplayLabel write SetDisplayLabel
  309.       stored IsDisplayLabelStored;
  310.     property DisplayWidth: Integer read GetDisplayWidth write SetDisplayWidth
  311.       stored IsDisplayWidthStored;
  312.     property FieldKind: TFieldKind read FFieldKind write SetFieldKind stored FieldKindStored;
  313.     property FieldName: string read FFieldName write SetFieldName;
  314.     property HasConstraints: Boolean read GetHasConstraints;
  315.     property Index: Integer read GetIndex write SetIndex stored False;
  316.     property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
  317.     property LookupDataSet: TDataSet read FLookupDataSet write SetLookupDataSet;
  318.     property LookupKeyFields: string read FLookupKeyFields write SetLookupKeyFields;
  319.     property LookupResultField: string read FLookupResultField write SetLookupResultField;
  320.     property KeyFields: string read FKeyFields write SetKeyFields;
  321.     property LookupCache: Boolean read FLookupCache write SetLookupCache default False;
  322.     property Origin: string read FOrigin write FOrigin;
  323.     property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
  324.     property Required: Boolean read FRequired write FRequired default False;
  325.     property Visible: Boolean read FVisible write SetVisible default True;
  326.     property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
  327.     property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
  328.     property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
  329.     property OnValidate: TFieldNotifyEvent read FOnValidate write FOnValidate;
  330.   end;
  331.  
  332. { TStringField }
  333.  
  334.   TStringField = class(TField)
  335.   private
  336.     FTransliterate: Boolean;
  337.   protected
  338.     class procedure CheckTypeSize(Value: Integer); override;
  339.     function GetAsBoolean: Boolean; override;
  340.     function GetAsDateTime: TDateTime; override;
  341.     function GetAsFloat: Double; override;
  342.     function GetAsInteger: Longint; override;
  343.     function GetAsString: string; override;
  344.     function GetAsVariant: Variant; override;
  345.     function GetDataSize: Word; override;
  346.     function GetDefaultWidth: Integer; override;
  347.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  348.     function GetValue(var Value: string): Boolean;
  349.     procedure SetAsBoolean(Value: Boolean); override;
  350.     procedure SetAsDateTime(Value: TDateTime); override;
  351.     procedure SetAsFloat(Value: Double); override;
  352.     procedure SetAsInteger(Value: Longint); override;
  353.     procedure SetAsString(const Value: string); override;
  354.     procedure SetVarValue(const Value: Variant); override;
  355.   public
  356.     constructor Create(AOwner: TComponent); override;
  357.     property Value: string read GetAsString write SetAsString;
  358.   published
  359.     property EditMask;
  360.     property Size default 20;
  361.     property Transliterate: Boolean read FTransliterate write FTransliterate default True;
  362.   end;
  363.  
  364. { TNumericField }
  365.  
  366.   TNumericField = class(TField)
  367.   private
  368.     FDisplayFormat: string;
  369.     FEditFormat: string;
  370.   protected
  371.     procedure RangeError(Value, Min, Max: Extended);
  372.     procedure SetDisplayFormat(const Value: string);
  373.     procedure SetEditFormat(const Value: string);
  374.   public
  375.     constructor Create(AOwner: TComponent); override;
  376.   published
  377.     property Alignment default taRightJustify;
  378.     property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  379.     property EditFormat: string read FEditFormat write SetEditFormat;
  380.   end;
  381.  
  382. { TIntegerField }
  383.  
  384.   TIntegerField = class(TNumericField)
  385.   private
  386.     FMinRange: Longint;
  387.     FMaxRange: Longint;
  388.     FMinValue: Longint;
  389.     FMaxValue: Longint;
  390.     procedure CheckRange(Value, Min, Max: Longint);
  391.     procedure SetMaxValue(Value: Longint);
  392.     procedure SetMinValue(Value: Longint);
  393.   protected
  394.     function GetAsFloat: Double; override;
  395.     function GetAsInteger: Longint; override;
  396.     function GetAsString: string; override;
  397.     function GetAsVariant: Variant; override;
  398.     function GetDataSize: Word; override;
  399.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  400.     function GetValue(var Value: Longint): Boolean;
  401.     procedure SetAsFloat(Value: Double); override;
  402.     procedure SetAsInteger(Value: Longint); override;
  403.     procedure SetAsString(const Value: string); override;
  404.     procedure SetVarValue(const Value: Variant); override;
  405.   public
  406.     constructor Create(AOwner: TComponent); override;
  407.     property Value: Longint read GetAsInteger write SetAsInteger;
  408.   published
  409.     property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
  410.     property MinValue: Longint read FMinValue write SetMinValue default 0;
  411.   end;
  412.  
  413. { TSmallintField }
  414.  
  415.   TSmallintField = class(TIntegerField)
  416.   protected
  417.     function GetDataSize: Word; override;
  418.   public
  419.     constructor Create(AOwner: TComponent); override;
  420.   end;
  421.  
  422. { TWordField }
  423.  
  424.   TWordField = class(TIntegerField)
  425.   protected
  426.     function GetDataSize: Word; override;
  427.   public
  428.     constructor Create(AOwner: TComponent); override;
  429.   end;
  430.  
  431. { TAutoIncField }
  432.  
  433.   TAutoIncField = class(TIntegerField)
  434.   public
  435.     constructor Create(AOwner: TComponent); override;
  436.   end;
  437.  
  438. { TFloatField }
  439.  
  440.   TFloatField = class(TNumericField)
  441.   private
  442.     FCurrency: Boolean;
  443.     FCheckRange: Boolean;
  444.     FPrecision: Integer;
  445.     FMinValue: Double;
  446.     FMaxValue: Double;
  447.     procedure SetCurrency(Value: Boolean);
  448.     procedure SetMaxValue(Value: Double);
  449.     procedure SetMinValue(Value: Double);
  450.     procedure SetPrecision(Value: Integer);
  451.     procedure UpdateCheckRange;
  452.   protected
  453.     function GetAsFloat: Double; override;
  454.     function GetAsInteger: Longint; override;
  455.     function GetAsString: string; override;
  456.     function GetAsVariant: Variant; override;
  457.     function GetDataSize: Word; override;
  458.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  459.     procedure SetAsFloat(Value: Double); override;
  460.     procedure SetAsInteger(Value: Longint); override;
  461.     procedure SetAsString(const Value: string); override;
  462.     procedure SetVarValue(const Value: Variant); override;
  463.   public
  464.     constructor Create(AOwner: TComponent); override;
  465.     property Value: Double read GetAsFloat write SetAsFloat;
  466.   published
  467.     property Currency: Boolean read FCurrency write SetCurrency default False;
  468.     property MaxValue: Double read FMaxValue write SetMaxValue;
  469.     property MinValue: Double read FMinValue write SetMinValue;
  470.     property Precision: Integer read FPrecision write SetPrecision default 15;
  471.   end;
  472.  
  473. { TCurrencyField }
  474.  
  475.   TCurrencyField = class(TFloatField)
  476.   public
  477.     constructor Create(AOwner: TComponent); override;
  478.   published
  479.     property Currency default True;
  480.   end;
  481.  
  482. { TBooleanField }
  483.  
  484.   TBooleanField = class(TField)
  485.   private
  486.     FDisplayValues: string;
  487.     FTextValues: array[Boolean] of string;
  488.     procedure LoadTextValues;
  489.     procedure SetDisplayValues(const Value: string);
  490.   protected
  491.     function GetAsBoolean: Boolean; override;
  492.     function GetAsString: string; override;
  493.     function GetAsVariant: Variant; override;
  494.     function GetDataSize: Word; override;
  495.     function GetDefaultWidth: Integer; override;
  496.     procedure SetAsBoolean(Value: Boolean); override;
  497.     procedure SetAsString(const Value: string); override;
  498.     procedure SetVarValue(const Value: Variant); override;
  499.   public
  500.     constructor Create(AOwner: TComponent); override;
  501.     property Value: Boolean read GetAsBoolean write SetAsBoolean;
  502.   published
  503.     property DisplayValues: string read FDisplayValues write SetDisplayValues;
  504.   end;
  505.  
  506. { TDateTimeField }
  507.  
  508.   TDateTimeField = class(TField)
  509.   private
  510.     FDisplayFormat: string;
  511.     function GetValue(var Value: TDateTime): Boolean;
  512.     procedure SetDisplayFormat(const Value: string);
  513.   protected
  514.     function GetAsDateTime: TDateTime; override;
  515.     function GetAsFloat: Double; override;
  516.     function GetAsString: string; override;
  517.     function GetAsVariant: Variant; override;
  518.     function GetDataSize: Word; override;
  519.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  520.     procedure SetAsDateTime(Value: TDateTime); override;
  521.     procedure SetAsFloat(Value: Double); override;
  522.     procedure SetAsString(const Value: string); override;
  523.     procedure SetVarValue(const Value: Variant); override;
  524.   public
  525.     constructor Create(AOwner: TComponent); override;
  526.     property Value: TDateTime read GetAsDateTime write SetAsDateTime;
  527.   published
  528.     property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
  529.     property EditMask;
  530.   end;
  531.  
  532. { TDateField }
  533.  
  534.   TDateField = class(TDateTimeField)
  535.   protected
  536.     function GetDataSize: Word; override;
  537.   public
  538.     constructor Create(AOwner: TComponent); override;
  539.   end;
  540.  
  541. { TTimeField }
  542.  
  543.   TTimeField = class(TDateTimeField)
  544.   protected
  545.     function GetDataSize: Word; override;
  546.   public
  547.     constructor Create(AOwner: TComponent); override;
  548.   end;
  549.  
  550. { TBinaryField }
  551.  
  552.   TBinaryField = class(TField)
  553.   protected
  554.     class procedure CheckTypeSize(Value: Integer); override;
  555.     function GetAsString: string; override;
  556.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  557.     function GetAsVariant: Variant; override;
  558.     procedure SetAsString(const Value: string); override;
  559.     procedure SetText(const Value: string); override;
  560.     procedure SetVarValue(const Value: Variant); override;
  561.   public
  562.     constructor Create(AOwner: TComponent); override;
  563.   published
  564.     property Size default 16;
  565.   end;
  566.  
  567. { TBytesField }
  568.  
  569.   TBytesField = class(TBinaryField)
  570.   protected
  571.     function GetDataSize: Word; override;
  572.   public
  573.     constructor Create(AOwner: TComponent); override;
  574.   end;
  575.  
  576. { TVarBytesField }
  577.  
  578.   TVarBytesField = class(TBytesField)
  579.   protected
  580.     function GetDataSize: Word; override;
  581.   public
  582.     constructor Create(AOwner: TComponent); override;
  583.   end;
  584.  
  585. { TBCDField }
  586.  
  587.   TBCDField = class(TNumericField)
  588.   private
  589.     FCurrency: Boolean;
  590.     FCheckRange: Boolean;
  591.     FMinValue: Currency;
  592.     FMaxValue: Currency;
  593.     FPrecision: Integer;
  594.     procedure SetCurrency(Value: Boolean);
  595.     procedure SetMaxValue(Value: Currency);
  596.     procedure SetMinValue(Value: Currency);
  597.     procedure UpdateCheckRange;
  598.   protected
  599.     class procedure CheckTypeSize(Value: Integer); override;
  600.     function GetAsCurrency: Currency; override;
  601.     function GetAsFloat: Double; override;
  602.     function GetAsInteger: Longint; override;
  603.     function GetAsString: string; override;
  604.     function GetAsVariant: Variant; override;
  605.     function GetDataSize: Word; override;
  606.     function GetDefaultWidth: Integer; override;
  607.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  608.     function GetValue(var Value: Currency): Boolean;
  609.     procedure SetAsCurrency(Value: Currency); override;
  610.     procedure SetAsFloat(Value: Double); override;
  611.     procedure SetAsInteger(Value: Longint); override;
  612.     procedure SetAsString(const Value: string); override;
  613.     procedure SetVarValue(const Value: Variant); override;
  614.   public
  615.     constructor Create(AOwner: TComponent); override;
  616.     property Value: Currency read GetAsCurrency write SetAsCurrency;
  617.   published
  618.     property Currency: Boolean read FCurrency write SetCurrency default False;
  619.     property MaxValue: Currency read FMaxValue write SetMaxValue;
  620.     property MinValue: Currency read FMinValue write SetMinValue;
  621.     property Size default 4;
  622.   end;
  623.  
  624. { TBlobField }
  625.  
  626.   TBlobType = ftBlob..ftTypedBinary;
  627.  
  628.   TBlobField = class(TField)
  629.   private
  630.     FModified: Boolean;
  631.     FModifiedRecord: Integer;
  632.     FTransliterate: Boolean;
  633.     function GetBlobType: TBlobType;
  634.     function GetModified: Boolean;
  635.     procedure LoadFromBlob(Blob: TBlobField);
  636.     procedure LoadFromBitmap(Bitmap: TBitmap);
  637.     procedure LoadFromStrings(Strings: TStrings);
  638.     procedure SaveToBitmap(Bitmap: TBitmap);
  639.     procedure SaveToStrings(Strings: TStrings);
  640.     procedure SetBlobType(Value: TBlobType);
  641.     procedure SetModified(Value: Boolean);
  642.   protected
  643.     procedure AssignTo(Dest: TPersistent); override;
  644.     procedure FreeBuffers; override;
  645.     function GetAsString: string; override;
  646.     function GetAsVariant: Variant; override;
  647.     function GetBlobSize: Integer; virtual;
  648.     function GetIsNull: Boolean; override;
  649.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  650.     procedure SetAsString(const Value: string); override;
  651.     procedure SetText(const Value: string); override;
  652.     procedure SetVarValue(const Value: Variant); override;
  653.   public
  654.     constructor Create(AOwner: TComponent); override;
  655.     procedure Assign(Source: TPersistent); override;
  656.     procedure Clear; override;
  657.     class function IsBlob: Boolean; override;
  658.     procedure LoadFromFile(const FileName: string);
  659.     procedure LoadFromStream(Stream: TStream);
  660.     procedure SaveToFile(const FileName: string);
  661.     procedure SaveToStream(Stream: TStream);
  662.     procedure SetFieldType(Value: TFieldType); override;
  663.     property BlobSize: Integer read GetBlobSize;
  664.     property Modified: Boolean read GetModified write SetModified;
  665.     property Value: string read GetAsString write SetAsString;
  666.     property Transliterate: Boolean read FTransliterate write FTransliterate;
  667.   published
  668.     property BlobType: TBlobType read GetBlobType write SetBlobType;
  669.     property Size default 0;
  670.   end;
  671.  
  672. { TMemoField }
  673.  
  674.   TMemoField = class(TBlobField)
  675.   public
  676.     constructor Create(AOwner: TComponent); override;
  677.   published
  678.     property Transliterate default True;
  679.   end;
  680.  
  681. { TGraphicField }
  682.  
  683.   TGraphicField = class(TBlobField)
  684.   public
  685.     constructor Create(AOwner: TComponent); override;
  686.   end;
  687.  
  688. { TIndexDef }
  689.  
  690.   TIndexDefs = class;
  691.  
  692.   TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
  693.     ixCaseInsensitive, ixExpression);
  694.  
  695.   TIndexDef = class
  696.   private
  697.     FOwner: TIndexDefs;
  698.     FSource: string;
  699.     FName: string;
  700.     FFields: string;
  701.     FOptions: TIndexOptions;
  702.     function GetExpression: string;
  703.     function GetFields: string;
  704.   public
  705.     constructor Create(Owner: TIndexDefs; const Name, Fields: string;
  706.       Options: TIndexOptions);
  707.     destructor Destroy; override;
  708.     property Expression: string read GetExpression;
  709.     property Fields: string read GetFields;
  710.     property Name: string read FName;
  711.     property Options: TIndexOptions read FOptions;
  712.     property Source: string read FSource write FSource;
  713.   end;
  714.  
  715. { TIndexDefs }
  716.  
  717.   TIndexDefs = class
  718.   private
  719.     FDataSet: TDataSet;
  720.     FItems: TList;
  721.     FUpdated: Boolean;
  722.     function GetCount: Integer;
  723.     function GetItem(Index: Integer): TIndexDef;
  724.   public
  725.     constructor Create(DataSet: TDataSet);
  726.     destructor Destroy; override;
  727.     procedure Add(const Name, Fields: string; Options: TIndexOptions);
  728.     procedure Assign(IndexDefs: TIndexDefs);
  729.     procedure Clear;
  730.     function FindIndexForFields(const Fields: string): TIndexDef;
  731.     function GetIndexForFields(const Fields: string;
  732.       CaseInsensitive: Boolean): TIndexDef;
  733.     function IndexOf(const Name: string): Integer;
  734.     procedure Update;
  735.     property Count: Integer read GetCount;
  736.     property Items[Index: Integer]: TIndexDef read GetItem; default;
  737.     property Updated: Boolean read FUpdated write FUpdated;
  738.   end;
  739.  
  740. { TDataLink }
  741.  
  742.   TDataLink = class(TPersistent)
  743.   private
  744.     FDataSource: TDataSource;
  745.     FNext: TDataLink;
  746.     FBufferCount: Integer;
  747.     FFirstRecord: Integer;
  748.     FReadOnly: Boolean;
  749.     FActive: Boolean;
  750.     FEditing: Boolean;
  751.     FUpdating: Boolean;
  752.     FDataSourceFixed: Boolean;
  753.     procedure DataEvent(Event: TDataEvent; Info: Longint);
  754.     function GetActiveRecord: Integer;
  755.     function GetDataSet: TDataSet;
  756.     function GetRecordCount: Integer;
  757.     procedure SetActive(Value: Boolean);
  758.     procedure SetActiveRecord(Value: Integer);
  759.     procedure SetBufferCount(Value: Integer);
  760.     procedure SetDataSource(ADataSource: TDataSource);
  761.     procedure SetEditing(Value: Boolean);
  762.     procedure SetReadOnly(Value: Boolean);
  763.     procedure UpdateRange;
  764.     procedure UpdateState;
  765.   protected
  766.     procedure ActiveChanged; virtual;
  767.     procedure CheckBrowseMode; virtual;
  768.     procedure DataSetChanged; virtual;
  769.     procedure DataSetScrolled(Distance: Integer); virtual;
  770.     procedure FocusControl(Field: TFieldRef); virtual;
  771.     procedure EditingChanged; virtual;
  772.     procedure LayoutChanged; virtual;
  773.     procedure RecordChanged(Field: TField); virtual;
  774.     procedure UpdateData; virtual;
  775.   public
  776.     constructor Create;
  777.     destructor Destroy; override;
  778.     function Edit: Boolean;
  779.     procedure UpdateRecord;
  780.     property Active: Boolean read FActive;
  781.     property ActiveRecord: Integer read GetActiveRecord write SetActiveRecord;
  782.     property BufferCount: Integer read FBufferCount write SetBufferCount;
  783.     property DataSet: TDataSet read GetDataSet;
  784.     property DataSource: TDataSource read FDataSource write SetDataSource;
  785.     property DataSourceFixed: Boolean read FDataSourceFixed write FDataSourceFixed;
  786.     property Editing: Boolean read FEditing;
  787.     property ReadOnly: Boolean read FReadOnly write SetReadOnly;
  788.     property RecordCount: Integer read GetRecordCount;
  789.   end;
  790.  
  791. { TDataSource }
  792.  
  793.   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  794.  
  795.   TDataSource = class(TComponent)
  796.   private
  797.     FDataSet: TDataSet;
  798.     FDataLinks: TList;
  799.     FEnabled: Boolean;
  800.     FAutoEdit: Boolean;
  801.     FState: TDataSetState;
  802.     FOnStateChange: TNotifyEvent;
  803.     FOnDataChange: TDataChangeEvent;
  804.     FOnUpdateData: TNotifyEvent;
  805.     procedure AddDataLink(DataLink: TDataLink);
  806.     procedure DataEvent(Event: TDataEvent; Info: Longint);
  807.     procedure NotifyDataLinks(Event: TDataEvent; Info: Longint);
  808.     procedure RemoveDataLink(DataLink: TDataLink);
  809.     procedure SetDataSet(ADataSet: TDataSet);
  810.     procedure SetEnabled(Value: Boolean);
  811.     procedure SetState(Value: TDataSetState);
  812.     procedure UpdateState;
  813.   public
  814.     constructor Create(AOwner: TComponent); override;
  815.     destructor Destroy; override;
  816.     procedure Edit;
  817.     function IsLinkedTo(DataSet: TDataSet): Boolean;
  818.     property State: TDataSetState read FState;
  819.   published
  820.     property AutoEdit: Boolean read FAutoEdit write FAutoEdit default True;
  821.     property DataSet: TDataSet read FDataSet write SetDataSet;
  822.     property Enabled: Boolean read FEnabled write SetEnabled default True;
  823.     property OnStateChange: TNotifyEvent read FOnStateChange write FOnStateChange;
  824.     property OnDataChange: TDataChangeEvent read FOnDataChange write FOnDataChange;
  825.     property OnUpdateData: TNotifyEvent read FOnUpdateData write FOnUpdateData;
  826.   end;
  827.  
  828. { TDataSetDesigner }
  829.  
  830.   TDataSetDesigner = class(TObject)
  831.   private
  832.     FDataSet: TDataSet;
  833.     FSaveActive: Boolean;
  834.   public
  835.     constructor Create(DataSet: TDataSet);
  836.     destructor Destroy; override;
  837.     procedure BeginDesign;
  838.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  839.     procedure EndDesign;
  840.     property DataSet: TDataSet read FDataSet;
  841.   end;
  842.  
  843. { TCheckConstraint }
  844.  
  845.   TCheckConstraint = class(TCollectionItem)
  846.   private
  847.     FImportedConstraint: string;
  848.     FCustomConstraint: string;
  849.     FErrorMessage: string;
  850.     FFromDictionary: Boolean;
  851.     procedure SetImportedConstraint(const Value: string);
  852.     procedure SetCustomConstraint(const Value: string);
  853.     procedure SetErrorMessage(const Value: string);
  854.   public
  855.     procedure Assign(Source: TPersistent); override;
  856.     function GetDisplayName: string; override;
  857.   published
  858.     property CustomConstraint: string read FCustomConstraint write SetCustomConstraint;
  859.     property ErrorMessage: string read FErrorMessage write SetErrorMessage;
  860.     property FromDictionary: Boolean read FFromDictionary write FFromDictionary;
  861.     property ImportedConstraint: string read FImportedConstraint write SetImportedConstraint;
  862.   end;
  863.  
  864. { TCheckConstraints }
  865.  
  866.   TCheckConstraints = class(TCollection)
  867.   private
  868.     FOwner: TPersistent;
  869.     function GetItem(Index: Integer): TCheckConstraint;
  870.     procedure SetItem(Index: Integer; Value: TCheckConstraint);
  871.   protected
  872.     function GetOwner: TPersistent; override;
  873.   public
  874.     constructor Create(Owner: TPersistent);
  875.     function Add: TCheckConstraint;
  876.     property Items[Index: Integer]: TCheckConstraint read GetItem write SetItem; default;
  877.   end;
  878.  
  879. { TDataSet }
  880.  
  881.   TBookmark = Pointer;
  882.   TBookmarkStr = string;
  883.  
  884.   PBookmarkFlag = ^TBookmarkFlag;
  885.   TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
  886.  
  887.   PBufferList = ^TBufferList;
  888.   TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
  889.  
  890.   TGetMode = (gmCurrent, gmNext, gmPrior);
  891.  
  892.   TGetResult = (grOK, grBOF, grEOF, grError);
  893.  
  894.   TResyncMode = set of (rmExact, rmCenter);
  895.  
  896.   TDataAction = (daFail, daAbort, daRetry);
  897.  
  898.   TUpdateKind = (ukModify, ukInsert, ukDelete);
  899.  
  900.   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
  901.  
  902.   TLocateOption = (loCaseInsensitive, loPartialKey);
  903.   TLocateOptions = set of TLocateOption;
  904.  
  905.   TDataOperation = procedure of object;
  906.  
  907.   TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  908.   TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  909.     var Action: TDataAction) of object;
  910.  
  911.   TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  912.   TFilterOptions = set of TFilterOption;
  913.  
  914.   TFilterRecordEvent = procedure(DataSet: TDataSet;
  915.     var Accept: Boolean) of object;
  916.  
  917.   TDataSet = class(TComponent)
  918.   private
  919.     FFields: TList;
  920.     FFieldDefs: TFieldDefs;
  921.     FDataSources: TList;
  922.     FFirstDataLink: TDataLink;
  923.     FBufferCount: Integer;
  924.     FRecordCount: Integer;
  925.     FActiveRecord: Integer;
  926.     FCurrentRecord: Integer;
  927.     FBuffers: PBufferList;
  928.     FCalcBuffer: PChar;
  929.     FBufListSize: Integer;
  930.     FBookmarkSize: Integer;
  931.     FCalcFieldsSize: Integer;
  932.     FBOF: Boolean;
  933.     FEOF: Boolean;
  934.     FModified: Boolean;
  935.     FStreamedActive: Boolean;
  936.     FInternalCalcFields: Boolean;
  937.     FState: TDataSetState;
  938.     FEnableEvent: TDataEvent;
  939.     FDisableState: TDataSetState;
  940.     FDesigner: TDataSetDesigner;
  941.     FDisableCount: Integer;
  942.     FFound: Boolean;
  943.     FDefaultFields: Boolean;
  944.     FAutoCalcFields: Boolean;
  945.     FFiltered: Boolean;
  946.     FBlobFieldCount: Integer;
  947.     FFilterText: string;
  948.     FFilterOptions: TFilterOptions;
  949.     FConstraints: TCheckConstraints;
  950.     FBeforeOpen: TDataSetNotifyEvent;
  951.     FAfterOpen: TDataSetNotifyEvent;
  952.     FBeforeClose: TDataSetNotifyEvent;
  953.     FAfterClose: TDataSetNotifyEvent;
  954.     FBeforeInsert: TDataSetNotifyEvent;
  955.     FAfterInsert: TDataSetNotifyEvent;
  956.     FBeforeEdit: TDataSetNotifyEvent;
  957.     FAfterEdit: TDataSetNotifyEvent;
  958.     FBeforePost: TDataSetNotifyEvent;
  959.     FAfterPost: TDataSetNotifyEvent;
  960.     FBeforeCancel: TDataSetNotifyEvent;
  961.     FAfterCancel: TDataSetNotifyEvent;
  962.     FBeforeDelete: TDataSetNotifyEvent;
  963.     FAfterDelete: TDataSetNotifyEvent;
  964.     FBeforeScroll: TDataSetNotifyEvent;
  965.     FAfterScroll: TDataSetNotifyEvent;
  966.     FOnNewRecord: TDataSetNotifyEvent;
  967.     FOnCalcFields: TDataSetNotifyEvent;
  968.     FOnEditError: TDataSetErrorEvent;
  969.     FOnPostError: TDataSetErrorEvent;
  970.     FOnDeleteError: TDataSetErrorEvent;
  971.     FOnFilterRecord: TFilterRecordEvent;
  972.     procedure AddDataSource(DataSource: TDataSource);
  973.     procedure AddField(Field: TField);
  974.     procedure AddRecord(const Values: array of const; Append: Boolean);
  975.     procedure BeginInsertAppend;
  976.     procedure CheckCanModify;
  977.     procedure CheckFieldName(const FieldName: string);
  978.     procedure CheckFieldNames(const FieldNames: string);
  979.     procedure CheckOperation(Operation: TDataOperation;
  980.       ErrorEvent: TDataSetErrorEvent);
  981.     procedure CheckRequiredFields;
  982.     procedure DoInternalOpen;
  983.     procedure DoInternalClose;
  984.     procedure EndInsertAppend;
  985.     function GetActive: Boolean;
  986.     function GetBuffer(Index: Integer): PChar;
  987.     function GetField(Index: Integer): TField;
  988.     function GetFieldCount: Integer;
  989.     function GetFieldValue(const FieldName: string): Variant;
  990.     function GetFound: Boolean;
  991.     procedure MoveBuffer(CurIndex, NewIndex: Integer);
  992.     procedure RemoveDataSource(DataSource: TDataSource);
  993.     procedure RemoveField(Field: TField);
  994.     procedure SetActive(Value: Boolean);
  995.     procedure SetBufferCount(Value: Integer);
  996.     procedure SetField(Index: Integer; Value: TField);
  997.     procedure SetFieldDefs(Value: TFieldDefs);
  998.     procedure SetFieldValue(const FieldName: string; const Value: Variant);
  999.     procedure SetConstraints(const Value: TCheckConstraints);
  1000.     procedure UpdateBufferCount;
  1001.     procedure UpdateFieldDefs;
  1002.   protected
  1003.     procedure ActivateBuffers; virtual;
  1004.     procedure BindFields(Binding: Boolean);
  1005.     function BookmarkAvailable: Boolean;
  1006.     function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; virtual;
  1007.     function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  1008.       Decimals: Integer): Boolean; virtual;
  1009.     procedure CalculateFields(Buffer: PChar); virtual;
  1010.     procedure CheckActive; virtual;
  1011.     procedure CheckInactive; virtual;
  1012.     procedure ClearBuffers; virtual;
  1013.     procedure ClearCalcFields(Buffer: PChar); virtual;
  1014.     procedure CloseBlob(Field: TField); virtual;
  1015.     procedure CloseCursor; virtual;
  1016.     procedure CreateFields;
  1017.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  1018.     procedure DestroyFields; virtual;
  1019.     procedure DoAfterCancel; virtual;
  1020.     procedure DoAfterClose; virtual;
  1021.     procedure DoAfterDelete; virtual;
  1022.     procedure DoAfterEdit; virtual;
  1023.     procedure DoAfterInsert; virtual;
  1024.     procedure DoAfterOpen; virtual;
  1025.     procedure DoAfterPost; virtual;
  1026.     procedure DoAfterScroll; virtual;
  1027.     procedure DoBeforeCancel; virtual;
  1028.     procedure DoBeforeClose; virtual;
  1029.     procedure DoBeforeDelete; virtual;
  1030.     procedure DoBeforeEdit; virtual;
  1031.     procedure DoBeforeInsert; virtual;
  1032.     procedure DoBeforeOpen; virtual;
  1033.     procedure DoBeforePost; virtual;
  1034.     procedure DoBeforeScroll; virtual;
  1035.     procedure DoOnCalcFields; virtual;
  1036.     procedure DoOnNewRecord; virtual;
  1037.     function FieldByNumber(FieldNo: Integer): TField;
  1038.     function FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
  1039.     procedure FreeFieldBuffers; virtual;
  1040.     function GetBookmarkStr: TBookmarkStr; virtual;
  1041.     procedure GetCalcFields(Buffer: PChar); virtual;
  1042.     function GetCanModify: Boolean; virtual;
  1043.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  1044.     function GetDataSource: TDataSource; virtual;
  1045.     function GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
  1046.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; virtual;
  1047.     function GetIsIndexField(Field: TField): Boolean; virtual;
  1048.     function GetNextRecords: Integer; virtual;
  1049.     function GetNextRecord: Boolean; virtual;
  1050.     function GetPriorRecords: Integer; virtual;
  1051.     function GetPriorRecord: Boolean; virtual;
  1052.     function GetRecordCount: Integer; virtual;
  1053.     function GetRecNo: Integer; virtual;
  1054.     procedure InitFieldDefs; virtual;
  1055.     procedure InitRecord(Buffer: PChar); virtual;
  1056.     procedure InternalCancel; virtual;
  1057.     procedure InternalEdit; virtual;
  1058.     procedure InternalRefresh; virtual;
  1059.     procedure Loaded; override;
  1060.     procedure OpenCursor(InfoQuery: Boolean); virtual;
  1061.     procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
  1062.     procedure RestoreState(const Value: TDataSetState);
  1063.     procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
  1064.     procedure SetBufListSize(Value: Integer);
  1065.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  1066.     procedure SetCurrentRecord(Index: Integer); virtual;
  1067.     procedure SetFiltered(Value: Boolean); virtual;
  1068.     procedure SetFilterOptions(Value: TFilterOptions); virtual;
  1069.     procedure SetFilterText(const Value: string); virtual;
  1070.     procedure SetFound(const Value: Boolean);
  1071.     procedure SetModified(Value: Boolean);
  1072.     procedure SetName(const Value: TComponentName); override;
  1073.     procedure SetStateFieldValue(State: TDataSetState; Field: TField; Value: Variant); virtual;
  1074.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
  1075.     procedure SetRecNo(Value: Integer); virtual;
  1076.     procedure SetState(Value: TDataSetState);
  1077.     function SetTempState(const Value: TDataSetState): TDataSetState;
  1078.     function TempBuffer: PChar;
  1079.     procedure UpdateIndexDefs; virtual;
  1080.     property ActiveRecord: Integer read FActiveRecord;
  1081.     property CurrentRecord: Integer read FCurrentRecord;
  1082.     property BlobFieldCount: Integer read FBlobFieldCount;
  1083.     property BookmarkSize: Integer read FBookmarkSize write FBookmarkSize;
  1084.     property Buffers[Index: Integer]: PChar read GetBuffer;
  1085.     property BufferCount: Integer read FBufferCount;
  1086.     property CalcBuffer: PChar read FCalcBuffer;
  1087.     property CalcFieldsSize: Integer read FCalcFieldsSize;
  1088.     property InternalCalcFields: Boolean read FInternalCalcFields;
  1089.     property Constraints: TCheckConstraints read FConstraints write SetConstraints;
  1090.   protected { abstract methods }
  1091.     function AllocRecordBuffer: PChar; virtual; abstract;
  1092.     procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
  1093.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  1094.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
  1095.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
  1096.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
  1097.     function GetRecordSize: Word; virtual; abstract;
  1098.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
  1099.     procedure InternalClose; virtual; abstract;
  1100.     procedure InternalDelete; virtual; abstract;
  1101.     procedure InternalFirst; virtual; abstract;
  1102.     procedure InternalGotoBookmark(Bookmark: Pointer); virtual; abstract;
  1103.     procedure InternalHandleException; virtual; abstract;
  1104.     procedure InternalInitFieldDefs; virtual; abstract;
  1105.     procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
  1106.     procedure InternalLast; virtual; abstract;
  1107.     procedure InternalOpen; virtual; abstract;
  1108.     procedure InternalPost; virtual; abstract;
  1109.     procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
  1110.     function IsCursorOpen: Boolean; virtual; abstract;
  1111.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
  1112.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  1113.     procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
  1114.   public
  1115.     constructor Create(AOwner: TComponent); override;
  1116.     destructor Destroy; override;
  1117.     function ActiveBuffer: PChar;
  1118.     procedure Append;
  1119.     procedure AppendRecord(const Values: array of const);
  1120.     function BookmarkValid(Bookmark: TBookmark): Boolean; virtual;
  1121.     procedure Cancel; virtual;
  1122.     procedure CheckBrowseMode;
  1123.     procedure ClearFields;
  1124.     procedure Close;
  1125.     function  ControlsDisabled: Boolean;
  1126.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; virtual;
  1127.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
  1128.     procedure CursorPosChanged;
  1129.     procedure Delete;
  1130.     procedure DisableControls;
  1131.     procedure Edit;
  1132.     procedure EnableControls;
  1133.     function FieldByName(const FieldName: string): TField;
  1134.     function FindField(const FieldName: string): TField;
  1135.     function FindFirst: Boolean;
  1136.     function FindLast: Boolean;
  1137.     function FindNext: Boolean;
  1138.     function FindPrior: Boolean;
  1139.     procedure First;
  1140.     procedure FreeBookmark(Bookmark: TBookmark); virtual;
  1141.     function GetBookmark: TBookmark; virtual;
  1142.     function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
  1143.     procedure GetFieldList(List: TList; const FieldNames: string);
  1144.     procedure GetFieldNames(List: TStrings);
  1145.     procedure GotoBookmark(Bookmark: TBookmark);
  1146.     procedure Insert;
  1147.     procedure InsertRecord(const Values: array of const);
  1148.     function IsEmpty: Boolean;
  1149.     function IsLinkedTo(DataSource: TDataSource): Boolean;
  1150.     function IsSequenced: Boolean; virtual;
  1151.     procedure Last;
  1152.     function Locate(const KeyFields: string; const KeyValues: Variant;
  1153.       Options: TLocateOptions): Boolean; virtual;
  1154.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  1155.       const ResultFields: string): Variant; virtual;
  1156.     function MoveBy(Distance: Integer): Integer;
  1157.     procedure Next;
  1158.     procedure Open;
  1159.     procedure Post; virtual;
  1160.     procedure Prior;
  1161.     procedure Refresh;
  1162.     procedure Resync(Mode: TResyncMode); virtual;
  1163.     procedure SetFields(const Values: array of const);
  1164.     procedure Translate(Src, Dest: PChar; ToOem: Boolean); virtual;
  1165.     procedure UpdateCursorPos;
  1166.     procedure UpdateRecord;
  1167.     property BOF: Boolean read FBOF;
  1168.     property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
  1169.     property CanModify: Boolean read GetCanModify;
  1170.     property DataSource: TDataSource read GetDataSource;
  1171.     property DefaultFields: Boolean read FDefaultFields;
  1172.     property Designer: TDataSetDesigner read FDesigner;
  1173.     property EOF: Boolean read FEOF;
  1174.     property FieldCount: Integer read GetFieldCount;
  1175.     property FieldDefs: TFieldDefs read FFieldDefs write SetFieldDefs;
  1176.     property Fields[Index: Integer]: TField read GetField write SetField;
  1177.     property FieldValues[const FieldName: string]: Variant read GetFieldValue write SetFieldValue; default;
  1178.     property Found: Boolean read GetFound;
  1179.     property Modified: Boolean read FModified;
  1180.     property RecordCount: Integer read GetRecordCount;
  1181.     property RecNo: Integer read GetRecNo write SetRecNo;
  1182.     property RecordSize: Word read GetRecordSize;
  1183.     property State: TDataSetState read FState;
  1184.     property Filter: string read FFilterText write SetFilterText;
  1185.     property Filtered: Boolean read FFiltered write SetFiltered default False;
  1186.     property FilterOptions: TFilterOptions read FFilterOptions write SetFilterOptions default [];
  1187.     property Active: Boolean read GetActive write SetActive default False;
  1188.     property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields default True;
  1189.     property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
  1190.     property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
  1191.     property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
  1192.     property AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
  1193.     property BeforeInsert: TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
  1194.     property AfterInsert: TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
  1195.     property BeforeEdit: TDataSetNotifyEvent read FBeforeEdit write FBeforeEdit;
  1196.     property AfterEdit: TDataSetNotifyEvent read FAfterEdit write FAfterEdit;
  1197.     property BeforePost: TDataSetNotifyEvent read FBeforePost write FBeforePost;
  1198.     property AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
  1199.     property BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
  1200.     property AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
  1201.     property BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
  1202.     property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
  1203.     property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
  1204.     property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
  1205.     property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
  1206.     property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
  1207.     property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
  1208.     property OnFilterRecord: TFilterRecordEvent read FOnFilterRecord write SetOnFilterRecord;
  1209.     property OnNewRecord: TDataSetNotifyEvent read FOnNewRecord write FOnNewRecord;
  1210.     property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
  1211.   end;
  1212.  
  1213. { TDateTimeRec }
  1214.   
  1215. type
  1216.   TDateTimeRec = record
  1217.     case TFieldType of
  1218.       ftDate: (Date: Longint);
  1219.       ftTime: (Time: Longint);
  1220.       ftDateTime: (DateTime: TDateTime);
  1221.   end;
  1222.  
  1223. const
  1224.   dsEditModes = [dsEdit, dsInsert, dsSetKey];
  1225.   dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter, dsNewValue];
  1226.  
  1227.   DefaultFieldClasses: array[ftUnknown..ftTypedBinary] of TFieldClass = (
  1228.     nil,                { ftUnknown }
  1229.     TStringField,       { ftString }
  1230.     TSmallintField,     { ftSmallint }
  1231.     TIntegerField,      { ftInteger }
  1232.     TWordField,         { ftWord }
  1233.     TBooleanField,      { ftBoolean }
  1234.     TFloatField,        { ftFloat }
  1235.     TCurrencyField,     { ftCurrency }
  1236.     TBCDField,          { ftBCD }
  1237.     TDateField,         { ftDate }
  1238.     TTimeField,         { ftTime }
  1239.     TDateTimeField,     { ftDateTime }
  1240.     TBytesField,        { ftBytes }
  1241.     TVarBytesField,     { ftVarBytes }
  1242.     TAutoIncField,      { ftAutoInc }
  1243.     TBlobField,         { ftBlob }
  1244.     TMemoField,         { ftMemo }
  1245.     TGraphicField,      { ftGraphic }
  1246.     TBlobField,         { ftFmtMemo }
  1247.     TBlobField,         { ftParadoxOle }
  1248.     TBlobField,         { ftDBaseOle }
  1249.     TBlobField);        { ftTypedBinary }
  1250.  
  1251. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  1252. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  1253.  
  1254. procedure DatabaseError(const Message: string);
  1255. procedure DatabaseErrorFmt(const Message: string; const Args: array of const);
  1256. procedure DBError(Ident: Word);
  1257. procedure DBErrorFmt(Ident: Word; const Args: array of const);
  1258.  
  1259. procedure DisposeMem(var Buffer; Size: Integer);
  1260. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
  1261.  
  1262. function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
  1263.   const FieldName: string): TField;
  1264.  
  1265. const
  1266.   RegisterFieldsProc: procedure(const FieldClassess: array of TFieldClass) = nil;
  1267.  
  1268. implementation
  1269.  
  1270. uses DBConsts, Mask;
  1271.  
  1272. { Paradox graphic BLOB header }
  1273.  
  1274. type
  1275.   TGraphicHeader = record
  1276.     Count: Word;                { Fixed at 1 }
  1277.     HType: Word;                { Fixed at $0100 }
  1278.     Size: Longint;              { Size not including header }
  1279.   end;
  1280.  
  1281. { Error and exception handling routines }
  1282.  
  1283. procedure DatabaseError(const Message: string);
  1284. begin
  1285.   raise EDatabaseError.Create(Message);
  1286. end;
  1287.  
  1288. procedure DatabaseErrorFmt(const Message: string; const Args: array of const);
  1289. begin
  1290.   raise EDatabaseError.CreateFmt(Message, Args);
  1291. end;
  1292.  
  1293. procedure DBError(Ident: Word);
  1294. begin
  1295.   DatabaseError(LoadStr(Ident));
  1296. end;
  1297.  
  1298. procedure DBErrorFmt(Ident: Word; const Args: array of const);
  1299. begin
  1300.   DatabaseError(FmtLoadStr(Ident, Args));
  1301. end;
  1302.  
  1303. function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
  1304.   const FieldName: string): TField;
  1305. begin
  1306.   Result := DataSet.FindField(FieldName);
  1307.   if Result = nil then
  1308.     DatabaseErrorFmt(SFieldNotFound, [Control.Name, FieldName]);
  1309. end;
  1310.  
  1311. { Utility routines }
  1312.  
  1313. procedure DisposeMem(var Buffer; Size: Integer);
  1314. begin
  1315.   if Pointer(Buffer) <> nil then
  1316.   begin
  1317.     FreeMem(Pointer(Buffer), Size);
  1318.     Pointer(Buffer) := nil;
  1319.   end;
  1320. end;
  1321.  
  1322. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean; assembler;
  1323. asm
  1324.         PUSH    EDI
  1325.         PUSH    ESI
  1326.         MOV     ESI,Buf1
  1327.         MOV     EDI,Buf2
  1328.         XOR     EAX,EAX
  1329.         JECXZ   @@1
  1330.         CLD
  1331.         REPE    CMPSB
  1332.         JNE     @@1
  1333.         INC     EAX
  1334. @@1:    POP     ESI
  1335.         POP     EDI
  1336. end;
  1337.  
  1338. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  1339. var
  1340.   I: Integer;
  1341. begin
  1342.   I := Pos;
  1343.   while (I <= Length(Fields)) and (Fields[I] <> ';') do Inc(I);
  1344.   Result := Trim(Copy(Fields, Pos, I - Pos));
  1345.   if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I);
  1346.   Pos := I;
  1347. end;
  1348.  
  1349. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  1350. begin
  1351.   if Assigned(RegisterFieldsProc) then
  1352.     RegisterFieldsProc(FieldClasses) else
  1353.     DatabaseError(SInvalidFieldRegistration);
  1354. end;
  1355.  
  1356. { TDataSetDesigner }
  1357.  
  1358. constructor TDataSetDesigner.Create(DataSet: TDataSet);
  1359. begin
  1360.   FDataSet := DataSet;
  1361.   FDataSet.FDesigner := Self;
  1362. end;
  1363.  
  1364. destructor TDataSetDesigner.Destroy;
  1365. begin
  1366.   FDataSet.FDesigner := nil;
  1367. end;
  1368.  
  1369. procedure TDataSetDesigner.BeginDesign;
  1370. begin
  1371.   FSaveActive := FDataSet.Active;
  1372.   if FSaveActive then
  1373.   begin
  1374.     FDataSet.DoInternalClose;
  1375.     FDataSet.SetState(dsInactive);
  1376.   end;
  1377.   FDataSet.DisableControls;
  1378. end;
  1379.  
  1380. procedure TDataSetDesigner.DataEvent(Event: TDataEvent; Info: Longint);
  1381. begin
  1382. end;
  1383.  
  1384. procedure TDataSetDesigner.EndDesign;
  1385. begin
  1386.   FDataSet.EnableControls;
  1387.   if FSaveActive then
  1388.   begin
  1389.     try
  1390.       FDataSet.DoInternalOpen;
  1391.       FDataSet.SetState(dsBrowse);
  1392.     except
  1393.       FDataSet.SetState(dsInactive);
  1394.       FDataSet.CloseCursor;
  1395.       raise;
  1396.     end;
  1397.   end;
  1398. end;
  1399.  
  1400. { TFieldDef }
  1401.  
  1402. constructor TFieldDef.Create(Owner: TFieldDefs; const Name: string;
  1403.   DataType: TFieldType; Size: Word; Required: Boolean; FieldNo: Integer);
  1404. var
  1405.   FieldClass: TFieldClass;
  1406. begin
  1407.   FieldClass := Owner.FDataSet.GetFieldClass(DataType);
  1408.   if Assigned(FieldClass) then
  1409.     FieldClass.CheckTypeSize(Size);
  1410.   if Owner <> nil then
  1411.   begin
  1412.     Owner.FItems.Add(Self);
  1413.     Owner.FUpdated := False;
  1414.     FOwner := Owner;
  1415.   end;
  1416.   FName := Name;
  1417.   FDataType := DataType;
  1418.   FSize := Size;
  1419.   FRequired := Required;
  1420.   FFieldNo := FieldNo;
  1421. end;
  1422.  
  1423. destructor TFieldDef.Destroy;
  1424. begin
  1425.   if FOwner <> nil then
  1426.   begin
  1427.     FOwner.FItems.Remove(Self);
  1428.     FOwner.FUpdated := False;
  1429.   end;
  1430. end;
  1431.  
  1432. function TFieldDef.CreateField(Owner: TComponent): TField;
  1433. var
  1434.   FieldClass: TFieldClass;
  1435. begin
  1436.   FieldClass := GetFieldClass;
  1437.   if FieldClass = nil then DatabaseErrorFmt(SUnknownFieldType, [Name]);
  1438.   Result := FieldClass.Create(Owner);
  1439.   try
  1440.     Result.FieldName := Name;
  1441.     Result.Size := FSize;
  1442.     Result.Required := FRequired;
  1443.     Result.SetFieldType(FDataType);
  1444.     if Result is TBCDField then
  1445.       TBCDField(Result).FPrecision := Precision;
  1446.     if FOwner <> nil then Result.DataSet := FOwner.FDataSet;
  1447.   except
  1448.     Result.Free;
  1449.     raise;
  1450.   end;
  1451. end;
  1452.  
  1453. function TFieldDef.GetFieldClass: TFieldClass;
  1454. begin
  1455.   Result := FOwner.FDataSet.GetFieldClass(FDataType);
  1456. end;
  1457.  
  1458. { TFieldDefs }
  1459.  
  1460. constructor TFieldDefs.Create(DataSet: TDataSet);
  1461. begin
  1462.   FDataSet := DataSet;
  1463.   FItems := TList.Create;
  1464. end;
  1465.  
  1466. destructor TFieldDefs.Destroy;
  1467. begin
  1468.   if FItems <> nil then Clear;
  1469.   FItems.Free;
  1470. end;
  1471.  
  1472. procedure TFieldDefs.Add(const Name: string; DataType: TFieldType;
  1473.   Size: Word; Required: Boolean);
  1474. begin
  1475.   if Name = '' then DatabaseError(SFieldNameMissing);
  1476.   if IndexOf(Name) >= 0 then DatabaseErrorFmt(SDuplicateFieldName, [Name]);
  1477.   TFieldDef.Create(Self, Name, DataType, Size, Required, FItems.Count + 1);
  1478. end;
  1479.  
  1480. procedure TFieldDefs.Assign(FieldDefs: TFieldDefs);
  1481. var
  1482.   I: Integer;
  1483. begin
  1484.   Clear;
  1485.   for I := 0 to FieldDefs.Count - 1 do
  1486.     with FieldDefs[I] do Add(Name, DataType, Size, Required);
  1487. end;
  1488.  
  1489. procedure TFieldDefs.Clear;
  1490. begin
  1491.   while FItems.Count > 0 do TFieldDef(FItems.Last).Free;
  1492. end;
  1493.  
  1494. function TFieldDefs.Find(const Name: string): TFieldDef;
  1495. var
  1496.   I: Integer;
  1497. begin
  1498.   I := IndexOf(Name);
  1499.   if I < 0 then DatabaseErrorFmt(SFieldNotFound, [FDataset.Name, Name]);
  1500.   Result := FItems[I];
  1501. end;
  1502.  
  1503. function TFieldDefs.GetCount: Integer;
  1504. begin
  1505.   Result := FItems.Count;
  1506. end;
  1507.  
  1508. function TFieldDefs.GetItem(Index: Integer): TFieldDef;
  1509. begin
  1510.   Result := FItems[Index];
  1511. end;
  1512.  
  1513. function TFieldDefs.IndexOf(const Name: string): Integer;
  1514. begin
  1515.   for Result := 0 to FItems.Count - 1 do
  1516.     if AnsiCompareText(TFieldDef(FItems[Result]).Name, Name) = 0 then Exit;
  1517.   Result := -1;
  1518. end;
  1519.  
  1520. procedure TFieldDefs.Update;
  1521. begin
  1522.   FDataSet.UpdateFieldDefs;
  1523. end;
  1524.  
  1525. { TLookupList }
  1526.  
  1527. constructor TLookupList.Create;
  1528. begin
  1529.   FList := TList.Create;
  1530. end;
  1531.  
  1532. destructor TLookupList.Destroy;
  1533. begin
  1534.   if Assigned(FList) then Clear;
  1535.   FList.Free;
  1536. end;
  1537.  
  1538. procedure TLookupList.Add(const AKey, AValue: Variant);
  1539. var
  1540.   ListEntry: PLookupListEntry;
  1541. begin
  1542.   New(ListEntry);
  1543.   ListEntry.Key := AKey;
  1544.   ListEntry.Value := AValue;
  1545.   FList.Add(ListEntry);
  1546. end;
  1547.  
  1548. procedure TLookupList.Clear;
  1549. var
  1550.   I: Integer;
  1551. begin
  1552.   for I := 0 to FList.Count - 1 do
  1553.     Dispose(PLookupListEntry(FList.Items[I]));
  1554.   FList.Clear;
  1555. end;
  1556.  
  1557. function TLookupList.ValueOfKey(const AKey: Variant): Variant;
  1558. var
  1559.   I: Integer;
  1560. begin
  1561.   Result := Null;
  1562.   if not VarIsNull(AKey) then
  1563.     for I := 0 to FList.Count - 1 do
  1564.       if PLookupListEntry(FList.Items[I]).Key = AKey then
  1565.       begin
  1566.         Result := PLookupListEntry(FList.Items[I]).Value;
  1567.         Break;
  1568.       end;
  1569. end;
  1570.  
  1571. { TField }
  1572.  
  1573. constructor TField.Create(AOwner: TComponent);
  1574. begin
  1575.   inherited Create(AOwner);
  1576.   FVisible := True;
  1577.   FValidChars := [#0..#255];
  1578. end;
  1579.  
  1580. destructor TField.Destroy;
  1581. begin
  1582.   if FDataSet <> nil then
  1583.   begin
  1584.     FDataSet.Close;
  1585.     FDataSet.RemoveField(Self);
  1586.   end;
  1587.   FLookupList.Free;
  1588.   inherited Destroy;
  1589. end;
  1590.  
  1591. function TField.AccessError(const TypeName: string): EDatabaseError;
  1592. begin
  1593.   Result := EDatabaseError.Create(Format(SFieldAccessError,
  1594.     [DisplayName, TypeName]));
  1595. end;
  1596.  
  1597. procedure TField.Assign(Source: TPersistent);
  1598. begin
  1599.   if Source = nil then
  1600.   begin
  1601.     Clear;
  1602.     Exit;
  1603.   end;
  1604.   if Source is TField then
  1605.   begin
  1606.     Value := TField(Source).Value;
  1607.     Exit;
  1608.   end;
  1609.   inherited Assign(Source);
  1610. end;
  1611.  
  1612. procedure TField.AssignValue(const Value: TVarRec);
  1613.  
  1614.   procedure Error;
  1615.   begin
  1616.     DatabaseErrorFmt(SFieldValueError, [DisplayName]);
  1617.   end;
  1618.  
  1619. begin
  1620.   with Value do
  1621.     case VType of
  1622.       vtInteger:
  1623.         AsInteger := VInteger;
  1624.       vtBoolean:
  1625.         AsBoolean := VBoolean;
  1626.       vtChar:
  1627.         AsString := VChar;
  1628.       vtExtended:
  1629.         AsFloat := VExtended^;
  1630.       vtString:
  1631.         AsString := VString^;
  1632.       vtPointer:
  1633.         if VPointer <> nil then Error;
  1634.       vtPChar:
  1635.         AsString := VPChar;
  1636.       vtObject:
  1637.         if (VObject = nil) or (VObject is TPersistent) then
  1638.           Assign(TPersistent(VObject))
  1639.         else
  1640.           Error;
  1641.       vtAnsiString:
  1642.         AsString := string(VAnsiString);
  1643.       vtCurrency:
  1644.         AsCurrency := VCurrency^;
  1645.       vtVariant:
  1646.         if not VarIsEmpty(VVariant^) then AsVariant := VVariant^;
  1647.     else
  1648.       Error;
  1649.     end;
  1650. end;
  1651.  
  1652. procedure TField.Bind(Binding: Boolean);
  1653. begin
  1654.   if FFieldKind = fkLookup then
  1655.     if Binding then
  1656.     begin
  1657.       if FLookupCache then
  1658.         RefreshLookupList
  1659.       else
  1660.         ValidateLookupInfo(True);
  1661.    end;
  1662. end;
  1663.  
  1664. procedure TField.CalcLookupValue;
  1665. begin
  1666.   if FLookupCache then
  1667.     Value := LookupList.ValueOfKey(FDataSet.FieldValues[FKeyFields])
  1668.   else if (FLookupDataSet <> nil) and FLookupDataSet.Active then
  1669.     Value := FLookupDataSet.Lookup(FLookupKeyFields,
  1670.       FDataSet.FieldValues[FKeyFields], FLookupResultField);
  1671. end;
  1672.  
  1673. procedure TField.Change;
  1674. begin
  1675.   if Assigned(FOnChange) then FOnChange(Self);
  1676. end;
  1677.  
  1678. procedure TField.CheckInactive;
  1679. begin
  1680.   if FDataSet <> nil then FDataSet.CheckInactive;
  1681. end;
  1682.  
  1683. procedure TField.Clear;
  1684. begin
  1685.   SetData(nil);
  1686. end;
  1687.  
  1688. procedure TField.DataChanged;
  1689. begin
  1690.   FDataSet.DataEvent(deFieldChange, Longint(Self));
  1691. end;
  1692.  
  1693. procedure TField.DefineProperties(Filer: TFiler);
  1694.  
  1695.   function AttributeSetStored: Boolean;
  1696.   begin
  1697.     if Assigned(Filer.Ancestor) then
  1698.       Result := CompareText(FAttributeSet, TField(Filer.Ancestor).FAttributeSet) <> 0
  1699.     else
  1700.       Result := FAttributeSet <> '';
  1701.   end;
  1702.  
  1703.   function CalculatedStored: Boolean;
  1704.   begin
  1705.     if Assigned(Filer.Ancestor) then
  1706.       Result := Calculated <> TField(Filer.Ancestor).Calculated else
  1707.       Result := Calculated;
  1708.   end;
  1709.  
  1710.   function LookupStored: Boolean;
  1711.   begin
  1712.     if Assigned(Filer.Ancestor) then
  1713.       Result := Lookup <> TField(Filer.Ancestor).Lookup else
  1714.       Result := Lookup;
  1715.   end;
  1716.  
  1717. begin
  1718.   Filer.DefineProperty('AttributeSet', ReadAttributeSet, WriteAttributeSet,
  1719.     AttributeSetStored);
  1720.   { For backwards compatibility }
  1721.   Filer.DefineProperty('Calculated', ReadCalculated, WriteCalculated,
  1722.     CalculatedStored);
  1723.   Filer.DefineProperty('Lookup', ReadLookup, WriteLookup, LookupStored);
  1724. end;
  1725.  
  1726. function TField.FieldKindStored: Boolean;
  1727. begin
  1728.   Result := (FieldKind = fkInternalCalc);
  1729. end;
  1730.  
  1731. procedure TField.FocusControl;
  1732. var
  1733.   Field: TField;
  1734. begin
  1735.   if (FDataSet <> nil) and FDataSet.Active then
  1736.   begin
  1737.     Field := Self;
  1738.     FDataSet.DataEvent(deFocusControl, Longint(@Field));
  1739.   end;
  1740. end;
  1741.  
  1742. procedure TField.FreeBuffers;
  1743. begin
  1744. end;
  1745.  
  1746. function TField.GetAsBoolean: Boolean;
  1747. begin
  1748.   raise AccessError('Boolean'); { Do not localize }
  1749. end;
  1750.  
  1751. function TField.GetAsCurrency: Currency;
  1752. begin
  1753.   Result := GetAsFloat;
  1754. end;
  1755.  
  1756. function TField.GetAsDateTime: TDateTime;
  1757. begin
  1758.   raise AccessError('DateTime'); { Do not localize }
  1759. end;
  1760.  
  1761. function TField.GetAsFloat: Double;
  1762. begin
  1763.   raise AccessError('Float'); { Do not localize }
  1764. end;
  1765.  
  1766. function TField.GetAsInteger: Longint;
  1767. begin
  1768.   raise AccessError('Integer'); { Do not localize }
  1769. end;
  1770.  
  1771. function TField.GetAsString: string;
  1772. var
  1773.   I, L: Integer;
  1774.   S: string[63];
  1775. begin
  1776.   S := ClassName;
  1777.   I := 1;
  1778.   L := Length(S);
  1779.   if S[1] = 'T' then I := 2;
  1780.   if (L >= 5) and (CompareText(Copy(S, L - 4, 5), 'FIELD') = 0) then Dec(L, 5);
  1781.   FmtStr(Result, '(%s)', [Copy(S, I, L + 1 - I)]);
  1782.   if not IsNull then Result := AnsiUpperCase(Result);
  1783. end;
  1784.  
  1785. function TField.GetAsVariant: Variant;
  1786. begin
  1787.   raise AccessError('Variant'); { Do not localize }
  1788. end;
  1789.  
  1790. function TField.GetCalculated: Boolean;
  1791. begin
  1792.   Result := FFieldKind = fkCalculated;
  1793. end;
  1794.  
  1795. function TField.GetCanModify: Boolean;
  1796. begin
  1797.   if FieldNo > 0 then
  1798.     if DataSet.State <> dsSetKey then
  1799.       Result := not ReadOnly and DataSet.CanModify else
  1800.       Result := IsIndexField
  1801.   else
  1802.     Result := False;
  1803. end;
  1804.  
  1805. function TField.GetData(Buffer: Pointer): Boolean;
  1806. begin
  1807.   if FDataSet = nil then DatabaseErrorFmt(SDataSetMissing, [DisplayName]);
  1808.   if FValidating then
  1809.   begin
  1810.     Result := LongBool(FValueBuffer);
  1811.     if Result and (Buffer <> nil) then
  1812.        Move(FValueBuffer^, Buffer^, DataSize);
  1813.   end else
  1814.     Result := FDataSet.GetFieldData(Self, Buffer);
  1815. end;
  1816.  
  1817. function TField.GetDataSize: Word;
  1818. begin
  1819.   Result := 0;
  1820. end;
  1821.  
  1822. function TField.GetDefaultWidth: Integer;
  1823. begin
  1824.   Result := 10;
  1825. end;
  1826.  
  1827. function TField.GetDisplayLabel: string;
  1828. begin
  1829.   Result := GetDisplayName;
  1830. end;
  1831.  
  1832. function TField.GetDisplayName: string;
  1833. begin
  1834.   if FDisplayLabel <> '' then
  1835.     Result := FDisplayLabel else
  1836.     Result := FFieldName;
  1837. end;
  1838.  
  1839. function TField.GetDisplayText: string;
  1840. begin
  1841.   Result := '';
  1842.   if Assigned(FOnGetText) then
  1843.     FOnGetText(Self, Result, True) else
  1844.     GetText(Result, True);
  1845. end;
  1846.  
  1847. function TField.GetDisplayWidth: Integer;
  1848. begin
  1849.   if FDisplayWidth > 0 then
  1850.     Result := FDisplayWidth else
  1851.     Result := GetDefaultWidth;
  1852. end;
  1853.  
  1854. function TField.GetEditText: string;
  1855. begin
  1856.   Result := '';
  1857.   if Assigned(FOnGetText) then
  1858.     FOnGetText(Self, Result, False) else
  1859.     GetText(Result, False);
  1860. end;
  1861.  
  1862. function TField.GetHasConstraints: Boolean;
  1863. begin
  1864.   Result := (CustomConstraint <> '') or (ImportedConstraint <> '') or
  1865.    (DefaultExpression <> '');
  1866. end;
  1867.  
  1868. function TField.GetIndex: Integer;
  1869. begin
  1870.   if FDataSet <> nil then
  1871.     Result := FDataSet.FFields.IndexOf(Self) else
  1872.     Result := -1;
  1873. end;
  1874.  
  1875. function TField.GetIsIndexField: Boolean;
  1876. begin
  1877.   if FDataSet <> nil then
  1878.     Result := DataSet.GetIsIndexField(Self) else
  1879.     Result := False;
  1880. end;
  1881.  
  1882. class function TField.IsBlob: Boolean;
  1883. begin
  1884.   Result := False;
  1885. end;
  1886.  
  1887. function TField.GetIsNull: Boolean;
  1888. begin
  1889.   Result := not GetData(nil);
  1890. end;
  1891.  
  1892. function TField.GetLookup: Boolean;
  1893. begin
  1894.   Result := FFieldKind = fkLookup;
  1895. end;
  1896.  
  1897. function TField.GetLookupList: TLookupList;
  1898. begin
  1899.   if not Assigned(FLookupList) then
  1900.     FLookupList := TLookupList.Create;
  1901.   Result := FLookupList;
  1902. end;
  1903.  
  1904. procedure TField.GetText(var Text: string; DisplayText: Boolean);
  1905. begin
  1906.   Text := GetAsString;
  1907. end;
  1908.  
  1909. function TField.HasParent: Boolean;
  1910. begin
  1911.   HasParent := True;
  1912. end;
  1913.  
  1914. function TField.GetNewValue: Variant;
  1915. begin
  1916.   Result := DataSet.GetStateFieldValue(dsNewValue, Self);
  1917. end;
  1918.  
  1919. function TField.GetOldValue: Variant;
  1920. begin
  1921.   Result := DataSet.GetStateFieldValue(dsOldValue, Self);
  1922. end;
  1923.  
  1924. function TField.GetCurValue: Variant;
  1925. begin
  1926.   Result := DataSet.GetStateFieldValue(dsCurValue, Self);
  1927. end;
  1928.  
  1929. function TField.GetParentComponent: TComponent;
  1930. begin
  1931.   Result := DataSet;
  1932. end;
  1933.  
  1934. procedure TField.SetParentComponent(AParent: TComponent);
  1935. begin
  1936.   if not (csLoading in ComponentState) then DataSet := AParent as TDataSet;
  1937. end;
  1938.  
  1939. function TField.IsValidChar(InputChar: Char): Boolean;
  1940. begin
  1941.   Result := InputChar in ValidChars;
  1942. end;
  1943.  
  1944. function TField.IsDisplayLabelStored: Boolean;
  1945. begin
  1946.   Result := FDisplayLabel <> '';
  1947. end;
  1948.  
  1949. function TField.IsDisplayWidthStored: Boolean;
  1950. begin
  1951.   Result := FDisplayWidth > 0;
  1952. end;
  1953.  
  1954. procedure TField.Notification(AComponent: TComponent;
  1955.   Operation: TOperation);
  1956. begin
  1957.   inherited Notification(AComponent, Operation);
  1958.   if (Operation = opRemove) and (AComponent = FLookupDataSet) then
  1959.     FLookupDataSet := nil;
  1960. end;
  1961.  
  1962. procedure TField.PropertyChanged(LayoutAffected: Boolean);
  1963. const
  1964.   Events: array[Boolean] of TDataEvent = (deDataSetChange, deLayoutChange);
  1965. begin
  1966.   if (FDataSet <> nil) and FDataSet.Active then
  1967.     FDataSet.DataEvent(Events[LayoutAffected], 0);
  1968. end;
  1969.  
  1970. procedure TField.ReadAttributeSet(Reader: TReader);
  1971. begin
  1972.   FAttributeSet := Reader.ReadString;
  1973. end;
  1974.  
  1975. procedure TField.ReadCalculated(Reader: TReader);
  1976. begin
  1977.   if Reader.ReadBoolean then
  1978.     FFieldKind := fkCalculated;
  1979. end;
  1980.  
  1981. procedure TField.ReadLookup(Reader: TReader);
  1982. begin
  1983.   if Reader.ReadBoolean then
  1984.     FFieldKind := fkLookup;
  1985. end;
  1986.  
  1987. procedure TField.ReadState(Reader: TReader);
  1988. begin
  1989.   inherited ReadState(Reader);
  1990.   if Reader.Parent is TDataSet then DataSet := TDataSet(Reader.Parent);
  1991. end;
  1992.  
  1993. procedure TField.RefreshLookupList;
  1994. var
  1995.   WasActive: Boolean;
  1996. begin
  1997.   if Assigned(FLookupDataSet) then
  1998.   begin
  1999.     WasActive := FLookupDataSet.Active;
  2000.     ValidateLookupInfo(True);
  2001.     with FLookupDataSet do
  2002.     try
  2003.       LookupList.Clear;
  2004.       DisableControls;
  2005.       try
  2006.         First;
  2007.         while not EOF do
  2008.         begin
  2009.           FLookupList.Add(FieldValues[FLookupKeyFields],
  2010.             FieldValues[FLookupResultField]);
  2011.           Next;
  2012.         end;
  2013.       finally
  2014.         EnableControls;
  2015.       end;
  2016.     finally
  2017.       Active := WasActive;
  2018.     end;
  2019.   end
  2020.   else
  2021.     ValidateLookupInfo(False);
  2022. end;
  2023.  
  2024. procedure TField.SetAsBoolean(Value: Boolean);
  2025. begin
  2026.   raise AccessError('Boolean'); { Do not localize }
  2027. end;
  2028.  
  2029. procedure TField.SetAsCurrency(Value: Currency);
  2030. begin
  2031.   SetAsFloat(Value);
  2032. end;
  2033.  
  2034. procedure TField.SetAsDateTime(Value: TDateTime);
  2035. begin
  2036.   raise AccessError('DateTime'); { Do not localize }
  2037. end;
  2038.  
  2039. procedure TField.SetAsFloat(Value: Double);
  2040. begin
  2041.   raise AccessError('Float'); { Do not localize }
  2042. end;
  2043.  
  2044. procedure TField.SetAsInteger(Value: Longint);
  2045. begin
  2046.   raise AccessError('Integer'); { Do not localize }
  2047. end;
  2048.  
  2049. procedure TField.SetAsString(const Value: string);
  2050. begin
  2051.   raise AccessError('String'); { Do not localize }
  2052. end;
  2053.  
  2054. procedure TField.SetAsVariant(const Value: Variant);
  2055. begin
  2056.   if VarIsNull(Value) then
  2057.     Clear
  2058.   else
  2059.     try
  2060.       SetVarValue(Value);
  2061.     except
  2062.       on EVariantError do DatabaseErrorFmt(SFieldValueError, [DisplayName]);
  2063.     end;
  2064. end;
  2065.  
  2066. procedure TField.SetAlignment(Value: TAlignment);
  2067. begin
  2068.   if FAlignment <> Value then
  2069.   begin
  2070.     FAlignment := Value;
  2071.     PropertyChanged(False);
  2072.   end;
  2073. end;
  2074.  
  2075. procedure TField.SetCalculated(Value: Boolean);
  2076. begin
  2077.   if Value then
  2078.     FieldKind := fkCalculated
  2079.   else if FieldKind = fkCalculated then
  2080.     FieldKind := fkData;
  2081. end;
  2082.  
  2083. procedure TField.SetData(Buffer: Pointer);
  2084. begin
  2085.   if FDataSet = nil then DatabaseErrorFmt(SDataSetMissing, [DisplayName]);
  2086.   FDataSet.SetFieldData(Self, Buffer);
  2087. end;
  2088.  
  2089. procedure TField.SetDataSet(ADataSet: TDataSet);
  2090. begin
  2091.   if ADataset <> FDataset then
  2092.   begin
  2093.     if FDataSet <> nil then FDataSet.CheckInactive;
  2094.     if ADataSet <> nil then
  2095.     begin
  2096.       ADataSet.CheckInactive;
  2097.       ADataSet.CheckFieldName(FFieldName);
  2098.     end;
  2099.     if FDataSet <> nil then FDataSet.RemoveField(Self);
  2100.     if ADataSet <> nil then ADataSet.AddField(Self);
  2101.   end;
  2102. end;
  2103.  
  2104. procedure TField.SetDataType(Value: TFieldType);
  2105. begin
  2106.   FDataType := Value;
  2107. end;
  2108.  
  2109. procedure TField.SetDisplayLabel(Value: string);
  2110. begin
  2111.   if Value = FFieldName then Value := '';
  2112.   if FDisplayLabel <> Value then
  2113.   begin
  2114.     FDisplaylabel := Value;
  2115.     PropertyChanged(True);
  2116.   end;
  2117. end;
  2118.  
  2119. procedure TField.SetDisplayWidth(Value: Integer);
  2120. begin
  2121.   if FDisplayWidth <> Value then
  2122.   begin
  2123.     FDisplayWidth := Value;
  2124.     PropertyChanged(True);
  2125.   end;
  2126. end;
  2127.  
  2128. procedure TField.SetEditMask(const Value: string);
  2129. begin
  2130.   FEditMask := Value;
  2131.   PropertyChanged(False);
  2132. end;
  2133.  
  2134. procedure TField.SetEditText(const Value: string);
  2135. begin
  2136.   if Assigned(FOnSetText) then FOnSetText(Self, Value) else SetText(Value);
  2137. end;
  2138.  
  2139. procedure TField.SetFieldKind(Value: TFieldKind);
  2140. begin
  2141.   if FFieldKind <> Value then
  2142.   begin
  2143.     if Assigned(DataSet) and Assigned(DataSet.FDesigner) then
  2144.     with DataSet.Designer do
  2145.     begin
  2146.       BeginDesign;
  2147.       try
  2148.         FFieldKind := Value;
  2149.       finally
  2150.         EndDesign;
  2151.       end;
  2152.     end else
  2153.     begin
  2154.       CheckInactive;
  2155.       FFieldKind := Value;
  2156.     end;
  2157.   end;
  2158. end;
  2159.  
  2160. procedure TField.SetFieldName(const Value: string);
  2161. begin
  2162.   CheckInactive;
  2163.   if FDataSet <> nil then FDataSet.CheckFieldName(Value);
  2164.   FFieldName := Value;
  2165.   if FDisplayLabel = Value then FDisplayLabel := '';
  2166.   if FDataSet <> nil then FDataSet.DataEvent(deFieldListChange, 0);
  2167. end;
  2168.  
  2169. procedure TField.SetFieldType(Value: TFieldType);
  2170. begin
  2171. end;
  2172.  
  2173. procedure TField.SetIndex(Value: Integer);
  2174. var
  2175.   CurIndex, Count: Integer;
  2176. begin
  2177.   CurIndex := GetIndex;
  2178.   if CurIndex >= 0 then
  2179.   begin
  2180.     Count := FDataSet.FFields.Count;
  2181.     if Value < 0 then Value := 0;
  2182.     if Value >= Count then Value := Count - 1;
  2183.     if Value <> CurIndex then
  2184.     begin
  2185.       FDataSet.FFields.Delete(CurIndex);
  2186.       FDataSet.FFields.Insert(Value, Self);
  2187.       PropertyChanged(True);
  2188.       FDataSet.DataEvent(deFieldListChange, 0);
  2189.     end;
  2190.   end;
  2191. end;
  2192.  
  2193. procedure TField.SetLookup(Value: Boolean);
  2194. begin
  2195.   if Value then
  2196.     FieldKind := fkLookup
  2197.   else if FieldKind = fkLookup then
  2198.     FieldKind := fkData;
  2199. end;
  2200.  
  2201. procedure TField.SetLookupDataSet(Value: TDataSet);
  2202. begin
  2203.   CheckInactive;
  2204.   if (Value <> nil) and (Value = FDataSet) then DatabaseError(SCircularDataLink);
  2205.   FLookupDataSet := Value;
  2206. end;
  2207.  
  2208. procedure TField.SetLookupKeyFields(const Value: string);
  2209. begin
  2210.   CheckInactive;
  2211.   FLookupKeyFields := Value;
  2212. end;
  2213.  
  2214. procedure TField.SetLookupResultField(const Value: string);
  2215. begin
  2216.   CheckInactive;
  2217.   FLookupResultField := Value;
  2218. end;
  2219.  
  2220. procedure TField.SetKeyFields(const Value: string);
  2221. begin
  2222.   CheckInactive;
  2223.   FKeyFields := Value;
  2224. end;
  2225.  
  2226. procedure TField.SetNewValue(const Value: Variant);
  2227. begin
  2228.   DataSet.SetStateFieldValue(dsNewValue, Self, Value);
  2229. end;
  2230.  
  2231. procedure TField.SetLookupCache(const Value: Boolean);
  2232. begin
  2233.   CheckInactive;
  2234.   FLookupCache := Value;
  2235. end;
  2236.  
  2237. class procedure TField.CheckTypeSize(Value: Integer);
  2238. begin
  2239.   if (Value <> 0) and not IsBlob then DatabaseError(SInvalidFieldSize);
  2240. end;
  2241.  
  2242. procedure TField.SetSize(Value: Word);
  2243. begin
  2244.   CheckInactive;
  2245.   CheckTypeSize(Value);
  2246.   FSize := Value;
  2247. end;
  2248.  
  2249. procedure TField.SetText(const Value: string);
  2250. begin
  2251.   SetAsString(Value);
  2252. end;
  2253.  
  2254. procedure TField.SetReadOnly(const Value: Boolean);
  2255. begin
  2256.   if FReadOnly <> Value then
  2257.   begin
  2258.     FReadOnly := Value;
  2259.     PropertyChanged(True);
  2260.   end;
  2261. end;
  2262.  
  2263. procedure TField.SetVarValue(const Value: Variant);
  2264. begin
  2265.   raise AccessError('Variant'); { Do not localize }
  2266. end;
  2267.  
  2268. procedure TField.SetVisible(Value: Boolean);
  2269. begin
  2270.   if FVisible <> Value then
  2271.   begin
  2272.     FVisible := Value;
  2273.     PropertyChanged(True);
  2274.   end;
  2275. end;
  2276.  
  2277. procedure TField.Validate(Buffer: Pointer);
  2278. begin
  2279.   if Assigned(OnValidate) then
  2280.   begin
  2281.     FValueBuffer := Buffer;
  2282.     FValidating := True;
  2283.     try
  2284.       OnValidate(Self);
  2285.     finally
  2286.       FValidating := False;
  2287.     end;
  2288.   end;
  2289. end;
  2290.  
  2291. procedure TField.ValidateLookupInfo(All: Boolean);
  2292. begin
  2293.   if (All and ((FLookupDataSet = nil) or (FLookupKeyFields = '') or
  2294.      (FLookupResultField = ''))) or (FKeyFields = '') then
  2295.     DatabaseErrorFmt(SLookupInfoError, [DisplayName]);
  2296.   FDataSet.CheckFieldNames(FKeyFields);
  2297.   if All then
  2298.   begin
  2299.     FLookupDataSet.Open;
  2300.     FLookupDataSet.CheckFieldNames(FLookupKeyFields);
  2301.     FLookupDataSet.FieldByName(FLookupResultField);
  2302.   end;
  2303. end;
  2304.  
  2305. procedure TField.WriteAttributeSet(Writer: TWriter);
  2306. begin
  2307.   Writer.WriteString(FAttributeSet);
  2308. end;
  2309.  
  2310. procedure TField.WriteCalculated(Writer: TWriter);
  2311. begin
  2312.   Writer.WriteBoolean(True);
  2313. end;
  2314.  
  2315. procedure TField.WriteLookup(Writer: TWriter);
  2316. begin
  2317.   Writer.WriteBoolean(True);
  2318. end;
  2319.  
  2320. { TStringField }
  2321.  
  2322. constructor TStringField.Create(AOwner: TComponent);
  2323. begin
  2324.   inherited Create(AOwner);
  2325.   SetDataType(ftString);
  2326.   Size := 20;
  2327.   Transliterate := True;
  2328. end;
  2329.  
  2330. class procedure TStringField.CheckTypeSize(Value: Integer);
  2331. begin
  2332.   if (Value < 1) or (Value > dsMaxStringSize) then DatabaseError(SInvalidFieldSize);
  2333. end;
  2334.  
  2335. function TStringField.GetAsBoolean: Boolean;
  2336. var
  2337.   S: string;
  2338. begin
  2339.   S := GetAsString;
  2340.   Result := (Length(S) > 0) and (S[1] in ['T', 't', 'Y', 'y']);
  2341. end;
  2342.  
  2343. function TStringField.GetAsDateTime: TDateTime;
  2344. begin
  2345.   Result := StrToDateTime(GetAsString);
  2346. end;
  2347.  
  2348. function TStringField.GetAsFloat: Double;
  2349. begin
  2350.   Result := StrToFloat(GetAsString);
  2351. end;
  2352.  
  2353. function TStringField.GetAsInteger: Longint;
  2354. begin
  2355.   Result := StrToInt(GetAsString);
  2356. end;
  2357.  
  2358. function TStringField.GetAsString: string;
  2359. begin
  2360.   if not GetValue(Result) then Result := '';
  2361. end;
  2362.  
  2363. function TStringField.GetAsVariant: Variant;
  2364. var
  2365.   S: string;
  2366. begin
  2367.   if GetValue(S) then Result := S else Result := Null;
  2368. end;
  2369.  
  2370. function TStringField.GetDataSize: Word;
  2371. begin
  2372.   Result := Size + 1;
  2373. end;
  2374.  
  2375. function TStringField.GetDefaultWidth: Integer;
  2376. begin
  2377.   Result := Size;
  2378. end;
  2379.  
  2380. procedure TStringField.GetText(var Text: string; DisplayText: Boolean);
  2381. begin
  2382.   if DisplayText and (EditMaskPtr <> '') then
  2383.     Text := FormatMaskText(EditMaskPtr, GetAsString) else
  2384.     Text := GetAsString;
  2385. end;
  2386.  
  2387. function TStringField.GetValue(var Value: string): Boolean;
  2388. var
  2389.   Buffer: array[0..dsMaxStringSize] of Char;
  2390. begin
  2391.   Result := GetData(@Buffer);
  2392.   if Result then
  2393.   begin
  2394.     Value := Buffer;
  2395.     if Transliterate and (Value <> '') then
  2396.       DataSet.Translate(PChar(Value), PChar(Value), False);
  2397.   end;
  2398. end;
  2399.  
  2400. procedure TStringField.SetAsBoolean(Value: Boolean);
  2401. const
  2402.   Values: array[Boolean] of string[1] = ('F', 'T');
  2403. begin
  2404.   SetAsString(Values[Value]);
  2405. end;
  2406.  
  2407. procedure TStringField.SetAsDateTime(Value: TDateTime);
  2408. begin
  2409.   SetAsString(DateTimeToStr(Value));
  2410. end;
  2411.  
  2412. procedure TStringField.SetAsFloat(Value: Double);
  2413. begin
  2414.   SetAsString(FloatToStr(Value));
  2415. end;
  2416.  
  2417. procedure TStringField.SetAsInteger(Value: Longint);
  2418. begin
  2419.   SetAsString(IntToStr(Value));
  2420. end;
  2421.  
  2422. procedure TStringField.SetAsString(const Value: string);
  2423. var
  2424.   Buffer: array[0..dsMaxStringSize] of Char;
  2425. begin
  2426.   StrLCopy(Buffer, PChar(Value), Size);
  2427.   if Transliterate then
  2428.     DataSet.Translate(Buffer, Buffer, True);
  2429.   SetData(@Buffer);
  2430. end;
  2431.  
  2432. procedure TStringField.SetVarValue(const Value: Variant);
  2433. begin
  2434.   SetAsString(Value);
  2435. end;
  2436.  
  2437. { TNumericField }
  2438.  
  2439. constructor TNumericField.Create(AOwner: TComponent);
  2440. begin
  2441.   inherited Create(AOwner);
  2442.   Alignment := taRightJustify;
  2443. end;
  2444.  
  2445. procedure TNumericField.RangeError(Value, Min, Max: Extended);
  2446. begin
  2447.   DatabaseErrorFmt(SFieldRangeError, [Value, DisplayName, Min, Max]);
  2448. end;
  2449.  
  2450. procedure TNumericField.SetDisplayFormat(const Value: string);
  2451. begin
  2452.   if FDisplayFormat <> Value then
  2453.   begin
  2454.     FDisplayFormat := Value;
  2455.     PropertyChanged(False);
  2456.   end;
  2457. end;
  2458.  
  2459. procedure TNumericField.SetEditFormat(const Value: string);
  2460. begin
  2461.   if FEditFormat <> Value then
  2462.   begin
  2463.     FEditFormat := Value;
  2464.     PropertyChanged(False);
  2465.   end;
  2466. end;
  2467.  
  2468. { TIntegerField }
  2469.  
  2470. constructor TIntegerField.Create(AOwner: TComponent);
  2471. begin
  2472.   inherited Create(AOwner);
  2473.   SetDataType(ftInteger);
  2474.   FMinRange := Low(Longint);
  2475.   FMaxRange := High(Longint);
  2476.   ValidChars := ['+', '-', '0'..'9'];
  2477. end;
  2478.  
  2479. procedure TIntegerField.CheckRange(Value, Min, Max: Longint);
  2480. begin
  2481.   if (Value < Min) or (Value > Max) then RangeError(Value, Min, Max);
  2482. end;
  2483.  
  2484. function TIntegerField.GetAsFloat: Double;
  2485. begin
  2486.   Result := GetAsInteger;
  2487. end;
  2488.  
  2489. function TIntegerField.GetAsInteger: Longint;
  2490. begin
  2491.   if not GetValue(Result) then Result := 0;
  2492. end;
  2493.  
  2494. function TIntegerField.GetAsString: string;
  2495. var
  2496.   L: Longint;
  2497. begin
  2498.   if GetValue(L) then Str(L, Result) else Result := '';
  2499. end;
  2500.  
  2501. function TIntegerField.GetAsVariant: Variant;
  2502. var
  2503.   L: Longint;
  2504. begin
  2505.   if GetValue(L) then Result := L else Result := Null;
  2506. end;
  2507.  
  2508. function TIntegerField.GetDataSize: Word;
  2509. begin
  2510.   Result := SizeOf(Integer);
  2511. end;
  2512.  
  2513. procedure TIntegerField.GetText(var Text: string; DisplayText: Boolean);
  2514. var
  2515.   L: Longint;
  2516.   FmtStr: string;
  2517. begin
  2518.   if GetValue(L) then
  2519.   begin
  2520.     if DisplayText or (FEditFormat = '') then
  2521.       FmtStr := FDisplayFormat else
  2522.       FmtStr := FEditFormat;
  2523.     if FmtStr = '' then Str(L, Text) else Text := FormatFloat(FmtStr, L);
  2524.   end else
  2525.     Text := '';
  2526. end;
  2527.  
  2528. function TIntegerField.GetValue(var Value: Longint): Boolean;
  2529. var
  2530.   Data: record
  2531.     case Integer of
  2532.       0: (I: Smallint);
  2533.       1: (W: Word);
  2534.       2: (L: Longint);
  2535.   end;
  2536. begin
  2537.   Result := GetData(@Data);
  2538.   if Result then
  2539.     case DataType of
  2540.       ftSmallint: Value := Data.I;
  2541.       ftWord: Value := Data.W;
  2542.     else
  2543.       Value := Data.L;
  2544.     end;
  2545. end;
  2546.  
  2547. procedure TIntegerField.SetAsFloat(Value: Double);
  2548. begin
  2549.   SetAsInteger(Round(Value));
  2550. end;
  2551.  
  2552. procedure TIntegerField.SetAsInteger(Value: Longint);
  2553. begin
  2554.   if (FMinValue <> 0) or (FMaxValue <> 0) then
  2555.     CheckRange(Value, FMinValue, FMaxValue) else
  2556.     CheckRange(Value, FMinRange, FMaxRange);
  2557.   SetData(@Value);
  2558. end;
  2559.  
  2560. procedure TIntegerField.SetAsString(const Value: string);
  2561. var
  2562.   E: Integer;
  2563.   L: Longint;
  2564. begin
  2565.   if Value = '' then Clear else
  2566.   begin
  2567.     Val(Value, L, E);
  2568.     if E <> 0 then DatabaseErrorFmt(SInvalidIntegerValue, [Value, DisplayName]);
  2569.     SetAsInteger(L);
  2570.   end;
  2571. end;
  2572.  
  2573. procedure TIntegerField.SetMaxValue(Value: Longint);
  2574. begin
  2575.   CheckRange(Value, FMinRange, FMaxRange);
  2576.   FMaxValue := Value;
  2577. end;
  2578.  
  2579. procedure TIntegerField.SetMinValue(Value: Longint);
  2580. begin
  2581.   CheckRange(Value, FMinRange, FMaxRange);
  2582.   FMinValue := Value;
  2583. end;
  2584.  
  2585. procedure TIntegerField.SetVarValue(const Value: Variant);
  2586. begin
  2587.   SetAsInteger(Value);
  2588. end;
  2589.  
  2590. { TSmallintField }
  2591.  
  2592. constructor TSmallintField.Create(AOwner: TComponent);
  2593. begin
  2594.   inherited Create(AOwner);
  2595.   SetDataType(ftSmallint);
  2596.   FMinRange := Low(Smallint);
  2597.   FMaxRange := High(Smallint);
  2598. end;
  2599.  
  2600. function TSmallintField.GetDataSize: Word;
  2601. begin
  2602.   Result := SizeOf(SmallInt);
  2603. end;
  2604.  
  2605. { TWordField }
  2606.  
  2607. constructor TWordField.Create(AOwner: TComponent);
  2608. begin
  2609.   inherited Create(AOwner);
  2610.   SetDataType(ftWord);
  2611.   FMinRange := Low(Word);
  2612.   FMaxRange := High(Word);
  2613. end;
  2614.  
  2615. function TWordField.GetDataSize: Word;
  2616. begin
  2617.   Result := SizeOf(Word);
  2618. end;
  2619.  
  2620. { TAutoIncField }
  2621.  
  2622. constructor TAutoIncField.Create(AOwner: TComponent);
  2623. begin
  2624.   inherited Create(AOwner);
  2625.   SetDataType(ftAutoInc);
  2626. end;
  2627.  
  2628. { TFloatField }
  2629.  
  2630. constructor TFloatField.Create(AOwner: TComponent);
  2631. begin
  2632.   inherited Create(AOwner);
  2633.   SetDataType(ftFloat);
  2634.   FPrecision := 15;
  2635.   ValidChars := [DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
  2636. end;
  2637.  
  2638. function TFloatField.GetAsFloat: Double;
  2639. begin
  2640.   if not GetData(@Result) then Result := 0;
  2641. end;
  2642.  
  2643. function TFloatField.GetAsInteger: Longint;
  2644. begin
  2645.   Result := Round(GetAsFloat);
  2646. end;
  2647.  
  2648. function TFloatField.GetAsString: string;
  2649. var
  2650.   F: Double;
  2651. begin
  2652.   if GetData(@F) then Result := FloatToStr(F) else Result := '';
  2653. end;
  2654.  
  2655. function TFloatField.GetAsVariant: Variant;
  2656. var
  2657.   F: Double;
  2658. begin
  2659.   if GetData(@F) then Result := F else Result := Null;
  2660. end;
  2661.  
  2662. function TFloatField.GetDataSize: Word;
  2663. begin
  2664.   Result := SizeOf(Double);
  2665. end;
  2666.  
  2667. procedure TFloatField.GetText(var Text: string; DisplayText: Boolean);
  2668. var
  2669.   Format: TFloatFormat;
  2670.   FmtStr: string;
  2671.   Digits: Integer;
  2672.   F: Double;
  2673. begin
  2674.   if GetData(@F) then
  2675.   begin
  2676.     if DisplayText or (FEditFormat = '') then
  2677.       FmtStr := FDisplayFormat else
  2678.       FmtStr := FEditFormat;
  2679.     if FmtStr = '' then
  2680.     begin
  2681.       if FCurrency then
  2682.       begin
  2683.         if DisplayText then Format := ffCurrency else Format := ffFixed;
  2684.         Digits := CurrencyDecimals;
  2685.       end
  2686.       else begin
  2687.         Format := ffGeneral;
  2688.         Digits := 0;
  2689.       end;
  2690.       Text := FloatToStrF(F, Format, FPrecision, Digits);
  2691.     end else
  2692.       Text := FormatFloat(FmtStr, F);
  2693.   end else
  2694.     Text := '';
  2695. end;
  2696.  
  2697. procedure TFloatField.SetAsFloat(Value: Double);
  2698. begin
  2699.   if FCheckRange and ((Value < FMinValue) or (Value > FMaxValue)) then
  2700.     RangeError(Value, FMinValue, FMaxValue);
  2701.   SetData(@Value);
  2702. end;
  2703.  
  2704. procedure TFloatField.SetAsInteger(Value: Longint);
  2705. begin
  2706.   SetAsFloat(Value);
  2707. end;
  2708.  
  2709. procedure TFloatField.SetAsString(const Value: string);
  2710. var
  2711.   F: Extended;
  2712. begin
  2713.   if Value = '' then Clear else
  2714.   begin
  2715.     if not TextToFloat(PChar(Value), F, fvExtended) then
  2716.       DatabaseErrorFmt(SInvalidFloatValue, [Value, DisplayName]);
  2717.     SetAsFloat(F);
  2718.   end;
  2719. end;
  2720.  
  2721. procedure TFloatField.SetCurrency(Value: Boolean);
  2722. begin
  2723.   if FCurrency <> Value then
  2724.   begin
  2725.     FCurrency := Value;
  2726.     PropertyChanged(False);
  2727.   end;
  2728. end;
  2729.  
  2730. procedure TFloatField.SetMaxValue(Value: Double);
  2731. begin
  2732.   FMaxValue := Value;
  2733.   UpdateCheckRange;
  2734. end;
  2735.  
  2736. procedure TFloatField.SetMinValue(Value: Double);
  2737. begin
  2738.   FMinValue := Value;
  2739.   UpdateCheckRange;
  2740. end;
  2741.  
  2742. procedure TFloatField.SetPrecision(Value: Integer);
  2743. begin
  2744.   if Value < 2 then Value := 2;
  2745.   if Value > 15 then Value := 15;
  2746.   if FPrecision <> Value then
  2747.   begin
  2748.     FPrecision := Value;
  2749.     PropertyChanged(False);
  2750.   end;
  2751. end;
  2752.  
  2753. procedure TFloatField.SetVarValue(const Value: Variant);
  2754. begin
  2755.   SetAsFloat(Value);
  2756. end;
  2757.  
  2758. procedure TFloatField.UpdateCheckRange;
  2759. begin
  2760.   FCheckRange := (FMinValue <> 0) or (FMaxValue <> 0);
  2761. end;
  2762.  
  2763. { TCurrencyField }
  2764.  
  2765. constructor TCurrencyField.Create(AOwner: TComponent);
  2766. begin
  2767.   inherited Create(AOwner);
  2768.   SetDataType(ftCurrency);
  2769.   FCurrency := True;
  2770. end;
  2771.  
  2772. { TBooleanField }
  2773.  
  2774. constructor TBooleanField.Create(AOwner: TComponent);
  2775. begin
  2776.   inherited Create(AOwner);
  2777.   SetDataType(ftBoolean);
  2778.   LoadTextValues;
  2779. end;
  2780.  
  2781. function TBooleanField.GetAsBoolean: Boolean;
  2782. var
  2783.   B: WordBool;
  2784. begin
  2785.   if GetData(@B) then Result := B else Result := False;
  2786. end;
  2787.  
  2788. function TBooleanField.GetAsString: string;
  2789. var
  2790.   B: WordBool;
  2791. begin
  2792.   if GetData(@B) then Result := FTextValues[B] else Result := '';
  2793. end;
  2794.  
  2795. function TBooleanField.GetAsVariant: Variant;
  2796. var
  2797.   B: WordBool;
  2798. begin
  2799.   if GetData(@B) then Result := B else Result := Null;
  2800. end;
  2801.  
  2802. function TBooleanField.GetDataSize: Word;
  2803. begin
  2804.   Result := SizeOf(WordBool);
  2805. end;
  2806.  
  2807. function TBooleanField.GetDefaultWidth: Integer;
  2808. begin
  2809.   if Length(FTextValues[False]) > Length(FTextValues[True]) then
  2810.     Result := Length(FTextValues[False]) else
  2811.     Result := Length(FTextValues[True]);
  2812. end;
  2813.  
  2814. procedure TBooleanField.LoadTextValues;
  2815. begin
  2816.   FTextValues[False] := STextFalse;
  2817.   FTextValues[True] := STextTrue;
  2818. end;
  2819.  
  2820. procedure TBooleanField.SetAsBoolean(Value: Boolean);
  2821. var
  2822.   B: WordBool;
  2823. begin
  2824.   if Value then Word(B) := 1 else Word(B) := 0;
  2825.   SetData(@B);
  2826. end;
  2827.  
  2828. procedure TBooleanField.SetAsString(const Value: string);
  2829. var
  2830.   L: Integer;
  2831. begin
  2832.   L := Length(Value);
  2833.   if L = 0 then
  2834.   begin
  2835.     if Length(FTextValues[False]) = 0 then SetAsBoolean(False) else
  2836.       if Length(FTextValues[True]) = 0 then SetAsBoolean(True) else
  2837.         Clear;
  2838.   end else
  2839.   begin
  2840.     if AnsiCompareText(Value, Copy(FTextValues[False], 1, L)) = 0 then
  2841.       SetAsBoolean(False)
  2842.     else
  2843.       if AnsiCompareText(Value, Copy(FTextValues[True], 1, L)) = 0 then
  2844.         SetAsBoolean(True)
  2845.       else
  2846.         DatabaseErrorFmt(SInvalidBoolValue, [Value, DisplayName]);
  2847.   end;
  2848. end;
  2849.  
  2850. procedure TBooleanField.SetDisplayValues(const Value: string);
  2851. var
  2852.   P: Integer;
  2853. begin
  2854.   if FDisplayValues <> Value then
  2855.   begin
  2856.     FDisplayValues := Value;
  2857.     if Value = '' then LoadTextValues else
  2858.     begin
  2859.       P := Pos(';', Value);
  2860.       if P = 0 then P := 256;
  2861.       FTextValues[False] := Copy(Value, P + 1, 255);
  2862.       FTextValues[True] := Copy(Value, 1, P - 1);
  2863.     end;
  2864.     PropertyChanged(True);
  2865.   end;
  2866. end;
  2867.  
  2868. procedure TBooleanField.SetVarValue(const Value: Variant);
  2869. begin
  2870.   SetAsBoolean(Value);
  2871. end;
  2872.  
  2873. { TDateTimeField }
  2874.  
  2875. constructor TDateTimeField.Create(AOwner: TComponent);
  2876. begin
  2877.   inherited Create(AOwner);
  2878.   SetDataType(ftDateTime);
  2879. end;
  2880.  
  2881. function TDateTimeField.GetAsDateTime: TDateTime;
  2882. begin
  2883.   if not GetValue(Result) then Result := 0;
  2884. end;
  2885.  
  2886. function TDateTimeField.GetAsFloat: Double;
  2887. begin
  2888.   Result := GetAsDateTime;
  2889. end;
  2890.  
  2891. function TDateTimeField.GetAsString: string;
  2892. begin
  2893.   GetText(Result, False);
  2894. end;
  2895.  
  2896. function TDateTimeField.GetAsVariant: Variant;
  2897. var
  2898.   D: TDateTime;
  2899. begin
  2900.   if GetValue(D) then Result := VarFromDateTime(D) else Result := Null;
  2901. end;
  2902.  
  2903. function TDateTimeField.GetDataSize: Word;
  2904. begin
  2905.   Result := SizeOf(TDateTime);
  2906. end;
  2907.  
  2908. procedure TDateTimeField.GetText(var Text: string; DisplayText: Boolean);
  2909. var
  2910.   F: string;
  2911.   D: TDateTime;
  2912. begin
  2913.   if GetValue(D) then
  2914.   begin
  2915.     if DisplayText and (FDisplayFormat <> '') then
  2916.       F := FDisplayFormat
  2917.     else
  2918.       case DataType of
  2919.         ftDate: F := ShortDateFormat;
  2920.         ftTime: F := LongTimeFormat;
  2921.       end;
  2922.     DateTimeToString(Text, F, D);
  2923.   end else
  2924.     Text := '';
  2925. end;
  2926.  
  2927. function TDateTimeField.GetValue(var Value: TDateTime): Boolean;
  2928. var
  2929.   TimeStamp: TTimeStamp;
  2930.   Data: TDateTimeRec;
  2931. begin
  2932.   Result := GetData(@Data);
  2933.   if Result then
  2934.   begin
  2935.     case DataType of
  2936.       ftDate:
  2937.         begin
  2938.           TimeStamp.Time := 0;
  2939.           TimeStamp.Date := Data.Date;
  2940.         end;
  2941.       ftTime:
  2942.         begin
  2943.           TimeStamp.Time := Data.Time;
  2944.           TimeStamp.Date := DateDelta;
  2945.         end;
  2946.     else
  2947.       try
  2948.         TimeStamp := MSecsToTimeStamp(Data.DateTime);
  2949.       except
  2950.         TimeStamp.Time := 0;
  2951.         TimeStamp.Date := 0;
  2952.       end;
  2953.     end;
  2954.     Value := TimeStampToDateTime(TimeStamp);
  2955.   end;
  2956. end;
  2957.  
  2958. procedure TDateTimeField.SetAsDateTime(Value: TDateTime);
  2959. var
  2960.   TimeStamp: TTimeStamp;
  2961.   Data: TDateTimeRec;
  2962. begin
  2963.   TimeStamp := DateTimeToTimeStamp(Value);
  2964.   case DataType of
  2965.     ftDate: Data.Date := TimeStamp.Date;
  2966.     ftTime: Data.Time := TimeStamp.Time;
  2967.   else
  2968.     Data.DateTime := TimeStampToMSecs(TimeStamp);
  2969.   end;
  2970.   SetData(@Data);
  2971. end;
  2972.  
  2973. procedure TDateTimeField.SetAsFloat(Value: Double);
  2974. begin
  2975.   SetAsDateTime(Value);
  2976. end;
  2977.  
  2978. procedure TDateTimeField.SetAsString(const Value: string);
  2979. var
  2980.   DateTime: TDateTime;
  2981. begin
  2982.   if Value = '' then Clear else
  2983.   begin
  2984.     case DataType of
  2985.       ftDate: DateTime := StrToDate(Value);
  2986.       ftTime: DateTime := StrToTime(Value);
  2987.     else
  2988.       DateTime := StrToDateTime(Value);
  2989.     end;
  2990.     SetAsDateTime(DateTime);
  2991.   end;
  2992. end;
  2993.  
  2994. procedure TDateTimeField.SetDisplayFormat(const Value: string);
  2995. begin
  2996.   if FDisplayFormat <> Value then
  2997.   begin
  2998.     FDisplayFormat := Value;
  2999.     PropertyChanged(False);
  3000.   end;
  3001. end;
  3002.  
  3003. procedure TDateTimeField.SetVarValue(const Value: Variant);
  3004. begin
  3005.   SetAsDateTime(VarToDateTime(Value));
  3006. end;
  3007.  
  3008. { TDateField }
  3009.  
  3010. constructor TDateField.Create(AOwner: TComponent);
  3011. begin
  3012.   inherited Create(AOwner);
  3013.   SetDataType(ftDate);
  3014. end;
  3015.  
  3016. function TDateField.GetDataSize: Word;
  3017. begin
  3018.   Result := SizeOf(Integer);
  3019. end;
  3020.  
  3021. { TTimeField }
  3022.  
  3023. constructor TTimeField.Create(AOwner: TComponent);
  3024. begin
  3025.   inherited Create(AOwner);
  3026.   SetDataType(ftTime);
  3027. end;
  3028.  
  3029. function TTimeField.GetDataSize: Word;
  3030. begin
  3031.   Result := SizeOf(Integer);
  3032. end;
  3033.  
  3034. { TBinaryField }
  3035.  
  3036. constructor TBinaryField.Create(AOwner: TComponent);
  3037. begin
  3038.   inherited Create(AOwner);
  3039. end;
  3040.  
  3041. class procedure TBinaryField.CheckTypeSize(Value: Integer);
  3042. begin
  3043.   if (Value = 0) then DatabaseError(SInvalidFieldSize);
  3044. end;
  3045.  
  3046. function TBinaryField.GetAsString: string;
  3047. begin
  3048.   SetLength(Result, DataSize);
  3049.   GetData(PChar(Result));
  3050. end;
  3051.  
  3052. procedure TBinaryField.SetAsString(const Value: string);
  3053. var
  3054.   Data: string;
  3055.   Count: Integer;
  3056. begin
  3057.   if Length(Value) = DataSize then
  3058.     Data := Value
  3059.   else
  3060.   begin
  3061.     SetLength(Data, DataSize);
  3062.     FillChar(PChar(Data)^, DataSize, #0);
  3063.     if Length(Value) > DataSize then
  3064.       Count := DataSize else
  3065.       Count := Length(Value);
  3066.     Move(PChar(Value)^, PChar(Data)^, Count);
  3067.   end;
  3068.   SetData(PChar(Data));
  3069. end;
  3070.  
  3071. function TBinaryField.GetAsVariant: Variant;
  3072. var
  3073.   Data: Pointer;
  3074.   HasData: Boolean;
  3075. begin
  3076.   Result := VarArrayCreate([0, DataSize - 1], varByte);
  3077.   Data := VarArrayLock(Result);
  3078.   try
  3079.     HasData := GetData(Data);
  3080.   finally
  3081.     VarArrayUnlock(Result);
  3082.   end;
  3083.   if not HasData then Result := Null;
  3084. end;
  3085.  
  3086. procedure TBinaryField.SetVarValue(const Value: Variant);
  3087. var
  3088.   Data: Pointer;
  3089. begin
  3090.   if not (VarIsArray(Value) and (VarArrayDimCount(Value) = 1) and
  3091.     ((VarType(Value) and VarTypeMask) = varByte) and
  3092.     ((VarArrayHighBound(Value, 1) - VarArrayLowBound(Value, 1) + 1) = DataSize)) then
  3093.     DatabaseError(SInvalidVarByteArray);
  3094.   Data := VarArrayLock(Value);
  3095.   try
  3096.     SetData(Data);
  3097.   finally
  3098.     VarArrayUnlock(Value);
  3099.   end;
  3100. end;
  3101.  
  3102. procedure TBinaryField.GetText(var Text: string; DisplayText: Boolean);
  3103. begin
  3104.   Text := inherited GetAsString;
  3105. end;
  3106.  
  3107. procedure TBinaryField.SetText(const Value: string);
  3108. begin
  3109.   raise AccessError('Text');
  3110. end;
  3111.  
  3112. { TBytesField }
  3113.  
  3114. constructor TBytesField.Create(AOwner: TComponent);
  3115. begin
  3116.   inherited Create(AOwner);
  3117.   SetDataType(ftBytes);
  3118.   Size := 16;
  3119. end;
  3120.  
  3121. function TBytesField.GetDataSize: Word;
  3122. begin
  3123.   Result := Size;
  3124. end;
  3125.  
  3126. { TVarBytesField }
  3127.  
  3128. constructor TVarBytesField.Create(AOwner: TComponent);
  3129. begin
  3130.   inherited Create(AOwner);
  3131.   SetDataType(ftVarBytes);
  3132.   Size := 16;
  3133. end;
  3134.  
  3135. function TVarBytesField.GetDataSize: Word;
  3136. begin
  3137.   Result := Size + 2;
  3138. end;
  3139.  
  3140. { TBCDField }
  3141.  
  3142. constructor TBCDField.Create(AOwner: TComponent);
  3143. begin
  3144.   inherited Create(AOwner);
  3145.   SetDataType(ftBCD);
  3146.   Size := 4;
  3147.   ValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
  3148. end;
  3149.  
  3150. class procedure TBCDField.CheckTypeSize(Value: Integer);
  3151. begin
  3152.   if Value > 32 then DatabaseError(SInvalidFieldSize);
  3153. end;
  3154.  
  3155. function TBCDField.GetAsCurrency: Currency;
  3156. begin
  3157.   if not GetValue(Result) then Result := 0;
  3158. end;
  3159.  
  3160. function TBCDField.GetAsFloat: Double;
  3161. begin
  3162.   Result := GetAsCurrency;
  3163. end;
  3164.  
  3165. function TBCDField.GetAsInteger: Longint;
  3166. begin
  3167.   Result := Round(GetAsCurrency);
  3168. end;
  3169.  
  3170. function TBCDField.GetAsString: string;
  3171. var
  3172.   C: System.Currency;
  3173. begin
  3174.   if GetValue(C) then Result := CurrToStr(C) else Result := '';
  3175. end;
  3176.  
  3177. function TBCDField.GetAsVariant: Variant;
  3178. var
  3179.   C: System.Currency;
  3180. begin
  3181.   if GetValue(C) then Result := C else Result := Null;
  3182. end;
  3183.  
  3184. function TBCDField.GetDataSize: Word;
  3185. begin
  3186.   Result := 34; { sizeof FMTBCD (BDE) }  
  3187. end;
  3188.  
  3189. function TBCDField.GetDefaultWidth: Integer;
  3190. begin
  3191.   if FPrecision > 0 then
  3192.     Result := FPrecision + 1 else
  3193.     Result := inherited GetDefaultWidth;
  3194. end;
  3195.  
  3196. procedure TBCDField.GetText(var Text: string; DisplayText: Boolean);
  3197. var
  3198.   Format: TFloatFormat;
  3199.   Digits: Integer;
  3200.   FmtStr: string;
  3201.   BCD: array[0..255] of Byte;
  3202.   C: System.Currency;
  3203. begin
  3204.   if GetData(@BCD) then
  3205.     if DataSet.BCDToCurr(@BCD, C) then
  3206.     begin
  3207.       if DisplayText or (EditFormat = '') then
  3208.         FmtStr := DisplayFormat else
  3209.         FmtStr := EditFormat;
  3210.       if FmtStr = '' then
  3211.       begin
  3212.         if FCurrency then
  3213.         begin
  3214.           if DisplayText then Format := ffCurrency else Format := ffFixed;
  3215.           Digits := CurrencyDecimals;
  3216.         end
  3217.         else begin
  3218.           Format := ffGeneral;
  3219.           Digits := 0;
  3220.         end;
  3221.         Text := CurrToStrF(C, Format, Digits);
  3222.       end else
  3223.         Text := FormatCurr(FmtStr, C);
  3224.     end else
  3225.       Text := SBCDOverflow
  3226.   else
  3227.     Text := '';
  3228. end;
  3229.  
  3230. function TBCDField.GetValue(var Value: Currency): Boolean;
  3231. var
  3232.   BCD: array[0..255] of Byte;
  3233. begin
  3234.   Result := GetData(@BCD);
  3235.   if Result then
  3236.     if not FDataSet.BCDToCurr(@BCD, Value) then
  3237.       DatabaseErrorFmt(SFieldOutOfRange, [DisplayName]);
  3238. end;
  3239.  
  3240. procedure TBCDField.SetAsCurrency(Value: Currency);
  3241. var
  3242.   BCD: array[0..255] of Byte;
  3243. begin
  3244.   if FCheckRange and ((Value < FMinValue) or (Value > FMaxValue)) then
  3245.     RangeError(Value, FMinValue, FMaxValue);
  3246.   FDataSet.CurrToBCD(Value, @BCD, FPrecision, Size);
  3247.   SetData(@BCD);
  3248. end;
  3249.  
  3250. procedure TBCDField.SetAsFloat(Value: Double);
  3251. begin
  3252.   SetAsCurrency(Value);
  3253. end;
  3254.  
  3255. procedure TBCDField.SetAsInteger(Value: Longint);
  3256. begin
  3257.   SetAsCurrency(Value);
  3258. end;
  3259.  
  3260. procedure TBCDField.SetAsString(const Value: string);
  3261. var
  3262.   C: System.Currency;
  3263. begin
  3264.   if Value = '' then Clear else
  3265.   begin
  3266.     if not TextToFloat(PChar(Value), C, fvCurrency) then
  3267.       DatabaseErrorFmt(SInvalidFloatValue, [Value, DisplayName]);
  3268.     SetAsCurrency(C);
  3269.   end;
  3270. end;
  3271.  
  3272. procedure TBCDField.SetCurrency(Value: Boolean);
  3273. begin
  3274.   if FCurrency <> Value then
  3275.   begin
  3276.     FCurrency := Value;
  3277.     PropertyChanged(False);
  3278.   end;
  3279. end;
  3280.  
  3281. procedure TBCDField.SetMaxValue(Value: Currency);
  3282. begin
  3283.   FMaxValue := Value;
  3284.   UpdateCheckRange;
  3285. end;
  3286.  
  3287. procedure TBCDField.SetMinValue(Value: Currency);
  3288. begin
  3289.   FMinValue := Value;
  3290.   UpdateCheckRange;
  3291. end;
  3292.  
  3293. procedure TBCDField.SetVarValue(const Value: Variant);
  3294. begin
  3295.   SetAsCurrency(Value);
  3296. end;
  3297.  
  3298. procedure TBCDField.UpdateCheckRange;
  3299. begin
  3300.   FCheckRange := (FMinValue <> 0) or (FMaxValue <> 0);
  3301. end;
  3302.  
  3303. { TBlobField }
  3304.  
  3305. constructor TBlobField.Create(AOwner: TComponent);
  3306. begin
  3307.   inherited Create(AOwner);
  3308.   SetDataType(ftBlob);
  3309. end;
  3310.  
  3311. procedure TBlobField.Assign(Source: TPersistent);
  3312. begin
  3313.   if Source is TBlobField then
  3314.   begin
  3315.     LoadFromBlob(TBlobField(Source));
  3316.     Exit;
  3317.   end;
  3318.   if Source is TStrings then
  3319.   begin
  3320.     LoadFromStrings(TStrings(Source));
  3321.     Exit;
  3322.   end;
  3323.   if Source is TBitmap then
  3324.   begin
  3325.     LoadFromBitmap(TBitmap(Source));
  3326.     Exit;
  3327.   end;
  3328.   if (Source is TPicture) and (TPicture(Source).Graphic is TBitmap) then
  3329.   begin
  3330.     LoadFromBitmap(TBitmap(TPicture(Source).Graphic));
  3331.     Exit;
  3332.   end;
  3333.   inherited Assign(Source);
  3334. end;
  3335.  
  3336. procedure TBlobField.AssignTo(Dest: TPersistent);
  3337. begin
  3338.   if Dest is TStrings then
  3339.   begin
  3340.     SaveToStrings(TStrings(Dest));
  3341.     Exit;
  3342.   end;
  3343.   if Dest is TBitmap then
  3344.   begin
  3345.     SaveToBitmap(TBitmap(Dest));
  3346.     Exit;
  3347.   end;
  3348.   if Dest is TPicture then
  3349.   begin
  3350.     SaveToBitmap(TPicture(Dest).Bitmap);
  3351.     Exit;
  3352.   end;
  3353.   inherited AssignTo(Dest);
  3354. end;
  3355.  
  3356. procedure TBlobField.Clear;
  3357. begin
  3358.   DataSet.CreateBlobStream(Self, bmWrite).Free;
  3359. end;
  3360.  
  3361. procedure TBlobField.FreeBuffers;
  3362. begin
  3363.   if FModified then
  3364.   begin
  3365.     Dataset.CloseBlob(Self);
  3366.     FModified := False;
  3367.   end;
  3368. end;
  3369.  
  3370. function TBlobField.GetAsString: string;
  3371. var
  3372.   Len: Integer;
  3373. begin
  3374.   with DataSet.CreateBlobStream(Self, bmRead) do
  3375.     try
  3376.       Len := Size;
  3377.       SetString(Result, nil, Len);
  3378.       ReadBuffer(Pointer(Result)^, Len);
  3379.     finally
  3380.       Free;
  3381.     end;
  3382. end;
  3383.  
  3384. function TBlobField.GetAsVariant: Variant;
  3385. begin
  3386.   Result := GetAsString;
  3387. end;
  3388.  
  3389. function TBlobField.GetBlobSize: Integer;
  3390. begin
  3391.   with DataSet.CreateBlobStream(Self, bmRead) do
  3392.     try
  3393.       Result := Size;
  3394.     finally
  3395.       Free;
  3396.     end;
  3397. end;
  3398.  
  3399. function TBlobField.GetBlobType: TBlobType;
  3400. begin
  3401.   Result := TBlobType(DataType);
  3402. end;
  3403.  
  3404. function TBlobField.GetIsNull: Boolean;
  3405. begin
  3406.   if Modified then
  3407.   begin
  3408.     with DataSet.CreateBlobStream(Self, bmRead) do
  3409.     try
  3410.       Result := (Size = 0);
  3411.     finally
  3412.       Free;
  3413.     end;
  3414.   end else
  3415.     Result := inherited GetIsNull;
  3416. end;
  3417.  
  3418. function TBlobField.GetModified: Boolean;
  3419. begin
  3420.   Result := FModified and (FModifiedRecord = DataSet.ActiveRecord);
  3421. end;
  3422.  
  3423. procedure TBlobField.GetText(var Text: string; DisplayText: Boolean);
  3424. begin
  3425.   Text := inherited GetAsString;
  3426. end;
  3427.  
  3428. class function TBlobField.IsBlob: Boolean;
  3429. begin
  3430.   Result := True;
  3431. end;
  3432.  
  3433. procedure TBlobField.LoadFromBitmap(Bitmap: TBitmap);
  3434. var
  3435.   BlobStream: TStream;
  3436.   Header: TGraphicHeader;
  3437. begin
  3438.   BlobStream := DataSet.CreateBlobStream(Self, bmWrite);
  3439.   try
  3440.     if (DataType = ftGraphic) or (DataType = ftTypedBinary) then
  3441.     begin
  3442.       Header.Count := 1;
  3443.       Header.HType := $0100;
  3444.       Header.Size := 0;
  3445.       BlobStream.Write(Header, SizeOf(Header));
  3446.       Bitmap.SaveToStream(BlobStream);
  3447.       Header.Size := BlobStream.Position - SizeOf(Header);
  3448.       BlobStream.Position := 0;
  3449.       BlobStream.Write(Header, SizeOf(Header));
  3450.     end else
  3451.       Bitmap.SaveToStream(BlobStream);
  3452.   finally
  3453.     BlobStream.Free;
  3454.   end;
  3455. end;
  3456.  
  3457. procedure TBlobField.LoadFromBlob(Blob: TBlobField);
  3458. var
  3459.   BlobStream: TStream;
  3460. begin
  3461.   BlobStream := DataSet.CreateBlobStream(Self, bmWrite);
  3462.   try
  3463.     Blob.SaveToStream(BlobStream);
  3464.   finally
  3465.     BlobStream.Free;
  3466.   end;
  3467. end;
  3468.  
  3469. procedure TBlobField.LoadFromFile(const FileName: string);
  3470. var
  3471.   Stream: TStream;
  3472. begin
  3473.   Stream := TFileStream.Create(FileName, fmOpenRead);
  3474.   try
  3475.     LoadFromStream(Stream);
  3476.   finally
  3477.     Stream.Free;
  3478.   end;
  3479. end;
  3480.  
  3481. procedure TBlobField.LoadFromStream(Stream: TStream);
  3482. begin
  3483.   with DataSet.CreateBlobStream(Self, bmWrite) do
  3484.   try
  3485.     CopyFrom(Stream, 0);
  3486.   finally
  3487.     Free;
  3488.   end;
  3489. end;
  3490.  
  3491. procedure TBlobField.LoadFromStrings(Strings: TStrings);
  3492. var
  3493.   BlobStream: TStream;
  3494. begin
  3495.   BlobStream := DataSet.CreateBlobStream(Self, bmWrite);
  3496.   try
  3497.     Strings.SaveToStream(BlobStream);
  3498.   finally
  3499.     BlobStream.Free;
  3500.   end;
  3501. end;
  3502.  
  3503. procedure TBlobField.SaveToBitmap(Bitmap: TBitmap);
  3504. var
  3505.   BlobStream: TStream;
  3506.   Size: Longint;
  3507.   Header: TGraphicHeader;
  3508. begin
  3509.   BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  3510.   try
  3511.     Size := BlobStream.Size;
  3512.     if Size >= SizeOf(TGraphicHeader) then
  3513.     begin
  3514.       BlobStream.Read(Header, SizeOf(Header));
  3515.       if (Header.Count <> 1) or (Header.HType <> $0100) or
  3516.         (Header.Size <> Size - SizeOf(Header)) then
  3517.         BlobStream.Position := 0;
  3518.     end;
  3519.     Bitmap.LoadFromStream(BlobStream);
  3520.   finally
  3521.     BlobStream.Free;
  3522.   end;
  3523. end;
  3524.  
  3525. procedure TBlobField.SaveToFile(const FileName: string);
  3526. var
  3527.   Stream: TStream;
  3528. begin
  3529.   Stream := TFileStream.Create(FileName, fmCreate);
  3530.   try
  3531.     SaveToStream(Stream);
  3532.   finally
  3533.     Stream.Free;
  3534.   end;
  3535. end;
  3536.  
  3537. procedure TBlobField.SaveToStream(Stream: TStream);
  3538. var
  3539.   BlobStream: TStream;
  3540. begin
  3541.   BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  3542.   try
  3543.     Stream.CopyFrom(BlobStream, 0);
  3544.   finally
  3545.     BlobStream.Free;
  3546.   end;
  3547. end;
  3548.  
  3549. procedure TBlobField.SaveToStrings(Strings: TStrings);
  3550. var
  3551.   BlobStream: TStream;
  3552. begin
  3553.   BlobStream := DataSet.CreateBlobStream(Self, bmRead);
  3554.   try
  3555.     Strings.LoadFromStream(BlobStream);
  3556.   finally
  3557.     BlobStream.Free;
  3558.   end;
  3559. end;
  3560.  
  3561. procedure TBlobField.SetAsString(const Value: string);
  3562. begin
  3563.   with DataSet.CreateBlobStream(Self, bmWrite) do
  3564.     try
  3565.       WriteBuffer(Pointer(Value)^, Length(Value));
  3566.     finally
  3567.       Free;
  3568.     end;
  3569. end;
  3570.  
  3571. procedure TBlobField.SetBlobType(Value: TBlobType);
  3572. begin
  3573.   SetFieldType(Value);
  3574. end;
  3575.  
  3576. procedure TBlobField.SetFieldType(Value: TFieldType);
  3577. begin
  3578.   if Value in [Low(TBlobType)..High(TBlobType)] then SetDataType(Value);
  3579. end;
  3580.  
  3581. procedure TBlobField.SetModified(Value: Boolean);
  3582. begin
  3583.   FModified := Value;
  3584.   if FModified then
  3585.     FModifiedRecord := DataSet.ActiveRecord;
  3586. end;
  3587.  
  3588. procedure TBlobField.SetText(const Value: string);
  3589. begin
  3590.   raise AccessError('Text');
  3591. end;
  3592.  
  3593. procedure TBlobField.SetVarValue(const Value: Variant);
  3594. begin
  3595.   SetAsString(Value);
  3596. end;
  3597.  
  3598. { TMemoField }
  3599.  
  3600. constructor TMemoField.Create(AOwner: TComponent);
  3601. begin
  3602.   inherited Create(AOwner);
  3603.   SetDataType(ftMemo);
  3604.   Transliterate := True;
  3605. end;
  3606.  
  3607. { TGraphicField }
  3608.  
  3609. constructor TGraphicField.Create(AOwner: TComponent);
  3610. begin
  3611.   inherited Create(AOwner);
  3612.   SetDataType(ftGraphic);
  3613. end;
  3614.  
  3615. { TIndexDef }
  3616.  
  3617. constructor TIndexDef.Create(Owner: TIndexDefs; const Name, Fields: string;
  3618.   Options: TIndexOptions);
  3619. begin
  3620.   if Owner <> nil then
  3621.   begin
  3622.     Owner.FItems.Add(Self);
  3623.     Owner.FUpdated := False;
  3624.     FOwner := Owner;
  3625.   end;
  3626.   FName := Name;
  3627.   FFields := Fields;
  3628.   FOptions := Options;
  3629. end;
  3630.  
  3631. destructor TIndexDef.Destroy;
  3632. begin
  3633.   if FOwner <> nil then
  3634.   begin
  3635.     FOwner.FItems.Remove(Self);
  3636.     FOwner.FUpdated := False;
  3637.   end;
  3638. end;
  3639.  
  3640. function TIndexDef.GetExpression: string;
  3641. begin
  3642.   if ixExpression in Options then Result := FFields else Result := '';
  3643. end;
  3644.  
  3645. function TIndexDef.GetFields: string;
  3646. begin
  3647.   if ixExpression in Options then Result := '' else Result := FFields;
  3648. end;
  3649.  
  3650. { TIndexDefs }
  3651.  
  3652. constructor TIndexDefs.Create(DataSet: TDataSet);
  3653. begin
  3654.   FDataSet := DataSet;
  3655.   FItems := TList.Create;
  3656. end;
  3657.  
  3658. destructor TIndexDefs.Destroy;
  3659. begin
  3660.   if FItems <> nil then Clear;
  3661.   FItems.Free;
  3662. end;
  3663.  
  3664. procedure TIndexDefs.Add(const Name, Fields: string;
  3665.   Options: TIndexOptions);
  3666. begin
  3667.   if IndexOf(Name) >= 0 then DatabaseErrorFmt(SDuplicateIndexName, [Name]);
  3668.   TIndexDef.Create(Self, Name, Fields, Options);
  3669. end;
  3670.  
  3671. procedure TIndexDefs.Assign(IndexDefs: TIndexDefs);
  3672. var
  3673.   I: Integer;
  3674. begin
  3675.   Clear;
  3676.   for I := 0 to IndexDefs.Count - 1 do
  3677.     with IndexDefs[I] do Add(Name, Fields, Options);
  3678. end;
  3679.  
  3680. procedure TIndexDefs.Clear;
  3681. begin
  3682.   while FItems.Count > 0 do TIndexDef(FItems.Last).Free;
  3683. end;
  3684.  
  3685. function TIndexDefs.FindIndexForFields(const Fields: string): TIndexDef;
  3686. begin
  3687.   Result := GetIndexForFields(Fields, False);
  3688.   if Result = nil then
  3689.     DatabaseErrorFmt(SNoIndexForFields, [FDataSet.Name, Fields]);
  3690. end;
  3691.  
  3692. function TIndexDefs.GetCount: Integer;
  3693. begin
  3694.   Result := FItems.Count;
  3695. end;
  3696.  
  3697. function TIndexDefs.GetIndexForFields(const Fields: string;
  3698.   CaseInsensitive: Boolean): TIndexDef;
  3699. var
  3700.   Exact: Boolean;
  3701.   I, L: Integer;
  3702. begin
  3703.   Update;
  3704.   L := Length(Fields);
  3705.   Exact := True;
  3706.   while True do
  3707.   begin
  3708.     for I := 0 to FItems.Count - 1 do
  3709.     begin
  3710.       Result := FItems[I];
  3711.       if (Result.FOptions * [ixDescending, ixExpression] = []) and
  3712.         (not CaseInsensitive or (ixCaseInsensitive in Result.FOptions)) then
  3713.         if Exact then
  3714.         begin
  3715.           if AnsiCompareText(Fields, Result.Fields) = 0 then Exit;
  3716.         end
  3717.         else begin
  3718.           if (AnsiCompareText(Fields, Copy(Result.Fields, 1, L)) = 0) and
  3719.             ((Length(Result.FFields) = L) or
  3720.             (Result.FFields[L + 1] = ';')) then Exit;
  3721.         end;
  3722.     end;
  3723.     if not Exact then Break;
  3724.     Exact := False;
  3725.   end;
  3726.   Result := nil;
  3727. end;
  3728.  
  3729. function TIndexDefs.GetItem(Index: Integer): TIndexDef;
  3730. begin
  3731.   Result := FItems[Index];
  3732. end;
  3733.  
  3734. function TIndexDefs.IndexOf(const Name: string): Integer;
  3735. begin
  3736.   for Result := 0 to FItems.Count - 1 do
  3737.     if AnsiCompareText(TIndexDef(FItems[Result]).FName, Name) = 0 then Exit;
  3738.   Result := -1;
  3739. end;
  3740.  
  3741. procedure TIndexDefs.Update;
  3742. begin
  3743.   FDataSet.UpdateIndexDefs;
  3744. end;
  3745.  
  3746. { TDataLink }
  3747.  
  3748. constructor TDataLink.Create;
  3749. begin
  3750.   inherited Create;
  3751.   FBufferCount := 1;
  3752. end;
  3753.  
  3754. destructor TDataLink.Destroy;
  3755. begin
  3756.   FActive := False;
  3757.   FEditing := False;
  3758.   FDataSourceFixed := False;
  3759.   SetDataSource(nil);
  3760.   inherited Destroy;
  3761. end;
  3762.  
  3763. procedure TDataLink.UpdateRange;
  3764. var
  3765.   Min, Max: Integer;
  3766. begin
  3767.   Min := DataSet.FActiveRecord - FBufferCount + 1;
  3768.   if Min < 0 then Min := 0;
  3769.   Max := DataSet.FBufferCount - FBufferCount;
  3770.   if Max < 0 then Max := 0;
  3771.   if Max > DataSet.FActiveRecord then Max := DataSet.FActiveRecord;
  3772.   if FFirstRecord < Min then FFirstRecord := Min;
  3773.   if FFirstRecord > Max then FFirstRecord := Max;
  3774. end;
  3775.  
  3776. function TDataLink.GetDataSet: TDataSet;
  3777. begin
  3778.   if DataSource <> nil then Result := DataSource.DataSet else Result := nil;
  3779. end;
  3780.  
  3781. procedure TDataLink.SetDataSource(ADataSource: TDataSource);
  3782. begin
  3783.   if FDataSource <> ADataSource then
  3784.   begin
  3785.     if FDataSourceFixed then DatabaseError(SDataSourceChange);
  3786.     if FDataSource <> nil then FDataSource.RemoveDataLink(Self);
  3787.     if ADataSource <> nil then ADataSource.AddDataLink(Self);
  3788.   end;
  3789. end;
  3790.  
  3791. procedure TDataLink.SetReadOnly(Value: Boolean);
  3792. begin
  3793.   if FReadOnly <> Value then
  3794.   begin
  3795.     FReadOnly := Value;
  3796.     UpdateState;
  3797.   end;
  3798. end;
  3799.  
  3800. procedure TDataLink.SetActive(Value: Boolean);
  3801. begin
  3802.   if FActive <> Value then
  3803.   begin
  3804.     FActive := Value;
  3805.     if Value then UpdateRange else FFirstRecord := 0;
  3806.     ActiveChanged;
  3807.   end;
  3808. end;
  3809.  
  3810. procedure TDataLink.SetEditing(Value: Boolean);
  3811. begin
  3812.   if FEditing <> Value then
  3813.   begin
  3814.     FEditing := Value;
  3815.     EditingChanged;
  3816.   end;
  3817. end;
  3818.  
  3819. procedure TDataLink.UpdateState;
  3820. begin
  3821.   SetActive((DataSource <> nil) and (DataSource.State <> dsInactive));
  3822.   SetEditing((DataSource <> nil) and (DataSource.State in dsEditModes) and
  3823.     not FReadOnly);
  3824. end;
  3825.  
  3826. procedure TDataLink.UpdateRecord;
  3827. begin
  3828.   FUpdating := True;
  3829.   try
  3830.     UpdateData;
  3831.   finally
  3832.     FUpdating := False;
  3833.   end;
  3834. end;
  3835.  
  3836. function TDataLink.Edit: Boolean;
  3837. begin
  3838.   if not FReadOnly and (DataSource <> nil) then DataSource.Edit;
  3839.   Result := FEditing;
  3840. end;
  3841.  
  3842. function TDataLink.GetActiveRecord: Integer;
  3843. begin
  3844.   if DataSource.State = dsSetKey then
  3845.     Result := 0 else
  3846.     Result := DataSource.DataSet.FActiveRecord - FFirstRecord;
  3847. end;
  3848.  
  3849. procedure TDataLink.SetActiveRecord(Value: Integer);
  3850. begin
  3851.   if DataSource.State <> dsSetKey then
  3852.     DataSource.DataSet.FActiveRecord := Value + FFirstRecord;
  3853. end;
  3854.  
  3855. procedure TDataLink.SetBufferCount(Value: Integer);
  3856. begin
  3857.   if FBufferCount <> Value then
  3858.   begin
  3859.     FBufferCount := Value;
  3860.     if Active then
  3861.     begin
  3862.       UpdateRange;
  3863.       DataSet.UpdateBufferCount;
  3864.       UpdateRange;
  3865.     end;
  3866.   end;
  3867. end;
  3868.  
  3869. function TDataLink.GetRecordCount: Integer;
  3870. begin
  3871.   if DataSource.State = dsSetKey then Result := 1 else
  3872.   begin
  3873.     Result := DataSource.DataSet.FRecordCount;
  3874.     if Result > FBufferCount then Result := FBufferCount;
  3875.   end;
  3876. end;
  3877.  
  3878. procedure TDataLink.DataEvent(Event: TDataEvent; Info: Longint);
  3879. var
  3880.   Active, First, Last, Count: Integer;
  3881. begin
  3882.   if Event = deUpdateState then UpdateState else
  3883.     if FActive then
  3884.       case Event of
  3885.         deFieldChange, deRecordChange:
  3886.           if not FUpdating then RecordChanged(TField(Info));
  3887.         deDataSetChange, deDataSetScroll, deLayoutChange:
  3888.           begin
  3889.             Count := 0;
  3890.             if DataSource.State <> dsSetKey then
  3891.             begin
  3892.               Active := DataSource.DataSet.FActiveRecord;
  3893.               First := FFirstRecord + Info;
  3894.               Last := First + FBufferCount - 1;
  3895.               if Active > Last then Count := Active - Last else
  3896.                 if Active < First then Count := Active - First;
  3897.               FFirstRecord := First + Count;
  3898.             end;
  3899.             case Event of
  3900.               deDataSetChange: DataSetChanged;
  3901.               deDataSetScroll: DataSetScrolled(Count);
  3902.               deLayoutChange: LayoutChanged;
  3903.             end;
  3904.           end;
  3905.         deUpdateRecord:
  3906.           UpdateRecord;
  3907.         deCheckBrowseMode:
  3908.           CheckBrowseMode;
  3909.         deFocusControl:
  3910.           FocusControl(TFieldRef(Info));
  3911.       end;
  3912. end;
  3913.  
  3914. procedure TDataLink.ActiveChanged;
  3915. begin
  3916. end;
  3917.  
  3918. procedure TDataLink.CheckBrowseMode;
  3919. begin
  3920. end;
  3921.  
  3922. procedure TDataLink.DataSetChanged;
  3923. begin
  3924.   RecordChanged(nil);
  3925. end;
  3926.  
  3927. procedure TDataLink.DataSetScrolled(Distance: Integer);
  3928. begin
  3929.   DataSetChanged;
  3930. end;
  3931.  
  3932. procedure TDataLink.EditingChanged;
  3933. begin
  3934. end;
  3935.  
  3936. procedure TDataLink.FocusControl(Field: TFieldRef);
  3937. begin
  3938. end;
  3939.  
  3940. procedure TDataLink.LayoutChanged;
  3941. begin
  3942.   DataSetChanged;
  3943. end;
  3944.  
  3945. procedure TDataLink.RecordChanged(Field: TField);
  3946. begin
  3947. end;
  3948.  
  3949. procedure TDataLink.UpdateData;
  3950. begin
  3951. end;
  3952.  
  3953. { TDataSource }
  3954.  
  3955. constructor TDataSource.Create(AOwner: TComponent);
  3956. begin
  3957.   inherited Create(AOwner);
  3958.   FDataLinks := TList.Create;
  3959.   FEnabled := True;
  3960.   FAutoEdit := True;
  3961. end;
  3962.  
  3963. destructor TDataSource.Destroy;
  3964. begin
  3965.   FOnStateChange := nil;
  3966.   SetDataSet(nil);
  3967.   while FDataLinks.Count > 0 do RemoveDataLink(FDataLinks.Last);
  3968.   FDataLinks.Free;
  3969.   inherited Destroy;
  3970. end;
  3971.  
  3972. procedure TDataSource.Edit;
  3973. begin
  3974.   if AutoEdit and (State = dsBrowse) then DataSet.Edit;
  3975. end;
  3976.  
  3977. procedure TDataSource.SetState(Value: TDataSetState);
  3978. var
  3979.   PriorState: TDataSetState;
  3980. begin
  3981.   if FState <> Value then
  3982.   begin
  3983.     PriorState := FState;
  3984.     FState := Value;
  3985.     NotifyDataLinks(deUpdateState, 0);
  3986.     if not (csDestroying in ComponentState) then
  3987.     begin
  3988.       if Assigned(FOnStateChange) then FOnStateChange(Self);
  3989.       if PriorState = dsInactive then
  3990.         if Assigned(FOnDataChange) then FOnDataChange(Self, nil);
  3991.     end;
  3992.   end;
  3993. end;
  3994.  
  3995. procedure TDataSource.UpdateState;
  3996. begin
  3997.   if Enabled and (DataSet <> nil) then
  3998.     SetState(DataSet.State) else
  3999.     SetState(dsInactive);
  4000. end;
  4001.  
  4002. function TDataSource.IsLinkedTo(DataSet: TDataSet): Boolean;
  4003. var
  4004.   DataSource: TDataSource;
  4005. begin
  4006.   Result := True;
  4007.   while DataSet <> nil do
  4008.   begin
  4009.     DataSource := DataSet.GetDataSource;
  4010.     if DataSource = nil then Break;
  4011.     if DataSource = Self then Exit;
  4012.     DataSet := DataSource.DataSet;
  4013.   end;
  4014.   Result := False;
  4015. end;
  4016.  
  4017. procedure TDataSource.SetDataSet(ADataSet: TDataSet);
  4018. begin
  4019.   if IsLinkedTo(ADataSet) then DatabaseError(SCircularDataLink);
  4020.   if FDataSet <> nil then FDataSet.RemoveDataSource(Self);
  4021.   if ADataSet <> nil then ADataSet.AddDataSource(Self);
  4022. end;
  4023.  
  4024. procedure TDataSource.SetEnabled(Value: Boolean);
  4025. begin
  4026.   FEnabled := Value;
  4027.   UpdateState;
  4028. end;
  4029.  
  4030. procedure TDataSource.AddDataLink(DataLink: TDataLink);
  4031. begin
  4032.   FDataLinks.Add(DataLink);
  4033.   DataLink.FDataSource := Self;
  4034.   if DataSet <> nil then DataSet.UpdateBufferCount;
  4035.   DataLink.UpdateState;
  4036. end;
  4037.  
  4038. procedure TDataSource.RemoveDataLink(DataLink: TDataLink);
  4039. begin
  4040.   DataLink.FDataSource := nil;
  4041.   FDataLinks.Remove(DataLink);
  4042.   DataLink.UpdateState;
  4043.   if DataSet <> nil then DataSet.UpdateBufferCount;
  4044. end;
  4045.  
  4046. procedure TDataSource.NotifyDataLinks(Event: TDataEvent; Info: Longint);
  4047. var
  4048.   I: Integer;
  4049. begin
  4050.   for I := 0 to FDataLinks.Count - 1 do
  4051.     with TDataLink(FDataLinks[I]) do
  4052.       if FBufferCount = 1 then DataEvent(Event, Info);
  4053.   for I := 0 to FDataLinks.Count - 1 do
  4054.     with TDataLink(FDataLinks[I]) do
  4055.       if FBufferCount > 1 then DataEvent(Event, Info);
  4056. end;
  4057.  
  4058. procedure TDataSource.DataEvent(Event: TDataEvent; Info: Longint);
  4059. begin
  4060.   if Event = deUpdateState then UpdateState else
  4061.     if FState <> dsInactive then
  4062.     begin
  4063.       NotifyDataLinks(Event, Info);
  4064.       case Event of
  4065.         deFieldChange:
  4066.           if Assigned(FOnDataChange) then FOnDataChange(Self, TField(Info));
  4067.         deRecordChange, deDataSetChange, deDataSetScroll, deLayoutChange:
  4068.           if Assigned(FOnDataChange) then FOnDataChange(Self, nil);
  4069.         deUpdateRecord:
  4070.           if Assigned(FOnUpdateData) then FOnUpdateData(Self);
  4071.       end;
  4072.     end;
  4073. end;
  4074.  
  4075. { TCheckConstraint }
  4076.  
  4077. procedure TCheckConstraint.Assign(Source: TPersistent);
  4078. begin
  4079.   if Source is TCheckConstraint then
  4080.   begin
  4081.     ImportedConstraint := TCheckConstraint(Source).ImportedConstraint;
  4082.     CustomConstraint := TCheckConstraint(Source).CustomConstraint;
  4083.     ErrorMessage := TCheckConstraint(Source).ErrorMessage;
  4084.   end
  4085.   else inherited Assign(Source);
  4086. end;
  4087.  
  4088. function TCheckConstraint.GetDisplayName: string;
  4089. begin
  4090.   Result := ImportedConstraint;
  4091.   if Result = '' then Result := CustomConstraint;
  4092.   if Result = '' then Result := inherited GetDisplayName;
  4093. end;
  4094.  
  4095. procedure TCheckConstraint.SetImportedConstraint(const Value: string);
  4096. begin
  4097.   if ImportedConstraint <> Value then
  4098.   begin
  4099.     FImportedConstraint := Value;
  4100.     Changed(True);
  4101.   end;
  4102. end;
  4103.  
  4104. procedure TCheckConstraint.SetCustomConstraint(const Value: string);
  4105. begin
  4106.   if CustomConstraint <> Value then
  4107.   begin
  4108.     FCustomConstraint := Value;
  4109.     Changed(True);
  4110.   end;
  4111. end;
  4112.  
  4113. procedure TCheckConstraint.SetErrorMessage(const Value: string);
  4114. begin
  4115.   if ErrorMessage <> Value then
  4116.   begin
  4117.     FErrorMessage := Value;
  4118.     Changed(True);
  4119.   end;
  4120. end;
  4121.  
  4122. { TCheckConstraints }
  4123.  
  4124. constructor TCheckConstraints.Create(Owner: TPersistent);
  4125. begin
  4126.   inherited Create(TCheckConstraint);
  4127.   FOwner := Owner;
  4128. end;
  4129.  
  4130. function TCheckConstraints.Add: TCheckConstraint;
  4131. begin
  4132.   Result := TCheckConstraint(inherited Add);
  4133. end;
  4134.  
  4135. function TCheckConstraints.GetOwner: TPersistent;
  4136. begin
  4137.   Result := FOwner;
  4138. end;
  4139.  
  4140. function TCheckConstraints.GetItem(Index: Integer): TCheckConstraint;
  4141. begin
  4142.   Result := TCheckConstraint(inherited GetItem(Index));
  4143. end;
  4144.  
  4145. procedure TCheckConstraints.SetItem(Index: Integer; Value: TCheckConstraint);
  4146. begin
  4147.   inherited SetItem(Index, Value);
  4148. end;
  4149.  
  4150. { TDataSet }
  4151.  
  4152. constructor TDataSet.Create(AOwner: TComponent);
  4153. begin
  4154.   inherited Create(AOwner);
  4155.   FFieldDefs := TFieldDefs.Create(Self);
  4156.   FFields := TList.Create;
  4157.   FDataSources := TList.Create;
  4158.   FAutoCalcFields := True;
  4159.   FConstraints := TCheckConstraints.Create(Self);
  4160.   ClearBuffers;
  4161. end;
  4162.  
  4163. destructor TDataSet.Destroy;
  4164. begin
  4165.   Destroying;
  4166.   Close;
  4167.   FDesigner.Free;
  4168.   if Assigned(FDataSources) then
  4169.     while FDataSources.Count > 0 do
  4170.       RemoveDataSource(FDataSources.Last);
  4171.   FDataSources.Free;
  4172.   if Assigned(FFields) then
  4173.     DestroyFields;
  4174.   FFields.Free;
  4175.   FFieldDefs.Free;
  4176.   FConstraints.Free;
  4177.   inherited Destroy;
  4178. end;
  4179.  
  4180. procedure TDataSet.SetName(const Value: TComponentName);
  4181. var
  4182.   I: Integer;
  4183.   OldName, FieldName, NamePrefix: TComponentName;
  4184.   Field: TField;
  4185. begin
  4186.   OldName := Name;
  4187.   inherited SetName(Value);
  4188.   if (csDesigning in ComponentState) and (Name <> OldName) then
  4189.     { In design mode the name of the fields should track the data set name }
  4190.     for I := 0 to FFields.Count - 1 do
  4191.     begin
  4192.       Field := FFields[I];
  4193.       if Field.Owner = Owner then
  4194.       begin
  4195.         FieldName := Field.Name;
  4196.         NamePrefix := FieldName;
  4197.         if Length(NamePrefix) > Length(OldName) then
  4198.         begin
  4199.           SetLength(NamePrefix, Length(OldName));
  4200.           if CompareText(OldName, NamePrefix) = 0 then
  4201.           begin
  4202.             System.Delete(FieldName, 1, Length(OldName));
  4203.             System.Insert(Value, FieldName, 1);
  4204.             try
  4205.               Field.Name := FieldName;
  4206.             except
  4207.               on EComponentError do {Ignore rename errors };
  4208.             end;
  4209.           end;
  4210.         end;
  4211.       end;
  4212.     end;
  4213. end;
  4214.  
  4215. procedure TDataSet.GetChildren(Proc: TGetChildProc; Root: TComponent);
  4216. var
  4217.   I: Integer;
  4218.   Field: TField;
  4219. begin
  4220.   for I := 0 to FFields.Count - 1 do
  4221.   begin
  4222.     Field := FFields[I];
  4223.     if Field.Owner = Root then Proc(Field);
  4224.   end;
  4225. end;
  4226.  
  4227. procedure TDataSet.SetChildOrder(Component: TComponent; Order: Integer);
  4228. begin
  4229.   if FFields.IndexOf(Component) >= 0 then
  4230.     (Component as TField).Index := Order;
  4231. end;
  4232.  
  4233. procedure TDataSet.Loaded;
  4234. begin
  4235.   inherited Loaded;
  4236.   try
  4237.     if FStreamedActive then Active := True;
  4238.   except
  4239.     if csDesigning in ComponentState then
  4240.       InternalHandleException else
  4241.       raise;
  4242.   end;
  4243. end;
  4244.  
  4245. procedure TDataSet.SetState(Value: TDataSetState);
  4246. begin
  4247.   if FState <> Value then
  4248.   begin
  4249.     FState := Value;
  4250.     FModified := False;
  4251.     DataEvent(deUpdateState, 0);
  4252.   end;
  4253. end;
  4254.  
  4255. procedure TDataSet.SetModified(Value: Boolean);
  4256. begin
  4257.   FModified := Value;
  4258. end;
  4259.  
  4260. function TDataSet.GetFound: Boolean;
  4261. begin
  4262.   Result := FFound;
  4263. end;
  4264.  
  4265. procedure TDataSet.SetFound(const Value: Boolean);
  4266. begin
  4267.   FFound := Value;
  4268. end;
  4269.  
  4270. function TDataSet.SetTempState(const Value: TDataSetState): TDataSetState;
  4271. begin
  4272.   Result := FState;
  4273.   FState := Value;
  4274.   Inc(FDisableCount);
  4275.   FModified := False;
  4276. end;
  4277.  
  4278. procedure TDataSet.RestoreState(const Value: TDataSetState);
  4279. begin
  4280.   FState := Value;
  4281.   Dec(FDisableCount);
  4282.   FModified := False;
  4283. end;
  4284.  
  4285. procedure TDataSet.Open;
  4286. begin
  4287.   Active := True;
  4288. end;
  4289.  
  4290. procedure TDataSet.Close;
  4291. begin
  4292.   Active := False;
  4293. end;
  4294.  
  4295. procedure TDataSet.CheckInactive;
  4296. begin
  4297.   if Active then
  4298.     if csUpdating in ComponentState then
  4299.       Close else
  4300.       DatabaseError(SDataSetOpen);
  4301. end;
  4302.  
  4303. procedure TDataSet.CheckActive;
  4304. begin
  4305.   if State = dsInactive then DatabaseError(SDataSetClosed);
  4306. end;
  4307.  
  4308. function TDataSet.GetActive: Boolean;
  4309. begin
  4310.   Result := State <> dsInactive;
  4311. end;
  4312.  
  4313. procedure TDataSet.SetActive(Value: Boolean);
  4314. begin
  4315.   if (csReading in ComponentState) then
  4316.   begin
  4317.     if Value then FStreamedActive := True;
  4318.   end
  4319.   else
  4320.     if Active <> Value then
  4321.     begin
  4322.       if Value then
  4323.       begin
  4324.         DoBeforeOpen;
  4325.         try
  4326.           OpenCursor(False);
  4327.           SetState(dsBrowse);
  4328.         except
  4329.           SetState(dsInactive);
  4330.           CloseCursor;
  4331.           raise;
  4332.         end;
  4333.         DoAfterOpen;
  4334.         DoAfterScroll;
  4335.       end else
  4336.       begin
  4337.         if not (csDestroying in ComponentState) then DoBeforeClose;
  4338.         SetState(dsInactive);
  4339.         CloseCursor;
  4340.         if not (csDestroying in ComponentState) then DoAfterClose;
  4341.       end;
  4342.     end;
  4343. end;
  4344.  
  4345. procedure TDataSet.DoInternalOpen;
  4346. begin
  4347.   FDefaultFields := FieldCount = 0;
  4348.   InternalOpen;
  4349.   UpdateBufferCount;
  4350.   FBOF := True;
  4351. end;
  4352.  
  4353. procedure TDataSet.DoInternalClose;
  4354. begin
  4355.   FreeFieldBuffers;
  4356.   ClearBuffers;
  4357.   SetBufListSize(0);
  4358.   InternalClose;
  4359.   FBufferCount := 0;
  4360.   FDefaultFields := False;
  4361. end;
  4362.  
  4363. procedure TDataSet.OpenCursor(InfoQuery: Boolean);
  4364. begin
  4365.   if InfoQuery then
  4366.     InternalInitFieldDefs else
  4367.     DoInternalOpen;
  4368. end;
  4369.  
  4370. procedure TDataSet.CloseCursor;
  4371. begin
  4372.   DoInternalClose;
  4373. end;
  4374.  
  4375. procedure TDataSet.InitFieldDefs;
  4376. begin
  4377.   if not Active then
  4378.     try
  4379.       OpenCursor(True);
  4380.     finally
  4381.       CloseCursor;
  4382.     end;
  4383. end;
  4384.  
  4385. { Field Management }
  4386.  
  4387. function TDataSet.GetFieldClass(FieldType: TFieldType): TFieldClass;
  4388. begin
  4389.   Result := DefaultFieldClasses[FieldType];
  4390. end;
  4391.  
  4392. procedure TDataSet.CreateFields;
  4393. var
  4394.   I: Integer;
  4395. begin
  4396.   for I := 0 to FFieldDefs.Count - 1 do
  4397.     with FFieldDefs[I] do
  4398.       if DataType <> ftUnknown then CreateField(Self);
  4399. end;
  4400.  
  4401. procedure TDataSet.DestroyFields;
  4402. var
  4403.   Field: TField;
  4404. begin
  4405.   while FFields.Count > 0 do
  4406.   begin
  4407.     Field := FFields.Last;
  4408.     RemoveField(Field);
  4409.     Field.Free;
  4410.   end;
  4411. end;
  4412.  
  4413. procedure TDataSet.BindFields(Binding: Boolean);
  4414. const
  4415.   CalcFieldTypes = [ftString, ftSmallint, ftInteger, ftWord, ftBoolean,
  4416.     ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime];
  4417.   BaseTypes: array[TFieldType] of TFieldType = (
  4418.     ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  4419.     ftBoolean, ftFloat, ftFloat, ftBCD, ftDate, ftTime, ftDateTime,
  4420.     ftBytes, ftVarBytes, ftInteger, ftBlob, ftBlob, ftBlob,
  4421.     ftBlob, ftBlob, ftBlob, ftBlob, ftUnknown);
  4422. var
  4423.   I: Integer;
  4424.   FieldDef: TFieldDef;
  4425. begin
  4426.   FCalcFieldsSize := 0;
  4427.   FBlobFieldCount := 0;
  4428.   FInternalCalcFields := False;
  4429.   for I := 0 to FFields.Count - 1 do
  4430.     with TField(FFields[I]) do
  4431.       if Binding then
  4432.       begin
  4433.         if FieldKind in [fkCalculated, fkLookup] then
  4434.         begin
  4435.           if not (DataType in CalcFieldTypes) then
  4436.             DatabaseErrorFmt(SInvalidCalcType, [DisplayName]);
  4437.           FFieldNo := -1;
  4438.           FOffset := FCalcFieldsSize;
  4439.           Inc(FCalcFieldsSize, DataSize + 1);
  4440.         end else
  4441.         begin
  4442.           FieldDef := FieldDefs.Find(FFieldName);
  4443.           if (BaseTypes[DataType] <> BaseTypes[FieldDef.DataType]) or
  4444.             (Size <> FieldDef.Size) then
  4445.           begin
  4446.             { Ignore size check for blob field types (BDE 3.5->4.0 comp issue) }
  4447.             if (BaseTypes[DataType] = ftBlob) then
  4448.               FSize := FieldDef.Size else
  4449.               DatabaseErrorFmt(SFieldTypeMismatch, [DisplayName]);
  4450.           end;
  4451.           FFieldNo := FieldDef.FieldNo;
  4452.           if FieldDef.InternalCalcField then
  4453.             FInternalCalcFields := True;
  4454.           if BaseTypes[FieldDef.DataType] = ftBlob then
  4455.           begin
  4456.             FOffset := FBlobFieldCount;
  4457.             Inc(FBlobFieldCount);
  4458.           end;
  4459.         end;
  4460.         Bind(True);
  4461.       end else
  4462.       begin
  4463.         Bind(False);
  4464.         FFieldNo := 0;
  4465.       end;
  4466. end;
  4467.  
  4468. procedure TDataSet.AddField(Field: TField);
  4469. begin
  4470.   FFields.Add(Field);
  4471.   Field.FDataSet := Self;
  4472.   DataEvent(deFieldListChange, 0)
  4473. end;
  4474.  
  4475. procedure TDataSet.RemoveField(Field: TField);
  4476. begin
  4477.   Field.FDataSet := nil;
  4478.   FFields.Remove(Field);
  4479.   if not (csDestroying in ComponentState) then
  4480.     DataEvent(deFieldListChange, 0)
  4481. end;
  4482.  
  4483. procedure TDataSet.FreeFieldBuffers;
  4484. var
  4485.   I: Integer;
  4486. begin
  4487.   for I := 0 to FFields.Count - 1 do TField(FFields[I]).FreeBuffers;
  4488. end;
  4489.  
  4490. procedure TDataSet.SetFieldDefs(Value: TFieldDefs);
  4491. begin
  4492.   FFieldDefs.Assign(Value);
  4493. end;
  4494.  
  4495. procedure TDataSet.UpdateFieldDefs;
  4496. begin
  4497.   if not FFieldDefs.FUpdated then
  4498.   begin
  4499.     InitFieldDefs;
  4500.     FFieldDefs.FUpdated := True;
  4501.   end;
  4502. end;
  4503.  
  4504. function TDataSet.GetFieldCount: Integer;
  4505. begin
  4506.   Result := FFields.Count;
  4507. end;
  4508.  
  4509. function TDataSet.GetField(Index: Integer): TField;
  4510. begin
  4511.   Result := FFields[Index];
  4512. end;
  4513.  
  4514. procedure TDataSet.SetField(Index: Integer; Value: TField);
  4515. begin
  4516.   TField(FFields[Index]).Assign(Value);
  4517. end;
  4518.  
  4519. function TDataSet.GetFieldValue(const FieldName: string): Variant;
  4520. var
  4521.   I: Integer;
  4522.   Fields: TList;
  4523. begin
  4524.   if Pos(';', FieldName) <> 0 then
  4525.   begin
  4526.     Fields := TList.Create;
  4527.     try
  4528.       GetFieldList(Fields, FieldName);
  4529.       Result := VarArrayCreate([0, Fields.Count - 1], varVariant);
  4530.       for I := 0 to Fields.Count - 1 do
  4531.         Result[I] := TField(Fields[I]).Value;
  4532.     finally
  4533.       Fields.Free;
  4534.     end;
  4535.   end else
  4536.     Result := FieldByName(FieldName).Value
  4537. end;
  4538.  
  4539. procedure TDataSet.SetFieldValue(const FieldName: string;
  4540.   const Value: Variant);
  4541. var
  4542.   I: Integer;
  4543.   Fields: TList;
  4544. begin
  4545.   if Pos(';', FieldName) <> 0 then
  4546.   begin
  4547.     Fields := TList.Create;
  4548.     try
  4549.       GetFieldList(Fields, FieldName);
  4550.       for I := 0 to Fields.Count - 1 do
  4551.         TField(Fields[I]).Value := Value[I];
  4552.     finally
  4553.       Fields.Free;
  4554.     end;
  4555.   end else
  4556.     FieldByName(FieldName).Value := Value;
  4557. end;
  4558.  
  4559. function TDataSet.FieldByName(const FieldName: string): TField;
  4560. begin
  4561.   Result := FindField(FieldName);
  4562.   if Result = nil then DatabaseErrorFmt(SFieldNotFound, [Name, FieldName]);
  4563. end;
  4564.  
  4565. function TDataSet.FieldByNumber(FieldNo: Integer): TField;
  4566. var
  4567.   I: Integer;
  4568. begin
  4569.   for I := 0 to FFields.Count - 1 do
  4570.   begin
  4571.     Result := Fields[I];
  4572.     if Result.FieldNo = FieldNo then Exit;
  4573.   end;
  4574.   Result := nil;
  4575. end;
  4576.  
  4577. function TDataSet.FindField(const FieldName: string): TField;
  4578. var
  4579.   I: Integer;
  4580. begin
  4581.   for I := 0 to FFields.Count - 1 do
  4582.   begin
  4583.     Result := FFields[I];
  4584.     if AnsiCompareText(Result.FFieldName, FieldName) = 0 then Exit;
  4585.   end;
  4586.   Result := nil;
  4587. end;
  4588.  
  4589. procedure TDataSet.SetConstraints(const Value: TCheckConstraints);
  4590. begin
  4591.   FConstraints.Assign(Value);
  4592. end;
  4593.  
  4594. procedure TDataSet.CheckFieldName(const FieldName: string);
  4595. begin
  4596.   if FieldName = '' then DatabaseError(SFieldNameMissing);
  4597.   if FindField(FieldName) <> nil then
  4598.     DatabaseErrorFmt(SDuplicateFieldName, [FieldName]);
  4599. end;
  4600.  
  4601. procedure TDataSet.CheckFieldNames(const FieldNames: string);
  4602. var
  4603.   Pos: Integer;
  4604. begin
  4605.   Pos := 1;
  4606.   while Pos <= Length(FieldNames) do
  4607.     FieldByName(ExtractFieldName(FieldNames, Pos));
  4608. end;
  4609.  
  4610. procedure TDataSet.GetFieldNames(List: TStrings);
  4611. var
  4612.   I: Integer;
  4613. begin
  4614.   List.BeginUpdate;
  4615.   try
  4616.     List.Clear;
  4617.     if FFields.Count > 0 then
  4618.       for I := 0 to FFields.Count - 1 do
  4619.         List.Add(TField(FFields[I]).FFieldName)
  4620.     else
  4621.     begin
  4622.       UpdateFieldDefs;
  4623.       for I := 0 to FFieldDefs.Count - 1 do
  4624.         List.Add(FFieldDefs[I].Name);
  4625.     end;
  4626.   finally
  4627.     List.EndUpdate;
  4628.   end;
  4629. end;
  4630.  
  4631. function TDataSet.GetStateFieldValue(State: TDataSetState; Field: TField): Variant;
  4632. var
  4633.   SaveState: TDataSetState;
  4634. begin
  4635.   if Field.FieldKind in [fkData, fkInternalCalc] then
  4636.   begin
  4637.     SaveState := FState;
  4638.     FState := State;
  4639.     try
  4640.       Result := Field.AsVariant;
  4641.     finally
  4642.       FState := SaveState;
  4643.     end;
  4644.   end else
  4645.     Result := NULL;
  4646. end;
  4647.  
  4648. procedure TDataSet.SetStateFieldValue(State: TDataSetState; Field: TField; Value: Variant);
  4649. var
  4650.   SaveState: TDataSetState;
  4651. begin
  4652.   if Field.FieldKind <> fkData then Exit;
  4653.   SaveState := FState;
  4654.   FState := State;
  4655.   try
  4656.     Field.AsVariant := Value;
  4657.   finally
  4658.     FState := SaveState;
  4659.   end;
  4660. end;
  4661.  
  4662. procedure TDataSet.CloseBlob(Field: TField);
  4663. begin
  4664. end;
  4665.  
  4666. function TDataSet.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
  4667. begin
  4668.   Result := nil;
  4669. end;
  4670.  
  4671. function TDataSet.BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean;
  4672. begin
  4673.   Result := False;
  4674. end;
  4675.  
  4676. function TDataSet.CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  4677.   Decimals: Integer): Boolean;
  4678. begin
  4679.   Result := False;
  4680. end;
  4681.  
  4682. { Index Related }
  4683.  
  4684. function TDataSet.GetIsIndexField(Field: TField): Boolean;
  4685. begin
  4686.   Result := False;
  4687. end;
  4688.  
  4689. procedure TDataSet.UpdateIndexDefs;
  4690. begin
  4691. end;
  4692.  
  4693. { Datasource/Datalink Interaction }
  4694.  
  4695. function TDataSet.GetDataSource: TDataSource;
  4696. begin
  4697.   Result := nil;
  4698. end;
  4699.  
  4700. function TDataSet.IsLinkedTo(DataSource: TDataSource): Boolean;
  4701. var
  4702.   DataSet: TDataSet;
  4703. begin
  4704.   Result := True;
  4705.   while DataSource <> nil do
  4706.   begin
  4707.     DataSet := DataSource.DataSet;
  4708.     if DataSet = nil then Break;
  4709.     if DataSet = Self then Exit;
  4710.     DataSource := DataSet.DataSource;
  4711.   end;
  4712.   Result := False;
  4713. end;
  4714.  
  4715. procedure TDataSet.AddDataSource(DataSource: TDataSource);
  4716. begin
  4717.   FDataSources.Add(DataSource);
  4718.   DataSource.FDataSet := Self;
  4719.   UpdateBufferCount;
  4720.   DataSource.UpdateState;
  4721. end;
  4722.  
  4723. procedure TDataSet.RemoveDataSource(DataSource: TDataSource);
  4724. begin
  4725.   DataSource.FDataSet := nil;
  4726.   FDataSources.Remove(DataSource);
  4727.   DataSource.UpdateState;
  4728.   UpdateBufferCount;
  4729. end;
  4730.  
  4731. procedure TDataSet.DataEvent(Event: TDataEvent; Info: Longint);
  4732. var
  4733.   I: Integer;
  4734. begin
  4735.   case Event of
  4736.     deFieldChange:
  4737.       begin
  4738.         if TField(Info).FieldKind in [fkData, fkInternalCalc] then
  4739.           FModified := True;
  4740.         if State <> dsSetKey then
  4741.         begin
  4742.           if FInternalCalcFields and (TField(Info).FieldKind = fkData) then
  4743.             RefreshInternalCalcFields(ActiveBuffer)
  4744.           else if (FCalcFieldsSize <> 0) and FAutoCalcFields and
  4745.             (TField(Info).FieldKind = fkData) then
  4746.             CalculateFields(ActiveBuffer);
  4747.           TField(Info).Change;
  4748.         end;
  4749.       end;
  4750.     dePropertyChange:
  4751.       FFieldDefs.FUpdated := False;
  4752.   end;
  4753.   if FDisableCount = 0 then
  4754.   begin
  4755.     for I := 0 to FDataSources.Count - 1 do
  4756.       TDataSource(FDataSources[I]).DataEvent(Event, Info);
  4757.     if FDesigner <> nil then FDesigner.DataEvent(Event, Info);
  4758.   end else
  4759.     if (Event = deUpdateState) and (State = dsInactive) or
  4760.       (Event = deLayoutChange) then FEnableEvent := deLayoutChange;
  4761. end;
  4762.  
  4763. function TDataset.ControlsDisabled: Boolean;
  4764. begin
  4765.   Result := FDisableCount <> 0;
  4766. end;
  4767.  
  4768. procedure TDataSet.DisableControls;
  4769. begin
  4770.   if FDisableCount = 0 then
  4771.   begin
  4772.     FDisableState := FState;
  4773.     FEnableEvent := deDataSetChange;
  4774.   end;
  4775.   Inc(FDisableCount);
  4776. end;
  4777.  
  4778. procedure TDataSet.EnableControls;
  4779. begin
  4780.   if FDisableCount <> 0 then
  4781.   begin
  4782.     Dec(FDisableCount);
  4783.     if FDisableCount = 0 then
  4784.     begin
  4785.       if FDisableState <> FState then DataEvent(deUpdateState, 0);
  4786.       if (FDisableState <> dsInactive) and (FState <> dsInactive) then
  4787.         DataEvent(FEnableEvent, 0);
  4788.     end;
  4789.   end;
  4790. end;
  4791.  
  4792. procedure TDataSet.UpdateRecord;
  4793. begin
  4794.   if not (State in dsEditModes) then DatabaseError(SNotEditing);
  4795.   DataEvent(deUpdateRecord, 0);
  4796. end;
  4797.  
  4798. { Buffer Management }
  4799.  
  4800. procedure TDataSet.SetBufListSize(Value: Integer);
  4801. var
  4802.   I: Integer;
  4803.   NewList: PBufferList;
  4804. begin
  4805.   if FBufListSize <> Value then
  4806.   begin
  4807.     if Value > 0 then
  4808.       GetMem(NewList, Value * SizeOf(Pointer)) else
  4809.       NewList := nil;
  4810.     if FBufListSize > Value then
  4811.     begin
  4812.       if Value <> 0 then
  4813.         Move(FBuffers^, NewList^, Value * SizeOf(Pointer));
  4814.       for I := Value to FBufListSize - 1 do
  4815.         FreeRecordBuffer(FBuffers^[I]);
  4816.     end else
  4817.     begin
  4818.       if FBufListSize <> 0 then
  4819.         Move(FBuffers^, NewList^, FBufListSize * SizeOf(Pointer));
  4820.       I := FBufListSize;
  4821.       try
  4822.         while I < Value do
  4823.         begin
  4824.           NewList^[I] := AllocRecordBuffer;
  4825.           Inc(I);
  4826.         end;
  4827.       except
  4828.         while I > FBufListSize do
  4829.         begin
  4830.           FreeRecordBuffer(NewList^[I]);
  4831.           Dec(I);
  4832.         end;
  4833.         FreeMem(NewList, Value * SizeOf(Pointer));
  4834.         raise;
  4835.       end;
  4836.     end;
  4837.     FreeMem(FBuffers, FBufListSize * SizeOf(Pointer));
  4838.     FBuffers := NewList;
  4839.     FBufListSize := Value;
  4840.   end;
  4841. end;
  4842.  
  4843. procedure TDataSet.SetBufferCount(Value: Integer);
  4844. var
  4845.   I, Delta: Integer;
  4846.   DataLink: TDataLink;
  4847.  
  4848.   procedure AdjustFirstRecord(Delta: Integer);
  4849.   var
  4850.     DataLink: TDataLink;
  4851.   begin
  4852.     if Delta <> 0 then
  4853.     begin
  4854.       DataLink := FFirstDataLink;
  4855.       while DataLink <> nil do
  4856.       begin
  4857.         if DataLink.Active then Inc(DataLink.FFirstRecord, Delta);
  4858.         DataLink := DataLink.FNext;
  4859.       end;
  4860.     end;
  4861.   end;
  4862.  
  4863. begin
  4864.   if FBufferCount <> Value then
  4865.   begin
  4866.     if (FBufferCount > Value) and (FRecordCount > 0) then
  4867.     begin
  4868.       Delta := FActiveRecord;
  4869.       DataLink := FFirstDataLink;
  4870.       while DataLink <> nil do
  4871.       begin
  4872.         if DataLink.Active and (DataLink.FFirstRecord < Delta) then
  4873.           Delta := DataLink.FFirstRecord;
  4874.         DataLink := DataLink.FNext;
  4875.       end;
  4876.       for I := 0 to Value - 1 do MoveBuffer(I + Delta, I);
  4877.       Dec(FActiveRecord, Delta);
  4878.       if FCurrentRecord <> -1 then Dec(FCurrentRecord, Delta);
  4879.       if FRecordCount > Value then FRecordCount := Value;
  4880.       AdjustFirstRecord(-Delta);
  4881.     end;
  4882.     SetBufListSize(Value + 1);
  4883.     FBufferCount := Value;
  4884.     GetNextRecords;
  4885.     AdjustFirstRecord(GetPriorRecords);
  4886.   end;
  4887. end;
  4888.  
  4889. procedure TDataSet.UpdateBufferCount;
  4890. var
  4891.   I, J, MaxBufferCount: Integer;
  4892.   DataLink: TDataLink;
  4893. begin
  4894.   if IsCursorOpen then
  4895.   begin
  4896.     MaxBufferCount := 1;
  4897.     FFirstDataLink := nil;
  4898.     for I := FDataSources.Count - 1 downto 0 do
  4899.       with TDataSource(FDataSources[I]) do
  4900.         for J := FDataLinks.Count - 1 downto 0 do
  4901.         begin
  4902.           DataLink := FDataLinks[J];
  4903.           DataLink.FNext := FFirstDataLink;
  4904.           FFirstDataLink := DataLink;
  4905.           if DataLink.FBufferCount > MaxBufferCount then
  4906.             MaxBufferCount := DataLink.FBufferCount;
  4907.         end;
  4908.     SetBufferCount(MaxBufferCount);
  4909.   end;
  4910. end;
  4911.  
  4912. procedure TDataSet.SetCurrentRecord(Index: Integer);
  4913. var
  4914.   Buffer: PChar;
  4915. begin
  4916.   if FCurrentRecord <> Index then
  4917.   begin
  4918.     Buffer := FBuffers[Index];
  4919.     case GetBookmarkFlag(Buffer) of
  4920.       bfCurrent,
  4921.       bfInserted: InternalSetToRecord(Buffer);
  4922.       bfBOF: InternalFirst;
  4923.       bfEOF: InternalLast;
  4924.     end;
  4925.     FCurrentRecord := Index;
  4926.   end;
  4927. end;
  4928.  
  4929. function TDataSet.GetBuffer(Index: Integer): PChar;
  4930. begin
  4931.   Result := FBuffers[Index];
  4932. end;
  4933.  
  4934. function TDataSet.GetNextRecord: Boolean;
  4935. var
  4936.   GetMode: TGetMode;
  4937. begin
  4938.   GetMode := gmNext;
  4939.   if FRecordCount > 0 then
  4940.   begin
  4941.     SetCurrentRecord(FRecordCount - 1);
  4942.     if (State = dsInsert) and (FCurrentRecord = FActiveRecord) and
  4943.       (GetBookmarkFlag(ActiveBuffer) = bfCurrent) then GetMode := gmCurrent;
  4944.   end;
  4945.   Result := (GetRecord(FBuffers[FRecordCount], GetMode, True) = grOK);
  4946.   if Result then
  4947.   begin
  4948.     if FRecordCount = 0 then
  4949.       ActivateBuffers
  4950.     else
  4951.       if FRecordCount < FBufferCount then
  4952.         Inc(FRecordCount) else
  4953.         MoveBuffer(0, FRecordCount);
  4954.     FCurrentRecord := FRecordCount - 1;
  4955.     Result := True;
  4956.   end else
  4957.     CursorPosChanged;
  4958. end;
  4959.  
  4960. function TDataSet.GetPriorRecord: Boolean;
  4961. begin
  4962.   if FRecordCount > 0 then SetCurrentRecord(0);
  4963.   Result := (GetRecord(FBuffers[FRecordCount], gmPrior, True) = grOK);
  4964.   if Result then
  4965.   begin
  4966.     if FRecordCount = 0 then
  4967.       ActivateBuffers else
  4968.     begin
  4969.       MoveBuffer(FRecordCount, 0);
  4970.       if FRecordCount < FBufferCount then
  4971.       begin
  4972.         Inc(FRecordCount);
  4973.         Inc(FActiveRecord);
  4974.       end;
  4975.     end;
  4976.     FCurrentRecord := 0;
  4977.   end else
  4978.     CursorPosChanged;
  4979. end;
  4980.  
  4981. procedure TDataSet.Resync(Mode: TResyncMode);
  4982. var
  4983.   Count: Integer;
  4984. begin
  4985.   if rmExact in Mode then
  4986.   begin
  4987.     CursorPosChanged;
  4988.     if GetRecord(FBuffers[FRecordCount], gmCurrent, True) <> grOK then
  4989.       DatabaseError(SRecordNotFound);
  4990.   end else
  4991.     if (GetRecord(FBuffers[FRecordCount], gmCurrent, False) <> grOK) and
  4992.       (GetRecord(FBuffers[FRecordCount], gmNext, False) <> grOK) and
  4993.       (GetRecord(FBuffers[FRecordCount], gmPrior, False) <> grOK) then
  4994.     begin
  4995.       ClearBuffers;
  4996.       DataEvent(deDataSetChange, 0);
  4997.       Exit;
  4998.     end;
  4999.   if rmCenter in Mode then
  5000.     Count := (FBufferCount - 1) div 2 else
  5001.     Count := FActiveRecord;
  5002.   MoveBuffer(FRecordCount, 0);
  5003.   ActivateBuffers;
  5004.   try
  5005.     while (Count > 0) and GetPriorRecord do Dec(Count);
  5006.     GetNextRecords;
  5007.     GetPriorRecords;
  5008.   except
  5009.   end;
  5010.   DataEvent(deDataSetChange, 0);
  5011. end;
  5012.  
  5013. procedure TDataSet.MoveBuffer(CurIndex, NewIndex: Integer);
  5014. var
  5015.   Buffer: PChar;
  5016. begin
  5017.   if CurIndex <> NewIndex then
  5018.   begin
  5019.     Buffer := FBuffers[CurIndex];
  5020.     if CurIndex < NewIndex then
  5021.       Move(FBuffers[CurIndex + 1], FBuffers[CurIndex],
  5022.         (NewIndex - CurIndex) * SizeOf(Pointer))
  5023.     else
  5024.       Move(FBuffers[NewIndex], FBuffers[NewIndex + 1],
  5025.         (CurIndex - NewIndex) * SizeOf(Pointer));
  5026.     FBuffers[NewIndex] := Buffer;
  5027.   end;
  5028. end;
  5029.  
  5030. function TDataSet.ActiveBuffer: PChar;
  5031. begin
  5032.   Result := FBuffers[FActiveRecord];
  5033. end;
  5034.  
  5035. function TDataSet.TempBuffer: PChar;
  5036. begin
  5037.   Result := FBuffers[FRecordCount];
  5038. end;
  5039.  
  5040. procedure TDataSet.ClearBuffers;
  5041. begin
  5042.   FRecordCount := 0;
  5043.   FActiveRecord := 0;
  5044.   FCurrentRecord := -1;
  5045.   FBOF := True;
  5046.   FEOF := True;
  5047. end;
  5048.  
  5049. procedure TDataSet.ActivateBuffers;
  5050. begin
  5051.   FRecordCount := 1;
  5052.   FActiveRecord := 0;
  5053.   FCurrentRecord := 0;
  5054.   FBOF := False;
  5055.   FEOF := False;
  5056. end;
  5057.  
  5058. procedure TDataSet.UpdateCursorPos;
  5059. begin
  5060.   if FRecordCount > 0 then SetCurrentRecord(FActiveRecord);
  5061. end;
  5062.  
  5063. procedure TDataSet.CursorPosChanged;
  5064. begin
  5065.   FCurrentRecord := -1;
  5066. end;
  5067.  
  5068. function TDataSet.GetCurrentRecord(Buffer: PChar): Boolean;
  5069. begin
  5070.   Result := False;
  5071. end;
  5072.  
  5073. function TDataSet.GetNextRecords: Integer;
  5074. begin
  5075.   Result := 0;
  5076.   try
  5077.     while (FRecordCount < FBufferCount) and GetNextRecord do Inc(Result);
  5078.   except
  5079.   end;
  5080. end;
  5081.  
  5082. function TDataSet.GetPriorRecords: Integer;
  5083. begin
  5084.   Result := 0;
  5085.   try
  5086.     while (FRecordCount < FBufferCount) and GetPriorRecord do Inc(Result);
  5087.   except
  5088.   end;
  5089. end;
  5090.  
  5091. procedure TDataSet.InitRecord(Buffer: PChar);
  5092. begin
  5093.   InternalInitRecord(Buffer);
  5094.   ClearCalcFields(Buffer);
  5095.   SetBookmarkFlag(Buffer, bfInserted);
  5096. end;
  5097.  
  5098. function TDataSet.IsEmpty: Boolean;
  5099. begin
  5100.   Result := FActiveRecord >= FRecordCount;
  5101. end;
  5102.  
  5103. procedure TDataSet.GetCalcFields(Buffer: PChar);
  5104. var
  5105.   SaveState: TDataSetState;
  5106. begin
  5107.   if (FCalcFieldsSize > 0) or FInternalCalcFields then
  5108.   begin
  5109.     SaveState := FState;
  5110.     FState := dsCalcFields;
  5111.     try
  5112.       CalculateFields(Buffer);
  5113.     finally
  5114.       FState := SaveState;
  5115.     end;
  5116.   end;
  5117. end;
  5118.  
  5119. procedure TDataSet.CalculateFields(Buffer: PChar);
  5120. var
  5121.   I: Integer;
  5122. begin
  5123.   FCalcBuffer := Buffer;
  5124.   ClearCalcFields(CalcBuffer);
  5125.   for I := 0 to FFields.Count - 1 do
  5126.     with TField(FFields[I]) do
  5127.       if FieldKind = fkLookup then CalcLookupValue;
  5128.   DoOnCalcFields;
  5129. end;
  5130.  
  5131. procedure TDataSet.ClearCalcFields(Buffer: PChar);
  5132. begin
  5133. end;
  5134.  
  5135. procedure TDataSet.RefreshInternalCalcFields(Buffer: PChar);
  5136. var
  5137.   I: Integer;
  5138. begin
  5139.   for I := 0 to FieldCount - 1 do
  5140.     with Fields[I] do
  5141.       if (FieldKind = fkInternalCalc) then Value := Value;
  5142. end;
  5143.  
  5144. { Navigation }
  5145.  
  5146. procedure TDataSet.First;
  5147. begin
  5148.   CheckBrowseMode;
  5149.   DoBeforeScroll;
  5150.   ClearBuffers;
  5151.   try
  5152.     InternalFirst;
  5153.     GetNextRecord;
  5154.     GetNextRecords;
  5155.   finally
  5156.     FBOF := True;
  5157.     DataEvent(deDataSetChange, 0);
  5158.     DoAfterScroll;
  5159.   end;
  5160. end;
  5161.  
  5162. procedure TDataSet.Last;
  5163. begin
  5164.   CheckBrowseMode;
  5165.   DoBeforeScroll;
  5166.   ClearBuffers;
  5167.   try
  5168.     InternalLast;
  5169.     GetPriorRecord;
  5170.     GetPriorRecords;
  5171.   finally
  5172.     FEOF := True;
  5173.     DataEvent(deDataSetChange, 0);
  5174.     DoAfterScroll;
  5175.   end;
  5176. end;
  5177.  
  5178. function TDataSet.MoveBy(Distance: Integer): Integer;
  5179. var
  5180.   OldRecordCount, ScrollCount, I: Integer;
  5181. begin
  5182.   CheckBrowseMode;
  5183.   Result := 0;
  5184.   DoBeforeScroll;
  5185.   if ((Distance > 0) and not FEOF) or ((Distance < 0) and not FBOF) then
  5186.   begin
  5187.     FBOF := False;
  5188.     FEOF := False;
  5189.     OldRecordCount := FRecordCount;
  5190.     ScrollCount := 0;
  5191.     try
  5192.       while Distance > 0 do
  5193.       begin
  5194.         if FActiveRecord < FRecordCount - 1 then Inc(FActiveRecord) else
  5195.         begin
  5196.           if FRecordCount < FBufferCount then I := 0 else I := 1;
  5197.           if GetNextRecord then
  5198.           begin
  5199.             Dec(ScrollCount, I);
  5200.             if FActiveRecord < FRecordCount - 1 then Inc(FActiveRecord);
  5201.           end else
  5202.           begin
  5203.             FEOF := True;
  5204.             Break;
  5205.           end;
  5206.         end;
  5207.         Dec(Distance);
  5208.         Inc(Result);
  5209.       end;
  5210.       while Distance < 0 do
  5211.       begin
  5212.         if FActiveRecord > 0 then Dec(FActiveRecord) else
  5213.         begin
  5214.           if FRecordCount < FBufferCount then I := 0 else I := 1;
  5215.           if GetPriorRecord then
  5216.           begin
  5217.             Inc(ScrollCount, I);
  5218.             if FActiveRecord > 0 then Dec(FActiveRecord);
  5219.           end else
  5220.           begin
  5221.             FBOF := True;
  5222.             Break;
  5223.           end;
  5224.         end;
  5225.         Inc(Distance);
  5226.         Dec(Result);
  5227.       end;
  5228.     finally
  5229.       if FRecordCount <> OldRecordCount then
  5230.         DataEvent(deDataSetChange, 0) else
  5231.         DataEvent(deDataSetScroll, ScrollCount);
  5232.       DoAfterScroll;
  5233.     end;
  5234.   end;
  5235. end;
  5236.  
  5237. procedure TDataSet.Next;
  5238. begin
  5239.   MoveBy(1);
  5240. end;
  5241.  
  5242. procedure TDataSet.Prior;
  5243. begin
  5244.   MoveBy(-1);
  5245. end;
  5246.  
  5247. procedure TDataSet.Refresh;
  5248. begin
  5249.   CheckBrowseMode;
  5250.   UpdateCursorPos;
  5251.   InternalRefresh;
  5252.   Resync([]);
  5253. end;
  5254.  
  5255. { Editing }
  5256.  
  5257. procedure TDataSet.Edit;
  5258. begin
  5259.   if not (State in [dsEdit, dsInsert]) then
  5260.     if FRecordCount = 0 then Insert else
  5261.     begin
  5262.       CheckBrowseMode;
  5263.       CheckCanModify;
  5264.       DoBeforeEdit;
  5265.       CheckOperation(InternalEdit, FOnEditError);
  5266.       GetCalcFields(ActiveBuffer);
  5267.       SetState(dsEdit);
  5268.       DataEvent(deRecordChange, 0);
  5269.       DoAfterEdit;
  5270.     end;
  5271. end;
  5272.  
  5273. procedure TDataSet.Insert;
  5274. var
  5275.   Buffer: PChar;
  5276.   OldCurrent: TBookmarkStr;
  5277. begin
  5278.   BeginInsertAppend;
  5279.   OldCurrent := Bookmark;
  5280.   MoveBuffer(FRecordCount, FActiveRecord);
  5281.   Buffer := ActiveBuffer;
  5282.   InitRecord(Buffer);
  5283.   if FRecordCount = 0 then
  5284.     SetBookmarkFlag(Buffer, bfBOF) else
  5285.     SetBookmarkData(Buffer, Pointer(OldCurrent));
  5286.   if FRecordCount < FBufferCount then Inc(FRecordCount);
  5287.   EndInsertAppend;
  5288. end;
  5289.  
  5290. procedure TDataSet.Append;
  5291. var
  5292.   Buffer: PChar;
  5293. begin
  5294.   BeginInsertAppend;
  5295.   ClearBuffers;
  5296.   Buffer := FBuffers[0];
  5297.   InitRecord(Buffer);
  5298.   SetBookmarkFlag(Buffer, bfEOF);
  5299.   FRecordCount := 1;
  5300.   FBOF := False;
  5301.   GetPriorRecords;
  5302.   EndInsertAppend;
  5303. end;
  5304.  
  5305. procedure TDataSet.Post;
  5306. begin
  5307.   UpdateRecord;
  5308.   case State of
  5309.     dsEdit, dsInsert:
  5310.       begin
  5311.         DataEvent(deCheckBrowseMode, 0);
  5312.         CheckRequiredFields;
  5313.         DoBeforePost;
  5314.         CheckOperation(InternalPost, FOnPostError);
  5315.         FreeFieldBuffers;
  5316.         SetState(dsBrowse);
  5317.         Resync([]);
  5318.         DoAfterPost;
  5319.       end;
  5320.   end;
  5321. end;
  5322.  
  5323. procedure TDataSet.Cancel;
  5324. begin
  5325.   case State of
  5326.     dsEdit, dsInsert:
  5327.       begin
  5328.         DataEvent(deCheckBrowseMode, 0);
  5329.         DoBeforeCancel;
  5330.         UpdateCursorPos;
  5331.         if State = dsEdit then InternalCancel;
  5332.         FreeFieldBuffers;
  5333.         SetState(dsBrowse);
  5334.         Resync([]);
  5335.         DoAfterCancel;
  5336.       end;
  5337.   end;
  5338. end;
  5339.  
  5340. procedure TDataSet.Delete;
  5341. begin
  5342.   CheckActive;
  5343.   if State in [dsInsert, dsSetKey] then Cancel else
  5344.   begin
  5345.     if FRecordCount = 0 then DatabaseError(SDataSetEmpty);
  5346.     DataEvent(deCheckBrowseMode, 0);
  5347.     DoBeforeDelete;
  5348.     DoBeforeScroll;
  5349.     CheckOperation(InternalDelete, FOnDeleteError);
  5350.     FreeFieldBuffers;
  5351.     SetState(dsBrowse);
  5352.     Resync([]);
  5353.     DoAfterDelete;
  5354.     DoAfterScroll;
  5355.   end;
  5356. end;
  5357.  
  5358. procedure TDataSet.BeginInsertAppend;
  5359. begin
  5360.   CheckBrowseMode;
  5361.   CheckCanModify;
  5362.   DoBeforeInsert;
  5363.   DoBeforeScroll;
  5364. end;
  5365.  
  5366. procedure TDataSet.EndInsertAppend;
  5367. begin
  5368.   SetState(dsInsert);
  5369.   try
  5370.     DoOnNewRecord;
  5371.   except
  5372.     UpdateCursorPos;
  5373.     FreeFieldBuffers;
  5374.     SetState(dsBrowse);
  5375.     Resync([]);
  5376.     raise;
  5377.   end;
  5378.   FModified := False;
  5379.   DataEvent(deDataSetChange, 0);
  5380.   DoAfterInsert;
  5381.   DoAfterScroll;
  5382. end;
  5383.  
  5384. procedure TDataSet.AddRecord(const Values: array of const; Append: Boolean);
  5385. var
  5386.   Buffer: PChar;
  5387. begin
  5388.   BeginInsertAppend;
  5389.   if not Append then UpdateCursorPos;
  5390.   DisableControls;
  5391.   try
  5392.     MoveBuffer(FRecordCount, FActiveRecord);
  5393.     try
  5394.       Buffer := ActiveBuffer;
  5395.       InitRecord(Buffer);
  5396.       FState := dsInsert;
  5397.       try
  5398.         DoOnNewRecord;
  5399.         DoAfterInsert;
  5400.         SetFields(Values);
  5401.         DoBeforePost;
  5402.         InternalAddRecord(Buffer, Append);
  5403.       finally
  5404.         FreeFieldBuffers;
  5405.         FState := dsBrowse;
  5406.         FModified := False;
  5407.       end;
  5408.     except
  5409.       MoveBuffer(FActiveRecord, FRecordCount);
  5410.       raise;
  5411.     end;
  5412.     Resync([]);
  5413.     DoAfterPost;
  5414.   finally
  5415.     EnableControls;
  5416.   end;
  5417. end;
  5418.  
  5419. procedure TDataSet.InsertRecord(const Values: array of const);
  5420. begin
  5421.   AddRecord(Values, False);
  5422. end;
  5423.  
  5424. procedure TDataSet.AppendRecord(const Values: array of const);
  5425. begin
  5426.   AddRecord(Values, True);
  5427. end;
  5428.  
  5429. procedure TDataSet.CheckOperation(Operation: TDataOperation;
  5430.   ErrorEvent: TDataSetErrorEvent);
  5431. var
  5432.   Done: Boolean;
  5433.   Action: TDataAction;
  5434. begin
  5435.   Done := False;
  5436.   repeat
  5437.     try
  5438.       UpdateCursorPos;
  5439.       Operation;
  5440.       Done := True;
  5441.     except
  5442.       on E: EDatabaseError do
  5443.       begin
  5444.         Action := daFail;
  5445.         if Assigned(ErrorEvent) then ErrorEvent(Self, E, Action);
  5446.         if Action = daFail then raise;
  5447.         if Action = daAbort then SysUtils.Abort;
  5448.       end;
  5449.     end;
  5450.   until Done;
  5451. end;
  5452.  
  5453. procedure TDataSet.SetFields(const Values: array of const);
  5454. var
  5455.   I: Integer;
  5456. begin
  5457.   for I := 0 to High(Values) do Fields[I].AssignValue(Values[I]);
  5458. end;
  5459.  
  5460. procedure TDataSet.ClearFields;
  5461. begin
  5462.   if not (State in dsEditModes) then DatabaseError(SNotEditing);
  5463.   DataEvent(deCheckBrowseMode, 0);
  5464.   InternalInitRecord(ActiveBuffer);
  5465.   if State <> dsSetKey then GetCalcFields(ActiveBuffer);
  5466.   DataEvent(deRecordChange, 0);
  5467. end;
  5468.  
  5469. procedure TDataSet.CheckRequiredFields;
  5470. var
  5471.   I: Integer;
  5472. begin
  5473.   for I := 0 to FFields.Count - 1 do
  5474.     with TField(FFields[I]) do
  5475.       if Required and not ReadOnly and (FieldKind = fkData) and IsNull then
  5476.       begin
  5477.         FocusControl;
  5478.         DatabaseErrorFmt(SFieldRequired, [DisplayName]);
  5479.       end;
  5480. end;
  5481.  
  5482. { Bookmarks }
  5483.  
  5484. function TDataset.BookmarkAvailable: Boolean;
  5485. begin
  5486.   Result := (State in [dsBrowse, dsEdit, dsInsert]) and not IsEmpty
  5487.     and (GetBookmarkFlag(ActiveBuffer) = bfCurrent);
  5488. end;
  5489.  
  5490. function TDataSet.GetBookmark: TBookmark;
  5491. begin
  5492.   if BookmarkAvailable then
  5493.   begin
  5494.     Result := StrAlloc(FBookmarkSize);
  5495.     GetBookmarkData(ActiveBuffer, Result);
  5496.   end else
  5497.     Result := nil;
  5498. end;
  5499.  
  5500. function TDataset.GetBookmarkStr: TBookmarkStr;
  5501. begin
  5502.   if BookmarkAvailable then
  5503.   begin
  5504.     SetLength(Result, BookmarkSize);
  5505.     GetBookmarkData(ActiveBuffer, Pointer(Result));
  5506.   end else
  5507.     Result := '';
  5508. end;
  5509.  
  5510. procedure TDataSet.GotoBookmark(Bookmark: TBookmark);
  5511. begin
  5512.   if Bookmark <> nil then
  5513.   begin
  5514.     CheckBrowseMode;
  5515.     DoBeforeScroll;
  5516.     InternalGotoBookmark(Bookmark);
  5517.     Resync([rmExact, rmCenter]);
  5518.     DoAfterScroll;
  5519.   end;
  5520. end;
  5521.  
  5522. procedure TDataset.SetBookmarkStr(const Value: TBookmarkStr);
  5523. begin
  5524.   GotoBookmark(Pointer(Value));
  5525. end;
  5526.  
  5527. function TDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
  5528. begin
  5529.   Result := False;
  5530. end;
  5531.  
  5532. function TDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer;
  5533. begin
  5534.   Result := 0;
  5535. end;
  5536.  
  5537. procedure TDataSet.FreeBookmark(Bookmark: TBookmark);
  5538. begin
  5539.   StrDispose(Bookmark);
  5540. end;
  5541.  
  5542. procedure TDataSet.InternalCancel;
  5543. begin
  5544. end;
  5545.  
  5546. procedure TDataSet.InternalEdit;
  5547. begin
  5548. end;
  5549.  
  5550. procedure TDataSet.InternalRefresh;
  5551. begin
  5552. end;
  5553.  
  5554. procedure TDataSet.Translate(Src, Dest: PChar; ToOem: Boolean);
  5555. begin
  5556.   if (Src <> nil) and (Src <> Dest) then
  5557.     StrCopy(Dest, Src);
  5558. end;
  5559.  
  5560. { Filter / Locate / Find }
  5561.  
  5562. function TDataSet.FindRecord(Restart, GoForward: Boolean): Boolean;
  5563. begin
  5564.   Result := False;
  5565. end;
  5566.  
  5567. function TDataSet.FindFirst: Boolean;
  5568. begin
  5569.   Result := FindRecord(True, True);
  5570. end;
  5571.  
  5572. function TDataSet.FindLast: Boolean;
  5573. begin
  5574.   Result := FindRecord(True, False);
  5575. end;
  5576.  
  5577. function TDataSet.FindNext: Boolean;
  5578. begin
  5579.   Result := FindRecord(False, True);
  5580. end;
  5581.  
  5582. function TDataSet.FindPrior: Boolean;
  5583. begin
  5584.   Result := FindRecord(False, False);
  5585. end;
  5586.  
  5587. procedure TDataSet.SetFiltered(Value: Boolean);
  5588. begin
  5589.   FFiltered := Value;
  5590. end;
  5591.  
  5592. procedure TDataSet.SetFilterOptions(Value: TFilterOptions);
  5593. begin
  5594.   FFilterOptions := Value;
  5595. end;
  5596.  
  5597. procedure TDataSet.SetFilterText(const Value: string);
  5598. begin
  5599.   FFilterText := Value;
  5600. end;
  5601.  
  5602. procedure TDataSet.SetOnFilterRecord(const Value: TFilterRecordEvent);
  5603. begin
  5604.   FOnFilterRecord := Value;
  5605. end;
  5606.  
  5607. function TDataSet.Locate(const KeyFields: string; const KeyValues: Variant;
  5608.   Options: TLocateOptions): Boolean;
  5609. begin
  5610.   Result := False;
  5611. end;
  5612.  
  5613. function TDataSet.Lookup(const KeyFields: string; const KeyValues: Variant;
  5614.   const ResultFields: string): Variant;
  5615. begin
  5616.   Result := False;
  5617. end;
  5618.  
  5619. { Informational }
  5620.  
  5621. procedure TDataSet.CheckBrowseMode;
  5622. begin
  5623.   CheckActive;
  5624.   DataEvent(deCheckBrowseMode, 0);
  5625.   case State of
  5626.     dsEdit, dsInsert:
  5627.       begin
  5628.         UpdateRecord;
  5629.         if Modified then Post else Cancel;
  5630.       end;
  5631.     dsSetKey:
  5632.       Post;
  5633.   end;
  5634. end;
  5635.  
  5636. function TDataSet.GetCanModify: Boolean;
  5637. begin
  5638.   Result := True;
  5639. end;
  5640.  
  5641. procedure TDataSet.CheckCanModify;
  5642. begin
  5643.   if not CanModify then DatabaseError(SDataSetReadOnly);
  5644. end;
  5645.  
  5646. procedure TDataSet.GetFieldList(List: TList; const FieldNames: string);
  5647. var
  5648.   Pos: Integer;
  5649. begin
  5650.   Pos := 1;
  5651.   while Pos <= Length(FieldNames) do
  5652.     List.Add(FieldByName(ExtractFieldName(FieldNames, Pos)));
  5653. end;
  5654.  
  5655. function TDataSet.GetRecordCount: Longint;
  5656. begin
  5657.   Result := -1;
  5658. end;
  5659.  
  5660. function TDataSet.GetRecNo: Integer;
  5661. begin
  5662.   Result := -1;
  5663. end;
  5664.  
  5665. procedure TDataSet.SetRecNo(Value: Integer);
  5666. begin
  5667. end;
  5668.  
  5669. function TDataSet.IsSequenced: Boolean;
  5670. begin
  5671.   Result := True;
  5672. end;
  5673.  
  5674. { Event Handler Helpers }
  5675.  
  5676. procedure TDataSet.DoAfterCancel;
  5677. begin
  5678.   if Assigned(FAfterCancel) then FAfterCancel(Self);
  5679. end;
  5680.  
  5681. procedure TDataSet.DoAfterClose;
  5682. begin
  5683.   if Assigned(FAfterClose) then FAfterClose(Self);
  5684. end;
  5685.  
  5686. procedure TDataSet.DoAfterDelete;
  5687. begin
  5688.   if Assigned(FAfterDelete) then FAfterDelete(Self);
  5689. end;
  5690.  
  5691. procedure TDataSet.DoAfterEdit;
  5692. begin
  5693.   if Assigned(FAfterEdit) then FAfterEdit(Self);
  5694. end;
  5695.  
  5696. procedure TDataSet.DoAfterInsert;
  5697. begin
  5698.   if Assigned(FAfterInsert) then FAfterInsert(Self);
  5699. end;
  5700.  
  5701. procedure TDataSet.DoAfterOpen;
  5702. begin
  5703.   if Assigned(FAfterOpen) then FAfterOpen(Self);
  5704. end;
  5705.  
  5706. procedure TDataSet.DoAfterPost;
  5707. begin
  5708.   if Assigned(FAfterPost) then FAfterPost(Self);
  5709. end;
  5710.  
  5711. procedure TDataSet.DoAfterScroll;
  5712. begin
  5713.   if Assigned(FAfterScroll) then FAfterScroll(Self);
  5714. end;
  5715.  
  5716. procedure TDataSet.DoBeforeCancel;
  5717. begin
  5718.   if Assigned(FBeforeCancel) then FBeforeCancel(Self);
  5719. end;
  5720.  
  5721. procedure TDataSet.DoBeforeClose;
  5722. begin
  5723.   if Assigned(FBeforeClose) then FBeforeClose(Self);
  5724. end;
  5725.  
  5726. procedure TDataSet.DoBeforeDelete;
  5727. begin
  5728.   if Assigned(FBeforeDelete) then FBeforeDelete(Self);
  5729. end;
  5730.  
  5731. procedure TDataSet.DoBeforeEdit;
  5732. begin
  5733.   if Assigned(FBeforeEdit) then FBeforeEdit(Self);
  5734. end;
  5735.  
  5736. procedure TDataSet.DoBeforeInsert;
  5737. begin
  5738.   if Assigned(FBeforeInsert) then FBeforeInsert(Self);
  5739. end;
  5740.  
  5741. procedure TDataSet.DoBeforeOpen;
  5742. begin
  5743.   if Assigned(FBeforeOpen) then FBeforeOpen(Self);
  5744. end;
  5745.  
  5746. procedure TDataSet.DoBeforePost;
  5747. begin
  5748.   if Assigned(FBeforePost) then FBeforePost(Self);
  5749. end;
  5750.  
  5751. procedure TDataSet.DoBeforeScroll;
  5752. begin
  5753.   if Assigned(FBeforeScroll) then FBeforeScroll(Self);
  5754. end;
  5755.  
  5756. procedure TDataSet.DoOnCalcFields;
  5757. begin
  5758.   if Assigned(FOnCalcFields) then FOnCalcFields(Self);
  5759. end;
  5760.  
  5761. procedure TDataSet.DoOnNewRecord;
  5762. begin
  5763.   if Assigned(FOnNewRecord) then FOnNewRecord(Self);
  5764. end;
  5765.  
  5766. end.
  5767.