Browse Source

Patch from Alexandrov Alexandru
- implemented TDataset.BindFields
- master-detail relation implemented
- improved variant-support for fields
- implemented TField.Assign and TField.AssignValue

joost 20 years ago
parent
commit
e7bf4ac4bf
5 changed files with 258 additions and 76 deletions
  1. 49 27
      fcl/db/dataset.inc
  2. 59 36
      fcl/db/datasource.inc
  3. 25 5
      fcl/db/db.pp
  4. 12 1
      fcl/db/dbconst.pp
  5. 113 7
      fcl/db/fields.inc

+ 49 - 27
fcl/db/dataset.inc

@@ -73,8 +73,8 @@ end;
 
 Procedure TDataset.BindFields(Binding: Boolean);
 
-// Var I : longint;
-
+var i, j, FieldIndex: Integer;
+    FieldDef: TFieldDef;
 begin
   {
      Here some magic will be needed later; for now just simply set
@@ -84,6 +84,23 @@ begin
   For I:=0 to FFieldList.Count-1 do
     FFieldList[i].FFieldNo:=I;
   }
+  FBlobFieldCount := 0;
+  for i := 0 to Fields.Count - 1 do
+    with Fields[i] do begin
+      if Binding then begin
+          FieldDef := nil;
+          FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
+          if FieldIndex <> -1 then begin
+            FieldDef := FieldDefs[FieldIndex];
+            FFieldNo := FieldDef.FieldNo;
+            if IsBlob then begin
+              FSize := FieldDef.Size;
+              FOffset := FBlobFieldCount;
+              Inc(FBlobFieldCount);
+            end;
+          end else FFieldNo := FieldIndex;
+      end else FFieldNo := 0;;
+    end;
 end;
 
 Function TDataset.BookmarkAvailable: Boolean;
@@ -174,17 +191,20 @@ Var
 begin
   // Do some bookkeeping;
   case Event of
-    deFieldChange :
-      begin
-      if TField(Info).FieldKind in [fkData,fkInternalCalc] then
-        SetModified(True);
-      if FInternalCalcFields and (TField(Info).FieldKind = fkData) then
-          RefreshInternalCalcFields(ActiveBuffer)
-      else if (FCalcFieldsSize <> 0) and FAutoCalcFields and
-        (TField(Info).FieldKind = fkData) then
-        CalculateFields(ActiveBuffer);
-      TField(Info).Change;
-      end;
+    deFieldChange: begin
+        if TField(Info).FieldKind in [fkData,fkInternalCalc] then
+          SetModified(True);
+        if State <> dsSetKey then begin
+          if FInternalCalcFields and (TField(Info).FieldKind = fkData) then
+              RefreshInternalCalcFields(ActiveBuffer)
+          else if (FCalcFieldsSize <> 0) and FAutoCalcFields and
+            (TField(Info).FieldKind = fkData) then
+            CalculateFields(ActiveBuffer);
+          TField(Info).Change;
+        end;
+    end;
+    deDataSetChange, deDataSetScroll:
+      if State <> dsInsert then UpdateCursorPos;
   end;
   // Distribute event to datasets;
   if FDisableControlsCount = 0 then
@@ -792,7 +812,7 @@ begin
       FActiverecord := Value -1;
       end;
 
-   If Assigned(FBuffers) then
+    If Assigned(FBuffers) then
       begin
       For I:=Value+1 to FBufferCount do
         FreeRecordBuffer(FBuffers[i]);
@@ -984,14 +1004,13 @@ Procedure TDataset.CheckBrowseMode;
 begin
   CheckActive;
   DataEvent(deCheckBrowseMode,0);
-  If State In [dsedit,dsinsert] then
-    begin
-    UpdateRecord;
-    If Modified then
-      Post
-    else
-      Cancel;
+  Case State of
+    dsedit,dsinsert: begin
+      UpdateRecord;
+      If Modified then Post else Cancel;
     end;
