home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-1 / Inter.Net 55-1.iso / CBuilder / Setup / BCB / data.z / db.int < prev    next >
Encoding:
Text File  |  1998-02-09  |  35.6 KB  |  1,013 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       Core Database                                   }
  6. {                                                       }
  7. {       Copyright (c) 1995,98 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.   TField = class;
  45.   TDataLink = class;
  46.   TDataSource = class;
  47.   TDataSet = class;
  48.  
  49. { Exception classes }
  50.  
  51.   EDatabaseError = class(Exception);
  52.  
  53. { TNamedItem }
  54.  
  55.   TNamedItem = class(TCollectionItem)
  56.   protected
  57.     function GetDisplayName: string; override;
  58.     procedure SetDisplayName(const Value: string); override;
  59.   published
  60.     property Name: string;
  61.   end;
  62.  
  63. { TDefCollection }
  64.  
  65.   TDefUpdateMethod = procedure of object;
  66.  
  67.   TDefCollection = class(TCollection)
  68.   protected
  69.     function GetOwner: TPersistent; override;
  70.     procedure SetItemName(AItem: TCollectionItem); override;
  71.     procedure Update(AItem: TCollectionItem); override;
  72.     procedure UpdateDefs(AMethod: TDefUpdateMethod);
  73.   public
  74.     constructor Create(ADataset: TDataset; AClass: TCollectionItemClass);
  75.     function IndexOf(const AName: string): Integer;
  76.     function Find(const AName: string): TNamedItem;
  77.     property Dataset: TDataset;
  78.     property Updated: Boolean;
  79.   end;
  80.  
  81. { TFieldDef }
  82.  
  83.   TFieldClass = class of TField;
  84.  
  85.   TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
  86.     ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
  87.     ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
  88.     ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);
  89.  
  90.   TFieldDef = class(TNamedItem)
  91.   public
  92.     procedure Assign(Source: TPersistent); override;
  93.     function CreateField(Owner: TComponent): TField;
  94.     property FieldClass: TFieldClass;
  95.     property InternalCalcField: Boolean;
  96.   published
  97.     property FieldNo: Integer;
  98.     property DataType: TFieldType;
  99.     property Precision: Integer;
  100.     property Required: Boolean;
  101.     property Size: Word;
  102.   end;
  103.  
  104. { TFieldDefs }
  105.  
  106.   TFieldDefs = class(TDefCollection)
  107.   public
  108.     constructor Create(ADataset: TDataset);
  109.     function AddFieldDef: TFieldDef;
  110.     function Find(const Name: string): TFieldDef;
  111.     procedure Update;
  112.     { procedure Add kept for compatability - AddFieldDef is the better way }
  113.     procedure Add(const N: string; T: TFieldType; S: Word; R: Boolean);
  114.     property Items[Index: Integer]: TFieldDef; default;
  115.   end;
  116.  
  117. { TIndexDef }
  118.  
  119.   TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
  120.     ixCaseInsensitive, ixExpression);
  121.  
  122.   TIndexDef = class(TNamedItem)
  123.   public
  124.     procedure Assign(ASource: TPersistent); override;
  125.     property FieldExpression: string;
  126.   published
  127.     property Options: TIndexOptions;
  128.     property Expression: string;
  129.     property Fields: string;
  130.     property Source: string;
  131.   end;
  132.  
  133. { TIndexDefs }
  134.  
  135.   TIndexDefs = class(TDefCollection)
  136.   public
  137.     constructor Create(ADataset: TDataset);
  138.     function AddIndexDef: TIndexDef;
  139.     function Find(const Name: string): TIndexDef;
  140.     procedure Update;
  141.     function FindIndexForFields(const Fields: string): TIndexDef;
  142.     function GetIndexForFields(const Fields: string;
  143.       CaseInsensitive: Boolean): TIndexDef;
  144.     { procedure Add kept for compatability - AddFieldDef is the better way }
  145.     procedure Add(const N, F: string; O: TIndexOptions);
  146.     property Items[Index: Integer]: TIndexDef; default;
  147.   end;
  148.  
  149. { TField }
  150.  
  151.   TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
  152.  
  153.   TFieldNotifyEvent = procedure(Sender: TField) of object;
  154.   TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
  155.     DisplayText: Boolean) of object;
  156.   TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
  157.   TFieldRef = ^TField;
  158.   TFieldChars = set of Char;
  159.  
  160.   PLookupListEntry = ^TLookupListEntry;
  161.   TLookupListEntry = record
  162.     Key: Variant;
  163.     Value: Variant;
  164.   end;
  165.  
  166.   TLookupList = class(TObject)
  167.   public
  168.     constructor Create;
  169.     destructor Destroy; override;
  170.     procedure Add(const AKey, AValue: Variant);
  171.     procedure Clear;
  172.     function ValueOfKey(const AKey: Variant): Variant;
  173.   end;
  174.  
  175.   TField = class(TComponent)
  176.   protected
  177.     function AccessError(const TypeName: string): EDatabaseError; dynamic;
  178.     procedure CheckInactive;
  179.     class procedure CheckTypeSize(Value: Integer); virtual;
  180.     procedure Change; virtual;
  181.     procedure DataChanged;
  182.     procedure DefineProperties(Filer: TFiler); override;
  183.     procedure FreeBuffers; virtual;
  184.     function GetAsBoolean: Boolean; virtual;
  185.     function GetAsCurrency: Currency; virtual;
  186.     function GetAsDateTime: TDateTime; virtual;
  187.     function GetAsFloat: Double; virtual;
  188.     function GetAsInteger: Longint; virtual;
  189.     function GetAsString: string; virtual;
  190.     function GetAsVariant: Variant; virtual;
  191.     function GetCanModify: Boolean; virtual;
  192.     function GetDataSize: Word; virtual;
  193.     function GetDefaultWidth: Integer; virtual;
  194.     function GetIsNull: Boolean; virtual;
  195.     function GetParentComponent: TComponent; override;
  196.     procedure GetText(var Text: string; DisplayText: Boolean); virtual;
  197.     function HasParent: Boolean; override;
  198.     procedure Notification(AComponent: TComponent;
  199.       Operation: TOperation); override;
  200.     procedure PropertyChanged(LayoutAffected: Boolean);
  201.     procedure ReadState(Reader: TReader); override;
  202.     procedure SetAsBoolean(Value: Boolean); virtual;
  203.     procedure SetAsCurrency(Value: Currency); virtual;
  204.     procedure SetAsDateTime(Value: TDateTime); virtual;
  205.     procedure SetAsFloat(Value: Double); virtual;
  206.     procedure SetAsInteger(Value: Longint); virtual;
  207.     procedure SetAsString(const Value: string); virtual;
  208.     procedure SetAsVariant(const Value: Variant); virtual;
  209.     procedure SetDataType(Value: TFieldType);
  210.     procedure SetSize(Value: Word); virtual;
  211.     procedure SetParentComponent(AParent: TComponent); override;
  212.     procedure SetText(const Value: string); virtual;
  213.     procedure SetVarValue(const Value: Variant); virtual;
  214.   public
  215.     constructor Create(AOwner: TComponent); override;
  216.     destructor Destroy; override;
  217.     procedure Assign(Source: TPersistent); override;
  218.     procedure AssignValue(const Value: TVarRec);
  219.     procedure Clear; virtual;
  220.     procedure FocusControl;
  221.     function GetData(Buffer: Pointer): Boolean;
  222.     class function IsBlob: Boolean; virtual;
  223.     function IsValidChar(InputChar: Char): Boolean; virtual;
  224.     procedure RefreshLookupList;
  225.     procedure SetData(Buffer: Pointer);
  226.     procedure SetFieldType(Value: TFieldType); virtual;
  227.     procedure Validate(Buffer: Pointer);
  228.     property AsBoolean: Boolean;
  229.     property AsCurrency: Currency;
  230.     property AsDateTime: TDateTime;
  231.     property AsFloat: Double;
  232.     property AsInteger: Longint;
  233.     property AsString: string;
  234.     property AsVariant: Variant;
  235.     property AttributeSet: string;
  236.     property Calculated: Boolean default False;
  237.     property CanModify: Boolean;
  238.     property CurValue: Variant;
  239.     property DataSet: TDataSet;
  240.     property DataSize: Word;
  241.     property DataType: TFieldType;
  242.     property DisplayName: string;
  243.     property DisplayText: string;
  244.     property EditMask: string;
  245.     property EditMaskPtr: string;
  246.     property FieldNo: Integer;
  247.     property IsIndexField: Boolean;
  248.     property IsNull: Boolean;
  249.     property Lookup: Boolean;
  250.     property LookupList: TLookupList;
  251.     property NewValue: Variant;
  252.     property Offset: word;
  253.     property OldValue: Variant;
  254.     property Size: Word;
  255.     property Text: string;
  256.     property ValidChars: TFieldChars;
  257.     property Value: Variant;
  258.   published
  259.     property Alignment: TAlignment default taLeftJustify;
  260.     property CustomConstraint: string;
  261.     property ConstraintErrorMessage: string;
  262.     property DefaultExpression: string;
  263.     property DisplayLabel: string;
  264.     property DisplayWidth: Integer;
  265.     property FieldKind: TFieldKind;
  266.     property FieldName: string;
  267.     property HasConstraints: Boolean;
  268.     property Index: Integer;
  269.     property ImportedConstraint: string;
  270.     property LookupDataSet: TDataSet;
  271.     property LookupKeyFields: string;
  272.     property LookupResultField: string;
  273.     property KeyFields: string;
  274.     property LookupCache: Boolean default False;
  275.     property Origin: string;
  276.     property ReadOnly: Boolean default False;
  277.     property Required: Boolean default False;
  278.     property Visible: Boolean default True;
  279.     property OnChange: TFieldNotifyEvent;
  280.     property OnGetText: TFieldGetTextEvent;
  281.     property OnSetText: TFieldSetTextEvent;
  282.     property OnValidate: TFieldNotifyEvent;
  283.   end;
  284.  
  285. { TStringField }
  286.  
  287.   TStringField = class(TField)
  288.   protected
  289.     class procedure CheckTypeSize(Value: Integer); override;
  290.     function GetAsBoolean: Boolean; override;
  291.     function GetAsDateTime: TDateTime; override;
  292.     function GetAsFloat: Double; override;
  293.     function GetAsInteger: Longint; override;
  294.     function GetAsString: string; override;
  295.     function GetAsVariant: Variant; override;
  296.     function GetDataSize: Word; override;
  297.     function GetDefaultWidth: Integer; override;
  298.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  299.     function GetValue(var Value: string): Boolean;
  300.     procedure SetAsBoolean(Value: Boolean); override;
  301.     procedure SetAsDateTime(Value: TDateTime); override;
  302.     procedure SetAsFloat(Value: Double); override;
  303.     procedure SetAsInteger(Value: Longint); override;
  304.     procedure SetAsString(const Value: string); override;
  305.     procedure SetVarValue(const Value: Variant); override;
  306.   public
  307.     constructor Create(AOwner: TComponent); override;
  308.     property Value: string;
  309.   published
  310.     property EditMask;
  311.     property Size default 20;
  312.     property Transliterate: Boolean default True;
  313.   end;
  314.  
  315. { TNumericField }
  316.  
  317.   TNumericField = class(TField)
  318.   protected
  319.     procedure RangeError(Value, Min, Max: Extended);
  320.     procedure SetDisplayFormat(const Value: string);
  321.     procedure SetEditFormat(const Value: string);
  322.   public
  323.     constructor Create(AOwner: TComponent); override;
  324.   published
  325.     property Alignment default taRightJustify;
  326.     property DisplayFormat: string;
  327.     property EditFormat: string;
  328.   end;
  329.  
  330. { TIntegerField }
  331.  
  332.   TIntegerField = class(TNumericField)
  333.   protected
  334.     function GetAsFloat: Double; override;
  335.     function GetAsInteger: Longint; override;
  336.     function GetAsString: string; override;
  337.     function GetAsVariant: Variant; override;
  338.     function GetDataSize: Word; override;
  339.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  340.     function GetValue(var Value: Longint): Boolean;
  341.     procedure SetAsFloat(Value: Double); override;
  342.     procedure SetAsInteger(Value: Longint); override;
  343.     procedure SetAsString(const Value: string); override;
  344.     procedure SetVarValue(const Value: Variant); override;
  345.   public
  346.     constructor Create(AOwner: TComponent); override;
  347.     property Value: Longint;
  348.   published
  349.     property MaxValue: Longint default 0;
  350.     property MinValue: Longint default 0;
  351.   end;
  352.  
  353. { TSmallintField }
  354.  
  355.   TSmallintField = class(TIntegerField)
  356.   protected
  357.     function GetDataSize: Word; override;
  358.   public
  359.     constructor Create(AOwner: TComponent); override;
  360.   end;
  361.  
  362. { TWordField }
  363.  
  364.   TWordField = class(TIntegerField)
  365.   protected
  366.     function GetDataSize: Word; override;
  367.   public
  368.     constructor Create(AOwner: TComponent); override;
  369.   end;
  370.  
  371. { TAutoIncField }
  372.  
  373.   TAutoIncField = class(TIntegerField)
  374.   public
  375.     constructor Create(AOwner: TComponent); override;
  376.   end;
  377.  
  378. { TFloatField }
  379.  
  380.   TFloatField = class(TNumericField)
  381.   protected
  382.     function GetAsFloat: Double; override;
  383.     function GetAsInteger: Longint; override;
  384.     function GetAsString: string; override;
  385.     function GetAsVariant: Variant; override;
  386.     function GetDataSize: Word; override;
  387.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  388.     procedure SetAsFloat(Value: Double); override;
  389.     procedure SetAsInteger(Value: Longint); override;
  390.     procedure SetAsString(const Value: string); override;
  391.     procedure SetVarValue(const Value: Variant); override;
  392.   public
  393.     constructor Create(AOwner: TComponent); override;
  394.     property Value: Double;
  395.   published
  396.     { Lowercase to avoid name clash with C++ Currency type }
  397.     property currency: Boolean default False;
  398.     property MaxValue: Double;
  399.     property MinValue: Double;
  400.     property Precision: Integer default 15;
  401.   end;
  402.  
  403. { TCurrencyField }
  404.  
  405.   TCurrencyField = class(TFloatField)
  406.   public
  407.     constructor Create(AOwner: TComponent); override;
  408.   published
  409.     property Currency default True;
  410.   end;
  411.  
  412. { TBooleanField }
  413.  
  414.   TBooleanField = class(TField)
  415.   protected
  416.     function GetAsBoolean: Boolean; override;
  417.     function GetAsString: string; override;
  418.     function GetAsVariant: Variant; override;
  419.     function GetDataSize: Word; override;
  420.     function GetDefaultWidth: Integer; override;
  421.     procedure SetAsBoolean(Value: Boolean); override;
  422.     procedure SetAsString(const Value: string); override;
  423.     procedure SetVarValue(const Value: Variant); override;
  424.   public
  425.     constructor Create(AOwner: TComponent); override;
  426.     property Value: Boolean;
  427.   published
  428.     property DisplayValues: string;
  429.   end;
  430.  
  431. { TDateTimeField }
  432.  
  433.   TDateTimeField = class(TField)
  434.   protected
  435.     function GetAsDateTime: TDateTime; override;
  436.     function GetAsFloat: Double; override;
  437.     function GetAsString: string; override;
  438.     function GetAsVariant: Variant; override;
  439.     function GetDataSize: Word; override;
  440.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  441.     procedure SetAsDateTime(Value: TDateTime); override;
  442.     procedure SetAsFloat(Value: Double); override;
  443.     procedure SetAsString(const Value: string); override;
  444.     procedure SetVarValue(const Value: Variant); override;
  445.   public
  446.     constructor Create(AOwner: TComponent); override;
  447.     property Value: TDateTime;
  448.   published
  449.     property DisplayFormat: string;
  450.     property EditMask;
  451.   end;
  452.  
  453. { TDateField }
  454.  
  455.   TDateField = class(TDateTimeField)
  456.   protected
  457.     function GetDataSize: Word; override;
  458.   public
  459.     constructor Create(AOwner: TComponent); override;
  460.   end;
  461.  
  462. { TTimeField }
  463.  
  464.   TTimeField = class(TDateTimeField)
  465.   protected
  466.     function GetDataSize: Word; override;
  467.   public
  468.     constructor Create(AOwner: TComponent); override;
  469.   end;
  470.  
  471. { TBinaryField }
  472.  
  473.   TBinaryField = class(TField)
  474.   protected
  475.     class procedure CheckTypeSize(Value: Integer); override;
  476.     function GetAsString: string; override;
  477.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  478.     function GetAsVariant: Variant; override;
  479.     procedure SetAsString(const Value: string); override;
  480.     procedure SetText(const Value: string); override;
  481.     procedure SetVarValue(const Value: Variant); override;
  482.   public
  483.     constructor Create(AOwner: TComponent); override;
  484.   published
  485.     property Size default 16;
  486.   end;
  487.  
  488. { TBytesField }
  489.  
  490.   TBytesField = class(TBinaryField)
  491.   protected
  492.     function GetDataSize: Word; override;
  493.   public
  494.     constructor Create(AOwner: TComponent); override;
  495.   end;
  496.  
  497. { TVarBytesField }
  498.  
  499.   TVarBytesField = class(TBytesField)
  500.   protected
  501.     function GetDataSize: Word; override;
  502.   public
  503.     constructor Create(AOwner: TComponent); override;
  504.   end;
  505.  
  506. { TBCDField }
  507.  
  508.   TBCDField = class(TNumericField)
  509.   protected
  510.     class procedure CheckTypeSize(Value: Integer); override;
  511.     function GetAsCurrency: Currency; override;
  512.     function GetAsFloat: Double; override;
  513.     function GetAsInteger: Longint; override;
  514.     function GetAsString: string; override;
  515.     function GetAsVariant: Variant; override;
  516.     function GetDataSize: Word; override;
  517.     function GetDefaultWidth: Integer; override;
  518.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  519.     function GetValue(var Value: Currency): Boolean;
  520.     procedure SetAsCurrency(Value: Currency); override;
  521.     procedure SetAsFloat(Value: Double); override;
  522.     procedure SetAsInteger(Value: Longint); override;
  523.     procedure SetAsString(const Value: string); override;
  524.     procedure SetVarValue(const Value: Variant); override;
  525.   public
  526.     constructor Create(AOwner: TComponent); override;
  527.     property Value: Currency;
  528.   published 
  529.     { Lowercase to avoid name clash with C++ Currency type }
  530.     property currency: Boolean default False;
  531.     property MaxValue: Currency;
  532.     property MinValue: Currency;
  533.     property Size default 4;
  534.   end;
  535.  
  536. { TBlobField }
  537.  
  538.   TBlobType = ftBlob..ftTypedBinary;
  539.  
  540.   TBlobField = class(TField)
  541.   protected
  542.     procedure AssignTo(Dest: TPersistent); override;
  543.     procedure FreeBuffers; override;
  544.     function GetAsString: string; override;
  545.     function GetAsVariant: Variant; override;
  546.     function GetBlobSize: Integer; virtual;
  547.     function GetIsNull: Boolean; override;
  548.     procedure GetText(var Text: string; DisplayText: Boolean); override;
  549.     procedure SetAsString(const Value: string); override;
  550.     procedure SetText(const Value: string); override;
  551.     procedure SetVarValue(const Value: Variant); override;
  552.   public
  553.     constructor Create(AOwner: TComponent); override;
  554.     procedure Assign(Source: TPersistent); override;
  555.     procedure Clear; override;
  556.     class function IsBlob: Boolean; override;
  557.     procedure LoadFromFile(const FileName: string);
  558.     procedure LoadFromStream(Stream: TStream);
  559.     procedure SaveToFile(const FileName: string);
  560.     procedure SaveToStream(Stream: TStream);
  561.     procedure SetFieldType(Value: TFieldType); override;
  562.     property BlobSize: Integer;
  563.     property Modified: Boolean;
  564.     property Value: string;
  565.     property Transliterate: Boolean;
  566.   published
  567.     property BlobType: TBlobType;
  568.     property Size default 0;
  569.   end;
  570.  
  571. { TMemoField }
  572.  
  573.   TMemoField = class(TBlobField)
  574.   public
  575.     constructor Create(AOwner: TComponent); override;
  576.   published
  577.     property Transliterate default True;
  578.   end;
  579.  
  580. { TGraphicField }
  581.  
  582.   TGraphicField = class(TBlobField)
  583.   public
  584.     constructor Create(AOwner: TComponent); override;
  585.   end;
  586.  
  587. { TDataLink }
  588.  
  589.   TDataLink = class(TPersistent)
  590.   protected
  591.     procedure ActiveChanged; virtual;
  592.     procedure CheckBrowseMode; virtual;
  593.     procedure DataSetChanged; virtual;
  594.     procedure DataSetScrolled(Distance: Integer); virtual;
  595.     procedure FocusControl(Field: TFieldRef); virtual;
  596.     procedure EditingChanged; virtual;
  597.     procedure LayoutChanged; virtual;
  598.     procedure RecordChanged(Field: TField); virtual;
  599.     procedure UpdateData; virtual;
  600.   public
  601.     constructor Create;
  602.     destructor Destroy; override;
  603.     function Edit: Boolean;
  604.     procedure UpdateRecord;
  605.     property Active: Boolean;
  606.     property ActiveRecord: Integer;
  607.     property BufferCount: Integer;
  608.     property DataSet: TDataSet;
  609.     property DataSource: TDataSource;
  610.     property DataSourceFixed: Boolean;
  611.     property Editing: Boolean;
  612.     property ReadOnly: Boolean;
  613.     property RecordCount: Integer;
  614.   end;
  615.  
  616. { TDataSource }
  617.  
  618.   TDataChangeEvent = procedure(Sender: TObject; Field: TField) of object;
  619.  
  620.   TDataSource = class(TComponent)
  621.   protected
  622.     property DataLinks: TList;
  623.   public
  624.     constructor Create(AOwner: TComponent); override;
  625.     destructor Destroy; override;
  626.     procedure Edit;
  627.     function IsLinkedTo(DataSet: TDataSet): Boolean;
  628.     property State: TDataSetState;
  629.   published
  630.     property AutoEdit: Boolean default True;
  631.     property DataSet: TDataSet;
  632.     property Enabled: Boolean default True;
  633.     property OnStateChange: TNotifyEvent;
  634.     property OnDataChange: TDataChangeEvent;
  635.     property OnUpdateData: TNotifyEvent;
  636.   end;
  637.  
  638. { TDataSetDesigner }
  639.  
  640.   TDataSetDesigner = class(TObject)
  641.   public
  642.     constructor Create(DataSet: TDataSet);
  643.     destructor Destroy; override;
  644.     procedure BeginDesign;
  645.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  646.     procedure EndDesign;
  647.     property DataSet: TDataSet;
  648.   end;
  649.  
  650. { TCheckConstraint }
  651.  
  652.   TCheckConstraint = class(TCollectionItem)
  653.   public
  654.     procedure Assign(Source: TPersistent); override;
  655.     function GetDisplayName: string; override;
  656.   published
  657.     property CustomConstraint: string;
  658.     property ErrorMessage: string;
  659.     property FromDictionary: Boolean;
  660.     property ImportedConstraint: string;
  661.   end;
  662.  
  663. { TCheckConstraints }
  664.  
  665.   TCheckConstraints = class(TCollection)
  666.   protected
  667.     function GetOwner: TPersistent; override;
  668.   public
  669.     constructor Create(Owner: TPersistent);
  670.     function Add: TCheckConstraint;
  671.     property Items[Index: Integer]: TCheckConstraint; default;
  672.   end;
  673.  
  674. { TDataSet }
  675.  
  676.   TBookmark = Pointer;
  677.   TBookmarkStr = string;
  678.  
  679.   PBookmarkFlag = ^TBookmarkFlag;
  680.   TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
  681.  
  682.   PBufferList = ^TBufferList;
  683.   TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
  684.  
  685.   TGetMode = (gmCurrent, gmNext, gmPrior);
  686.  
  687.   TGetResult = (grOK, grBOF, grEOF, grError);
  688.  
  689.   TResyncMode = set of (rmExact, rmCenter);
  690.  
  691.   TDataAction = (daFail, daAbort, daRetry);
  692.  
  693.   TUpdateKind = (ukModify, ukInsert, ukDelete);
  694.  
  695.   TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
  696.  
  697.   TLocateOption = (loCaseInsensitive, loPartialKey);
  698.   TLocateOptions = set of TLocateOption;
  699.  
  700.   TDataOperation = procedure of object;
  701.  
  702.   TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
  703.   TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  704.     var Action: TDataAction) of object;
  705.  
  706.   TFilterOption = (foCaseInsensitive, foNoPartialCompare);
  707.   TFilterOptions = set of TFilterOption;
  708.  
  709.   TFilterRecordEvent = procedure(DataSet: TDataSet;
  710.     var Accept: Boolean) of object;
  711.  
  712.   TDataSet = class(TComponent)
  713.     procedure BeginInsertAppend;
  714.     procedure CheckCanModify;
  715.     procedure CheckFieldName(const FieldName: string);
  716.     procedure CheckFieldNames(const FieldNames: string);
  717.     procedure CheckOperation(Operation: TDataOperation;
  718.       ErrorEvent: TDataSetErrorEvent);
  719.     procedure CheckRequiredFields;
  720.     procedure DoInternalOpen;
  721.     procedure DoInternalClose;
  722.     procedure EndInsertAppend;
  723.     function GetActive: Boolean;
  724.     function GetBuffer(Index: Integer): PChar;
  725.     function GetField(Index: Integer): TField;
  726.     function GetFieldCount: Integer;
  727.     function GetFieldValue(const FieldName: string): Variant;
  728.     function GetFound: Boolean;
  729.     procedure MoveBuffer(CurIndex, NewIndex: Integer);
  730.     procedure RemoveDataSource(DataSource: TDataSource);
  731.     procedure RemoveField(Field: TField);
  732.     procedure SetActive(Value: Boolean);
  733.     procedure SetBufferCount(Value: Integer);
  734.     procedure SetField(Index: Integer; Value: TField);
  735.     procedure SetFieldDefs(Value: TFieldDefs);
  736.     procedure SetFieldValue(const FieldName: string; const Value: Variant);
  737.     procedure SetConstraints(Value: TCheckConstraints);
  738.     procedure UpdateBufferCount;
  739.   protected
  740.     procedure ActivateBuffers; virtual;
  741.     procedure BindFields(Binding: Boolean);
  742.     function BookmarkAvailable: Boolean;
  743.     function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; virtual;
  744.     function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  745.       Decimals: Integer): Boolean; virtual;
  746.     procedure CalculateFields(Buffer: PChar); virtual;
  747.     procedure CheckActive; virtual;
  748.     procedure CheckInactive; virtual;
  749.     procedure ClearBuffers; virtual;
  750.     procedure ClearCalcFields(Buffer: PChar); virtual;
  751.     procedure CloseBlob(Field: TField); virtual;
  752.     procedure CloseCursor; virtual;
  753.     procedure CreateFields;
  754.     procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
  755.     procedure DefChanged(Sender: TObject); virtual;
  756.     procedure DestroyFields; virtual;
  757.     procedure DoAfterCancel; virtual;
  758.     procedure DoAfterClose; virtual;
  759.     procedure DoAfterDelete; virtual;
  760.     procedure DoAfterEdit; virtual;
  761.     procedure DoAfterInsert; virtual;
  762.     procedure DoAfterOpen; virtual;
  763.     procedure DoAfterPost; virtual;
  764.     procedure DoAfterScroll; virtual;
  765.     procedure DoBeforeCancel; virtual;
  766.     procedure DoBeforeClose; virtual;
  767.     procedure DoBeforeDelete; virtual;
  768.     procedure DoBeforeEdit; virtual;
  769.     procedure DoBeforeInsert; virtual;
  770.     procedure DoBeforeOpen; virtual;
  771.     procedure DoBeforePost; virtual;
  772.     procedure DoBeforeScroll; virtual;
  773.     procedure DoOnCalcFields; virtual;
  774.     procedure DoOnNewRecord; virtual;
  775.     function FieldByNumber(FieldNo: Integer): TField;
  776.     function FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
  777.     procedure FreeFieldBuffers; virtual;
  778.     function GetBookmarkStr: TBookmarkStr; virtual;
  779.     procedure GetCalcFields(Buffer: PChar); virtual;
  780.     function GetCanModify: Boolean; virtual;
  781.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  782.     function GetDataSource: TDataSource; virtual;
  783.     function GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
  784.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; virtual;
  785.     function GetIsIndexField(Field: TField): Boolean; virtual;
  786.     function GetNextRecords: Integer; virtual;
  787.     function GetNextRecord: Boolean; virtual;
  788.     function GetPriorRecords: Integer; virtual;
  789.     function GetPriorRecord: Boolean; virtual;
  790.     function GetRecordCount: Integer; virtual;
  791.     function GetRecNo: Integer; virtual;
  792.     procedure InitFieldDefs; virtual;
  793.     procedure InitRecord(Buffer: PChar); virtual;
  794.     procedure InternalCancel; virtual;
  795.     procedure InternalEdit; virtual;
  796.     procedure InternalRefresh; virtual;
  797.     procedure Loaded; override;
  798.     procedure OpenCursor(InfoQuery: Boolean); virtual;
  799.     procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
  800.     procedure RestoreState(const Value: TDataSetState);
  801.     procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
  802.     procedure SetBufListSize(Value: Integer);
  803.     procedure SetChildOrder(Component: TComponent; Order: Integer); override;
  804.     procedure SetCurrentRecord(Index: Integer); virtual;
  805.     procedure SetFiltered(Value: Boolean); virtual;
  806.     procedure SetFilterOptions(Value: TFilterOptions); virtual;
  807.     procedure SetFilterText(const Value: string); virtual;
  808.     procedure SetFound(const Value: Boolean);
  809.     procedure SetModified(Value: Boolean);
  810.     procedure SetName(const Value: TComponentName); override;
  811.     procedure SetStateFieldValue(State: TDataSetState; Field: TField; Value: Variant); virtual;
  812.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
  813.     procedure SetRecNo(Value: Integer); virtual;
  814.     procedure SetState(Value: TDataSetState);
  815.     function SetTempState(const Value: TDataSetState): TDataSetState;
  816.     function TempBuffer: PChar;
  817.     procedure UpdateIndexDefs; virtual;
  818.     property ActiveRecord: Integer;
  819.     property CurrentRecord: Integer;
  820.     property BlobFieldCount: Integer;
  821.     property BookmarkSize: Integer;
  822.     property Buffers[Index: Integer]: PChar;
  823.     property BufferCount: Integer;
  824.     property CalcBuffer: PChar;
  825.     property CalcFieldsSize: Integer;
  826.     property InternalCalcFields: Boolean;
  827.     property Constraints: TCheckConstraints;
  828.   protected { abstract methods }
  829.     function AllocRecordBuffer: PChar; virtual; abstract;
  830.     procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
  831.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  832.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
  833.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
  834.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
  835.     function GetRecordSize: Word; virtual; abstract;
  836.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
  837.     procedure InternalClose; virtual; abstract;
  838.     procedure InternalDelete; virtual; abstract;
  839.     procedure InternalFirst; virtual; abstract;
  840.     procedure InternalGotoBookmark(Bookmark: Pointer); virtual; abstract;
  841.     procedure InternalHandleException; virtual; abstract;
  842.     procedure InternalInitFieldDefs; virtual; abstract;
  843.     procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
  844.     procedure InternalLast; virtual; abstract;
  845.     procedure InternalOpen; virtual; abstract;
  846.     procedure InternalPost; virtual; abstract;
  847.     procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
  848.     function IsCursorOpen: Boolean; virtual; abstract;
  849.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
  850.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
  851.     procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
  852.   public
  853.     constructor Create(AOwner: TComponent); override;
  854.     destructor Destroy; override;
  855.     function ActiveBuffer: PChar;
  856.     procedure Append;
  857.     procedure AppendRecord(const Values: array of const);
  858.     function BookmarkValid(Bookmark: TBookmark): Boolean; virtual;
  859.     procedure Cancel; virtual;
  860.     procedure CheckBrowseMode;
  861.     procedure ClearFields;
  862.     procedure Close;
  863.     function  ControlsDisabled: Boolean;
  864.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; virtual;
  865.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
  866.     procedure CursorPosChanged;
  867.     procedure Delete;
  868.     procedure DisableControls;
  869.     procedure Edit;
  870.     procedure EnableControls;
  871.     function FieldByName(const FieldName: string): TField;
  872.     function FindField(const FieldName: string): TField;
  873.     function FindFirst: Boolean;
  874.     function FindLast: Boolean;
  875.     function FindNext: Boolean;
  876.     function FindPrior: Boolean;
  877.     procedure First;
  878.     procedure FreeBookmark(Bookmark: TBookmark); virtual;
  879.     function GetBookmark: TBookmark; virtual;
  880.     function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
  881.     procedure GetFieldList(List: TList; const FieldNames: string);
  882.     procedure GetFieldNames(List: TStrings);
  883.     procedure GotoBookmark(Bookmark: TBookmark);
  884.     procedure Insert;
  885.     procedure InsertRecord(const Values: array of const);
  886.     function IsEmpty: Boolean;
  887.     function IsLinkedTo(DataSource: TDataSource): Boolean;
  888.     function IsSequenced: Boolean; virtual;
  889.     procedure Last;
  890.     function Locate(const KeyFields: string; const KeyValues: Variant;
  891.       Options: TLocateOptions): Boolean; virtual;
  892.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  893.       const ResultFields: string): Variant; virtual;
  894.     function MoveBy(Distance: Integer): Integer;
  895.     procedure Next;
  896.     procedure Open;
  897.     procedure Post; virtual;
  898.     procedure Prior;
  899.     procedure Refresh;
  900.     procedure Resync(Mode: TResyncMode); virtual;
  901.     procedure SetFields(const Values: array of const);
  902.     procedure Translate(Src, Dest: PChar; ToOem: Boolean); virtual;
  903.     procedure UpdateCursorPos;
  904.     procedure UpdateRecord;
  905.     property Bof: Boolean;
  906.     property Bookmark: TBookmarkStr;
  907.     property CanModify: Boolean;
  908.     property DataSource: TDataSource;
  909.     property DefaultFields: Boolean;
  910.     property Designer: TDataSetDesigner;
  911.     property Eof: Boolean; {Upper case EOF conflicts with C++}
  912.     property FieldCount: Integer;
  913.     property FieldDefs: TFieldDefs;
  914.     property Fields[Index: Integer]: TField;
  915.     property FieldValues[const FieldName: string]: Variant; default;
  916.     property Found: Boolean;
  917.     property Modified: Boolean;
  918.     property RecordCount: Integer;
  919.     property RecNo: Integer;
  920.     property RecordSize: Word;
  921.     property State: TDataSetState;
  922.     property Filter: string;
  923.     property Filtered: Boolean default False;
  924.     property FilterOptions: TFilterOptions default [];
  925.     property Active: Boolean default False;
  926.     property AutoCalcFields: Boolean default True;
  927.     property BeforeOpen: TDataSetNotifyEvent;
  928.     property AfterOpen: TDataSetNotifyEvent;
  929.     property BeforeClose: TDataSetNotifyEvent;
  930.     property AfterClose: TDataSetNotifyEvent;
  931.     property BeforeInsert: TDataSetNotifyEvent;
  932.     property AfterInsert: TDataSetNotifyEvent;
  933.     property BeforeEdit: TDataSetNotifyEvent;
  934.     property AfterEdit: TDataSetNotifyEvent;
  935.     property BeforePost: TDataSetNotifyEvent;
  936.     property AfterPost: TDataSetNotifyEvent;
  937.     property BeforeCancel: TDataSetNotifyEvent;
  938.     property AfterCancel: TDataSetNotifyEvent;
  939.     property BeforeDelete: TDataSetNotifyEvent;
  940.     property AfterDelete: TDataSetNotifyEvent;
  941.     property BeforeScroll: TDataSetNotifyEvent;
  942.     property AfterScroll: TDataSetNotifyEvent;
  943.     property OnCalcFields: TDataSetNotifyEvent;
  944.     property OnDeleteError: TDataSetErrorEvent;
  945.     property OnEditError: TDataSetErrorEvent;
  946.     property OnFilterRecord: TFilterRecordEvent;
  947.     property OnNewRecord: TDataSetNotifyEvent;
  948.     property OnPostError: TDataSetErrorEvent;
  949.   end;
  950.  
  951. { TDateTimeRec }
  952.  
  953. type
  954.   TDateTimeAlias = type TDateTime;
  955.   {$NODEFINE TDateTimeAlias}
  956.   (*$HPPEMIT 'namespace Db'*)
  957.   (*$HPPEMIT '{'*)
  958.   (*$HPPEMIT '    typedef TDateTimeBase TDateTimeAlias;'*)
  959.   (*$HPPEMIT '}'*)
  960.   TDateTimeRec = record
  961.     case TFieldType of
  962.       ftDate: (Date: Longint);
  963.       ftTime: (Time: Longint);
  964.       ftDateTime: (DateTime: TDateTimeAlias);
  965.   end;
  966.  
  967. const
  968.   dsEditModes = [dsEdit, dsInsert, dsSetKey];
  969.   dsWriteModes = [dsEdit, dsInsert, dsSetKey, dsCalcFields, dsFilter, dsNewValue];
  970.  
  971.   DefaultFieldClasses: array[ftUnknown..ftTypedBinary] of TFieldClass = (
  972.     nil,                { ftUnknown }
  973.     TStringField,       { ftString }
  974.     TSmallintField,     { ftSmallint }
  975.     TIntegerField,      { ftInteger }
  976.     TWordField,         { ftWord }
  977.     TBooleanField,      { ftBoolean }
  978.     TFloatField,        { ftFloat }
  979.     TCurrencyField,     { ftCurrency }
  980.     TBCDField,          { ftBCD }
  981.     TDateField,         { ftDate }
  982.     TTimeField,         { ftTime }
  983.     TDateTimeField,     { ftDateTime }
  984.     TBytesField,        { ftBytes }
  985.     TVarBytesField,     { ftVarBytes }
  986.     TAutoIncField,      { ftAutoInc }
  987.     TBlobField,         { ftBlob }
  988.     TMemoField,         { ftMemo }
  989.     TGraphicField,      { ftGraphic }
  990.     TBlobField,         { ftFmtMemo }
  991.     TBlobField,         { ftParadoxOle }
  992.     TBlobField,         { ftDBaseOle }
  993.     TBlobField);        { ftTypedBinary }
  994.  
  995. function ExtractFieldName(const Fields: string; var Pos: Integer): string;
  996. procedure RegisterFields(const FieldClasses: array of TFieldClass);
  997.  
  998. procedure DatabaseError(const Message: string);
  999. procedure DatabaseErrorFmt(const Message: string; const Args: array of const);
  1000. procedure DBError(Ident: Word);
  1001. procedure DBErrorFmt(Ident: Word; const Args: array of const);
  1002.  
  1003. procedure DisposeMem(var Buffer; Size: Integer);
  1004. function BuffersEqual(Buf1, Buf2: Pointer; Size: Integer): Boolean;
  1005.  
  1006. function GetFieldProperty(DataSet: TDataSet; Control: TComponent;
  1007.   const FieldName: string): TField;
  1008.  
  1009. const
  1010.   RegisterFieldsProc: procedure(const FieldClassess: array of TFieldClass) = nil;
  1011.  
  1012. implementation
  1013.