+    dsSetKey: Post;
+  end;
 end;
 
 Procedure TDataset.ClearFields;
@@ -1640,13 +1659,9 @@ end;
 Procedure TDataset.SetFields(const Values: array of const);
 
 Var I  : longint;
-
 begin
   For I:=0 to high(Values) do
-    Case Values[I].vtype of
-      vtInteger : FieldByNumber(i).AsLongInt:=Values[I].VInteger;
-      // needs Completion..
-    end;
+    Fields[I].AssignValue(Values[I]);
 end;
 
 Function TDataset.Translate(Src, Dest: PChar; ToOem: Boolean): Integer;
@@ -1773,7 +1788,14 @@ end;
 
 {
   $Log$
-  Revision 1.34  2005-04-10 18:26:27  joost
+  Revision 1.35  2005-04-10 22:18:43  joost
+  Patch from Alexandrov Alexandru
+  - implemented TDataset.BindFields
+  - master-detail relation implemented
+  - improved variant-support for fields
+  - implemented TField.Assign and TField.AssignValue
+
+  Revision 1.34  2005/04/10 18:26:27  joost
   - implemented TDataset.Locate
 
   Revision 1.33  2005/03/29 10:07:34  michael

+ 59 - 36
fcl/db/datasource.inc

@@ -84,19 +84,19 @@ Procedure TDataLink.CalcRange;
 var
     aMax, aMin: integer;
 begin
-    aMin:= DataSet.FActiveRecord - FBufferCount + 1;
-    If aMin < 0 Then aMin:= 0;
-    aMax:= Dataset.FBufferCount - FBufferCount;
-    If aMax < 0 then aMax:= 0;
+  aMin:= DataSet.FActiveRecord - FBufferCount + 1;
+  If aMin < 0 Then aMin:= 0;
+  aMax:= Dataset.FBufferCount - FBufferCount;
+  If aMax < 0 then aMax:= 0;
 
-    If aMax>DataSet.FActiveRecord Then aMax:=DataSet.FActiveRecord;
+  If aMax>DataSet.FActiveRecord Then aMax:=DataSet.FActiveRecord;
 
-    If FFirstRecord < aMin Then FFirstRecord:= aMin;
-    If FFirstrecord > aMax Then FFirstRecord:= aMax;
+  If FFirstRecord < aMin Then FFirstRecord:= aMin;
+  If FFirstrecord > aMax Then FFirstRecord:= aMax;
 
-    If (FfirstRecord<>0) And
-       (DataSet.FActiveRecord - FFirstRecord < FBufferCount -1) Then
-        Dec(FFirstRecord, 1);
+  If (FfirstRecord<>0) And
+     (DataSet.FActiveRecord - FFirstRecord < FBufferCount -1) Then
+    Dec(FFirstRecord, 1);
 
 end;
 
@@ -106,31 +106,23 @@ Procedure TDataLink.DataEvent(Event: TDataEvent; Info: Ptrint);
 
 begin
   Case Event of
-    deFieldChange,
-    deRecordChange :
+    deFieldChange, deRecordChange:
       If Not FUpdatingRecord then
         RecordChanged(TField(Info));
-    deDataSetChange:
-      begin
+    deDataSetChange: begin
       SetActive(DataSource.DataSet.Active);
       CalcFirstRecord(Info);
       DatasetChanged;
-      end;
-    deDataSetScroll:
-      DatasetScrolled(CalcFirstRecord(Info));
-    deLayoutChange:
-      begin
+    end;
+    deDataSetScroll: DatasetScrolled(CalcFirstRecord(Info));
+    deLayoutChange: begin
       CalcFirstRecord(Info);
       LayoutChanged;
-      end;
-    deUpdateRecord:
-      UpdateRecord;
-    deUpdateState:
-      CheckActiveAndEditing;
-    deCheckBrowseMode:
-      CheckBrowseMode;
-    deFocusControl:
-      FocusControl(TFieldRef(Info));
+    end;
+    deUpdateRecord: UpdateRecord;
+    deUpdateState: CheckActiveAndEditing;
+    deCheckBrowseMode: CheckBrowseMode;
+    deFocusControl: FocusControl(TFieldRef(Info));
   end;
 end;
 
@@ -197,7 +189,7 @@ end;
 
 Function TDataLink.GetRecordCount: Integer;
 
-Var D : TDataSet;
+Var D: TDataSet;
 
 begin
   Result:=Dataset.FRecordCount;
@@ -326,6 +318,7 @@ end;
 Function TDetailDataLink.GetDetailDataSet: TDataSet;
 
 begin
+  Result := nil;
 end;
 
 
@@ -336,12 +329,16 @@ end;
 constructor TMasterDataLink.Create(ADataSet: TDataSet);
 
 begin
+  inherited Create;
+  FDataSet := ADataSet;
+  FFields := TList.Create;
 end;
 
 
 destructor TMasterDataLink.Destroy;
 
 begin
+  FFields.Free;
   inherited Destroy;
 end;
 
@@ -349,35 +346,62 @@ end;
 Procedure TMasterDataLink.ActiveChanged;
 
 begin
+  FFields.Clear;
+  if Active then
+  try
+    DataSet.GetFieldList(FFields, FFieldNames);
+  except
+    FFields.Clear;
+    raise;
+  end;
+  if FDataSet.Active and not (csDestroying in FDataSet.ComponentState) then
+    if Active and (FFields.Count > 0) then
+    begin
+      if Assigned(FOnMasterChange) then FOnMasterChange(Self);
+    end else
+      if Assigned(FOnMasterDisable) then FOnMasterDisable(Self);
 end;
 
 
 Procedure TMasterDataLink.CheckBrowseMode;
 
 begin
+  if FDataSet.Active then FDataSet.CheckBrowseMode;
 end;
 
 
 Function TMasterDataLink.GetDetailDataSet: TDataSet;
 
 begin
+  Result := FDataSet;
 end;
 
 
 Procedure TMasterDataLink.LayoutChanged;
 
 begin
+  ActiveChanged;
 end;
 
 
 Procedure TMasterDataLink.RecordChanged(Field: TField);
 
 begin
+  if (DataSource.State <> dsSetKey) and FDataSet.Active and
+     (FFields.Count > 0) and ((Field = nil) or
+     (FFields.IndexOf(Field) >= 0)) and
+     Assigned(FOnMasterChange) then
+    FOnMasterChange(Self);
 end;
 
 procedure TMasterDatalink.SetFieldNames(const Value: string);
 
 begin
+  if FFieldNames <> Value then
+  begin
+    FFieldNames := Value;
+    ActiveChanged;
+  end;
 end;
 
 
@@ -389,9 +413,9 @@ Constructor TDataSource.Create(AOwner: TComponent);
 
 begin
   Inherited Create(AOwner);
-  FDatalinks:=TList.Create;
-  FEnabled:=True;
-  FAutoEdit:=True;
+  FDatalinks := TList.Create;
+  FEnabled := True;
+  FAutoEdit := True;
 end;
 
 
@@ -505,16 +529,15 @@ begin
   FDatalinks.Remove(Datalink);
   If Dataset<>Nil then
     DataSet.RecalcBufListSize;
-    //Dataset.SetBufListSize(DataLink.BufferCount);
+  //Dataset.SetBufListSize(DataLink.BufferCount);
 end;
 
 
 procedure TDataSource.ProcessEvent(Event : TDataEvent; Info : Ptrint);
 
 Const
-  OnDataChangeEvents = [deRecordChange, deDataSetChange,
-                           deDataSetScroll,
-                           deLayoutChange,deUpdateState];
+    OnDataChangeEvents = [deRecordChange, deDataSetChange, deDataSetScroll,
+                          deLayoutChange,deUpdateState];
 
 Var
   NeedDataChange : Boolean;

+ 25 - 5
fcl/db/db.pp

@@ -33,6 +33,7 @@ const
   // whether it's true or false.
   YesNoChars : Array[Boolean] of char = ('Y','N');
 
+
 type
 {$ifdef ver1_0}
   PtrInt = Longint;
@@ -53,7 +54,8 @@ type
 
   TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
     deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
-    deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);
+    deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl,
+    deParentScroll);
 
   TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
 
@@ -179,6 +181,8 @@ type
   TFieldRef = ^TField;
   TFieldChars = set of Char;
 
+  { TField }
+
   TField = class(TComponent)
   Private
     FAlignMent : TAlignment;
@@ -268,10 +272,12 @@ type
     procedure SetSize(AValue: Word); virtual;
     procedure SetParentComponent(AParent: TComponent); override;
     procedure SetText(const AValue: string); virtual;
+    procedure SetVarValue(const AValue: Variant); virtual;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure Assign(Source: TPersistent); override;
+    procedure AssignValue(const Value: TVarRec);
     procedure Clear; virtual;
     procedure FocusControl;
     function GetData(Buffer: Pointer): Boolean;
@@ -286,6 +292,7 @@ type
     property AsLongint: Longint read GetAsLongint write SetAsLongint;
     property AsInteger: Integer read GetAsInteger write SetAsInteger;
     property AsString: string read GetAsString write SetAsString;
+    property AsVariant: variant read GetAsVariant write SetAsVariant;
     property AttributeSet: string read FAttributeSet write FAttributeSet;
     property Calculated: Boolean read FCalculated write FCalculated;
     property CanModify: Boolean read FCanModify;
@@ -351,6 +358,7 @@ type
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsLongint(AValue: Longint); override;
     procedure SetAsString(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
   published
@@ -394,7 +402,7 @@ type
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsLongint(AValue: Longint); override;
     procedure SetAsString(const AValue: string); override;
-    procedure SetAsVariant(AValue: variant); override;
+    procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
     Function CheckRange(AValue : longint) : Boolean;
@@ -428,6 +436,7 @@ type
     procedure SetAsLongint(AValue: Longint); override;
     procedure SetAsLargeint(AValue: Largeint); virtual;
     procedure SetAsString(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
     Function CheckRange(AValue : largeint) : Boolean;
@@ -481,6 +490,7 @@ type
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsLongint(AValue: Longint); override;
     procedure SetAsString(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
     Function CheckRange(AValue : Double) : Boolean;
@@ -509,6 +519,7 @@ type
     function GetDefaultWidth: Longint; override;
     procedure SetAsBoolean(AValue: Boolean); override;
     procedure SetAsString(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
     property Value: Boolean read GetAsBoolean write SetAsBoolean;
@@ -532,6 +543,7 @@ type
     procedure SetAsDateTime(AValue: TDateTime); override;
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsString(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
     property Value: TDateTime read GetAsDateTime write SetAsDateTime;
@@ -562,6 +574,7 @@ type
     procedure GetText(var TheText: string; ADisplayText: Boolean); override;
     procedure SetAsString(const AValue: string); override;
     procedure SetText(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
   published
@@ -608,6 +621,7 @@ type
     procedure SetAsLongint(AValue: Longint); override;
     procedure SetAsString(const AValue: string); override;
     procedure SetAsCurrency(AValue: Currency); virtual;
+    procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
     Function CheckRange(AValue : Currency) : Boolean;
@@ -640,6 +654,7 @@ type
     procedure GetText(var TheText: string; ADisplayText: Boolean); override;
     procedure SetAsString(const AValue: string); override;
     procedure SetText(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
     procedure Assign(Source: TPersistent); override;
@@ -1884,8 +1899,6 @@ begin
   //!! To be implemented
 end;
 
-
-
 {$i dataset.inc}
 {$i fields.inc}
 {$i datasource.inc}
@@ -1897,7 +1910,14 @@ end.
 
 {
   $Log$
-  Revision 1.45  2005-04-10 18:26:54  joost
+  Revision 1.46  2005-04-10 22:18:43  joost
+  Patch from Alexandrov Alexandru
+  - implemented TDataset.BindFields
+  - master-detail relation implemented
+  - improved variant-support for fields
+  - implemented TField.Assign and TField.AssignValue
+
+  Revision 1.45  2005/04/10 18:26:54  joost
   - implemented TDataset.Locate
   - removed TParam.FNull
 

+ 12 - 1
fcl/db/dbconst.pp

@@ -69,13 +69,24 @@ Const
   SDeletedRecord           = 'The record is deleted.';
   SIndexNotFound           = 'Index ''%s'' not found';
   SParameterCountIncorrect = 'The number of parameters is incorrect.';
+  SFieldValueError         = 'Invalid value for field ''%s''';
+  SInvalidCalcType         = 'Field ''%s'' cannot be a calculated or lookup field';
+
+
 Implementation
 
 end.
 
 {
   $Log$
-  Revision 1.10  2005-04-10 18:28:30  joost
+  Revision 1.11  2005-04-10 22:18:43  joost
+  Patch from Alexandrov Alexandru
+  - implemented TDataset.BindFields
+  - master-detail relation implemented
+  - improved variant-support for fields
+  - implemented TField.Assign and TField.AssignValue
+
+  Revision 1.10  2005/04/10 18:28:30  joost
   - implemented parameter support for sqldb
 
   Revision 1.9  2005/03/18 10:17:34  michael

+ 113 - 7
fcl/db/fields.inc

@@ -265,7 +265,54 @@ end;
 procedure TField.Assign(Source: TPersistent);
 
 begin
-  //!! To be implemented
+  if Source = nil then Clear
+  else if Source is TField then begin
+    Value := TField(Source).Value;
+  end else
+    inherited Assign(Source);
+end;
+
+procedure TField.AssignValue(const Value: TVarRec);
+  procedure Error;
+  begin
+    DatabaseErrorFmt(SFieldValueError, [DisplayName]);
+  end;
+
+begin
+  with Value do
+    case VType of
+      vtInteger:
+        AsInteger := VInteger;
+      vtBoolean:
+        AsBoolean := VBoolean;
+      vtChar:
+        AsString := VChar;
+      vtExtended:
+        AsFloat := VExtended^;
+      vtString:
+        AsString := VString^;
+      vtPointer:
+        if VPointer <> nil then Error;
+      vtPChar:
+        AsString := VPChar;
+      vtObject:
+        if (VObject = nil) or (VObject is TPersistent) then
+          Assign(TPersistent(VObject))
+        else
+          Error;
+      vtAnsiString:
+        AsString := string(VAnsiString);
+//      vtCurrency:
+//        AsCurrency := VCurrency^;
+      vtVariant:
+        if not VarIsClear(VVariant^) then Self.Value := VVariant^;
+      vtWideString:
+        AsString := WideString(VWideString);
+      vtInt64:
+        Self.Value := VInt64^;
+    else
+      Error;
+    end;
 end;
 
 procedure TField.Change;
@@ -285,7 +332,8 @@ end;
 procedure TField.Clear;
 
 begin
-  SetData(Nil);
+  if FieldKind in [fkData, fkInternalCalc] then
+    SetData(Nil);
 end;
 
 procedure TField.DataChanged;
@@ -510,7 +558,14 @@ end;
 procedure TField.SetAsVariant(AValue: Variant);
 
 begin
-  AccessError(SVariant);
+  if VarIsNull(AValue) then
+    Clear
+  else
+    try
+      SetVarValue(AValue);
+    except
+      on EVariantError do DatabaseErrorFmt(SFieldValueError, [DisplayName]);
+    end;
 end;
 
 
@@ -592,6 +647,11 @@ begin
   AsString:=AValue;
 end;
 
+procedure TField.SetVarValue(const AValue: Variant);
+begin
+  AccessError(SVariant);
+end;
+
 procedure TField.Validate(Buffer: Pointer);
 
 begin
@@ -808,6 +868,11 @@ begin
     SetData(@AValue[1]);
 end;
 
+procedure TStringField.SetVarValue(const AValue: Variant);
+begin
+  SetAsString(AValue);
+end;
+
 { ---------------------------------------------------------------------
     TNumericField
   ---------------------------------------------------------------------}
@@ -951,8 +1016,7 @@ begin
     RangeError(Avalue,FMinrange,FMaxRange);
 end;
 
-procedure TLongintField.SetAsVariant(AValue: Variant);
-
+procedure TLongintField.SetVarValue(const AValue: Variant);
 begin
   SetAsLongint(AValue);
 end;
@@ -1142,6 +1206,11 @@ begin
     end;
 end;
 
+procedure TLargeintField.SetVarValue(const AValue: Variant);
+begin
+  SetAsLargeint(AValue);
+end;
+
 Function TLargeintField.CheckRange(AValue : largeint) : Boolean;
 
 begin
@@ -1281,7 +1350,7 @@ Var
     E : Double;
 
 begin
-  text:='';
+  TheText:='';
   If Not GetData(@E) then exit;
   If ADisplayText or (Length(FEditFormat) = 0) Then
     Fmt:=FDisplayFormat
@@ -1322,6 +1391,11 @@ begin
     SetAsFloat(R);
 end;
 
+procedure TFloatField.SetVarValue(const AValue: Variant);
+begin
+  SetAsFloat(Avalue);
+end;
+
 constructor TFloatField.Create(AOwner: TComponent);
 
 begin
@@ -1411,6 +1485,11 @@ begin
     DatabaseErrorFmt(SNotABoolean,[AValue]);
 end;
 
+procedure TBooleanField.SetVarValue(const AValue: Variant);
+begin
+  SetAsBoolean(AValue);
+end;
+
 constructor TBooleanField.Create(AOwner: TComponent);
 
 begin
@@ -1456,6 +1535,11 @@ begin
     Result:=0;
 end;
 
+procedure TDateTimeField.SetVarValue(const AValue: Variant);
+begin
+  SetAsDateTime(AValue);
+end;
+
 function TDateTimeField.GetAsVariant: Variant;
 
 Var d : tDateTime;
@@ -1619,6 +1703,11 @@ begin
   SetAsString(Avalue);
 end;
 
+procedure TBinaryField.SetVarValue(const AValue: Variant);
+begin
+  SetAsString(Avalue);
+end;
+
 
 constructor TBinaryField.Create(AOwner: TComponent);
 
@@ -1763,6 +1852,11 @@ begin
     RangeError(AValue,FMinValue,FMaxvalue);
 end;
 
+procedure TBCDField.SetVarValue(const AValue: Variant);
+begin
+  SetAsCurrency(AValue);
+end;
+
 Function TBCDField.CheckRange(AValue : Currency) : Boolean;
 
 begin
@@ -1900,6 +1994,11 @@ begin
   SetAsString(AValue);
 end;
 
+procedure TBlobField.SetVarValue(const AValue: Variant);
+begin
+  SetAsString(AValue);
+end;
+
 
 constructor TBlobField.Create(AOwner: TComponent);
 
@@ -2192,7 +2291,14 @@ end;
 
 {
   $Log$
-  Revision 1.29  2005-04-04 07:30:51  michael
+  Revision 1.30  2005-04-10 22:18:43  joost
+  Patch from Alexandrov Alexandru
+  - implemented TDataset.BindFields
+  - master-detail relation implemented
+  - improved variant-support for fields
+  - implemented TField.Assign and TField.AssignValue
+
+  Revision 1.29  2005/04/04 07:30:51  michael
   + Patch from Jesus reyes to notify changes to DisplayFormat
 
   Revision 1.28  2005/03/23 08:17:51  michael