+ Initial support for Master/Detail relations

git-svn-id: trunk@3120 -

fcl/db/datasource.inc

@@ -163,7 +163,10 @@ end;
 Function TDatalink.GetDataSet : TDataset;
 
 begin
-  Result:=FDataSource.DataSet
+  If Assigned(Datasource) then
+    Result:=DataSource.DataSet
+  else
+    Result:=Nil;  
 end;
 
 
@@ -329,8 +332,8 @@ constructor TMasterDataLink.Create(ADataSet: TDataSet);
 
 begin
   inherited Create;
-  FDataSet := ADataSet;
-  FFields := TList.Create;
+  FDetailDataSet:=ADataSet;
+  FFields:=TList.Create;
 end;
 
 
@@ -353,26 +356,25 @@ begin
     FFields.Clear;
     raise;
   end;
-  if FDataSet.Active and not (csDestroying in FDataSet.ComponentState) then
+  if FDetailDataSet.Active and not (csDestroying in FDetailDataSet.ComponentState) then
     if Active and (FFields.Count > 0) then
-    begin
-      if Assigned(FOnMasterChange) then FOnMasterChange(Self);
-    end else
-      if Assigned(FOnMasterDisable) then FOnMasterDisable(Self);
+      DoMasterChange
+    else
+      DoMasterDisable;  
 end;
 
 
 Procedure TMasterDataLink.CheckBrowseMode;
 
 begin
-  if FDataSet.Active then FDataSet.CheckBrowseMode;
+  if FDetailDataSet.Active then FDetailDataSet.CheckBrowseMode;
 end;
 
 
 Function TMasterDataLink.GetDetailDataSet: TDataSet;
 
 begin
-  Result := FDataSet;
+  Result := FDetailDataSet;
 end;
 
 
@@ -386,23 +388,122 @@ end;
 Procedure TMasterDataLink.RecordChanged(Field: TField);
 
 begin
-  if (DataSource.State <> dsSetKey) and FDataSet.Active and
+  if (DataSource.State <> dsSetKey) and FDetailDataSet.Active and
      (FFields.Count > 0) and ((Field = nil) or
-     (FFields.IndexOf(Field) >= 0)) and
-     Assigned(FOnMasterChange) then
-    FOnMasterChange(Self);
+     (FFields.IndexOf(Field) >= 0)) then
+    DoMasterChange;  
 end;
 
 procedure TMasterDatalink.SetFieldNames(const Value: string);
 
 begin
   if FFieldNames <> Value then
-  begin
+    begin
     FFieldNames := Value;
     ActiveChanged;
-  end;
+    end;
+end;
+
+Procedure TMasterDataLink.DoMasterDisable; 
+
+begin
+  if Assigned(FOnMasterDisable) then 
+    FOnMasterDisable(Self);
+end;
+
+Procedure TMasterDataLink.DoMasterChange; 
+
+begin
+  If Assigned(FOnMasterChange) then
+    FOnMasterChange(Self);
+end;
+
+{ ---------------------------------------------------------------------
+    TMasterDataLink
+  ---------------------------------------------------------------------}
+
+constructor TMasterParamsDataLink.Create(ADataSet: TDataSet);
+
+Var
+  P : TParams;
+
+begin
+  inherited Create(ADataset);
+  If (ADataset<>Nil) then
+    begin
+    P:=TParams(GetObjectProp(ADataset,'Params',TParams));
+    if (P<>Nil) then
+      Params:=P;
+    end;  
+end;
+
+
+Procedure TMasterParamsDataLink.SetParams(AVAlue : TParams);  
+
+Var
+  N : String;
+
+begin
+  N:=DetailDataset.Name;
+  FParams:=AValue;
+  If (AValue<>Nil) then
+    RefreshParamNames;
 end;
 
+Procedure TMasterParamsDataLink.RefreshParamNames; 
+
+Var
+  FN : String;
+  DS : TDataset;
+  F  : TField;
+  I : Integer;
+
+begin
+  FN:='';
+  DS:=Dataset;
+  If Assigned(FParams) then
+    begin
+    F:=Nil;
+    For I:=0 to FParams.Count-1 do
+      begin
+      If Assigned(DS) then
+        F:=DS.FindField(FParams[i].Name);
+      If (Not Assigned(DS)) or (F<>Nil) then
+        begin
+        If (FN<>'') then
+          FN:=FN+';';
+        FN:=FN+FParams[i].Name; 
+        end;
+      end;
+    end;
+  FieldNames:=FN;  
+end;
+
+Procedure TMasterParamsDataLink.CopyParamsFromMaster(CopyBound : Boolean);
+
+begin
+  if Assigned(FParams) then
+    FParams.CopyParamValuesFromDataset(Dataset,CopyBound);
+end;
+
+Procedure TMasterParamsDataLink.DoMasterDisable; 
+
+begin
+  Inherited;
+  If Assigned(DetailDataset) and DetailDataset.Active then
+    DetailDataset.Close;
+end;
+
+Procedure TMasterParamsDataLink.DoMasterChange; 
+
+begin
+  Inherited;
+  if Assigned(Params) and Assigned(DetailDataset) and DetailDataset.Active then
+    begin
+    DetailDataset.Close;
+    DetailDataset.Open;
+    end;
+end;
 
 { ---------------------------------------------------------------------
     TDatasource

fcl/db/db.pp

@@ -1265,7 +1265,7 @@ type
 
   TMasterDataLink = class(TDetailDataLink)
   private
-    FDataSet: TDataSet;
+    FDetailDataSet: TDataSet;
     FFieldNames: string;
     FFields: TList;
     FOnMasterChange: TNotifyEvent;
@@ -1277,8 +1277,10 @@ type
     function GetDetailDataSet: TDataSet; override;
     procedure LayoutChanged; override;
     procedure RecordChanged(Field: TField); override;
+    Procedure DoMasterDisable; virtual;
+    Procedure DoMasterChange; virtual;
   public
-    constructor Create(ADataSet: TDataSet);
+    constructor Create(ADataSet: TDataSet);virtual;
     destructor Destroy; override;
     property FieldNames: string read FFieldNames write SetFieldNames;
     property Fields: TList read FFields;
@@ -1619,6 +1621,7 @@ type
     Procedure AssignField(Field: TField);
     Procedure AssignToField(Field: TField);
     Procedure AssignFieldValue(Field: TField; const AValue: Variant);
+    procedure AssignFromField(Field : TField);
     Procedure Clear;
     Procedure GetData(Buffer: Pointer);
     Function  GetDataSize: Integer;
@@ -1682,11 +1685,26 @@ type
     Function  ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle): String; overload;
     Function  ParseSQL(SQL: String; DoCreate: Boolean; ParameterStyle : TParamStyle; var ParamBinding: TParambinding): String; overload;
     Procedure RemoveParam(Value: TParam);
+    Procedure CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean);
     Property Dataset : TDataset Read GetDataset;
     Property Items[Index: Integer] : TParam read GetItem write SetItem; default;
     Property ParamValues[const ParamName: string] : Variant read GetParamValue write SetParamValue;
   end;
 
+  TMasterParamsDataLink = Class(TMasterDataLink)
+  Private
+    FParams : TParams;
+    Procedure SetParams(AVAlue : TParams);  
+  Protected  
+    Procedure DoMasterDisable; override;
+    Procedure DoMasterChange; override;
+  Public
+    constructor Create(ADataSet: TDataSet); override;
+    Procedure RefreshParamNames; virtual;
+    Procedure CopyParamsFromMaster(CopyBound : Boolean); virtual;
+    Property Params : TParams Read FParams Write SetParams;  
+  end;
+
 const
   FieldTypetoVariantMap : array[TFieldType] of Integer = (varError, varOleStr, varSmallint,
     varInteger, varSmallint, varBoolean, varDouble, varCurrency, varCurrency,
@@ -1820,7 +1838,7 @@ Function DateTimeToDateTimeRec(DT: TFieldType; Data: TDateTime): TDateTimeRec;
 
 implementation
 
-uses dbconst;
+uses dbconst,typinfo;
 
 { ---------------------------------------------------------------------
     Auxiliary functions

fcl/db/dsparams.inc

@@ -676,7 +676,7 @@ begin
   if Assigned(Field) then
     begin
     // Need TField.Value
-    // AssignFieldValue(Field,Field.Value);
+    AssignFieldValue(Field,Field.Value);
     Name:=Field.FieldName;
     end
   else
@@ -721,7 +721,46 @@ begin
     end;
 end;
 
+procedure TParam.AssignFromField(Field : TField);
+
+begin
+  if Assigned(Field) then
+    begin
+    FDataType:=Field.DataType;
+    case Field.DataType of
+      ftUnknown  : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
+      // Need TField.AsSmallInt
+      ftSmallint : AsSmallint:=Field.AsInteger;
+      // Need TField.AsWord
+      ftWord     : AsWord:=Field.AsInteger;
+      ftInteger,
+      ftAutoInc  : AsInteger:=Field.AsInteger;
+      // Need TField.AsCurrency
+      ftCurrency : AsCurrency:=Field.asCurrency;
+      ftFloat    : AsFloat:=Field.asFloat;
+      ftBoolean  : AsBoolean:=Field.AsBoolean;
+      ftBlob,
+      ftGraphic..ftTypedBinary,
+      ftOraBlob,
+      ftOraClob,
+      ftString,
+      ftMemo,
+      ftAdt,
+      ftFixedChar: AsString:=Field.AsString;
+      ftTime,
+      ftDate,
+      ftDateTime : AsDateTime:=Field.AsDateTime;
+      ftBytes,
+      ftVarBytes : ; // Todo.
+    else
+      If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
+        DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
+    end;
+    end;
+end;
+
 Procedure TParam.AssignFieldValue(Field: TField; const AValue: Variant);
+
 begin
   If Assigned(Field) then
     begin
@@ -917,3 +956,25 @@ begin
   end;
 end;
 
+
+Procedure TParams.CopyParamValuesFromDataset(ADataset : TDataset; CopyBound : Boolean);
+
+Var
+  I : Integer;
+  P : TParam;
+  F : TField;
+  
+begin
+  If (ADataSet<>Nil) then
+    For I:=0 to Count-1 do
+     begin
+     P:=Items[i];
+     if CopyBound or (not P.Bound) then
+       begin
+       F:=ADataset.FieldByName(P.Name);
+       P.AssignFromField(F);   
+       If Not CopyBound then
+         P.Bound:=False;
+       end;
+    end;
+end;

fcl/db/sqldb/sqldb.pp

@@ -176,6 +176,7 @@ type
     FWhereStartPos       : integer;
     FWhereStopPos        : integer;
     FParseSQL            : boolean;
+    FMasterLink          : TMasterParamsDatalink;
 //    FSchemaInfo          : TSchemaInfo;
 
     procedure FreeFldBuffers;
@@ -211,6 +212,8 @@ type
     Procedure SetActive (Value : Boolean); override;
     procedure SetFiltered(Value: Boolean); override;
     procedure SetFilterText(const Value: string); override;
+    Function GetDataSource : TDatasource;
+    Procedure SetDataSource(AValue : TDatasource); 
   public
     procedure Prepare; virtual;
     procedure UnPrepare; virtual;
@@ -220,6 +223,7 @@ type
     procedure SetSchemaInfo( SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string); virtual;
     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     property Prepared : boolean read IsPrepared;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
   published
     // redeclared data set properties
     property Active;
@@ -260,6 +264,7 @@ type
     property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey;
     property StatementType : TStatementType read GetStatementType;
     property ParseSQL : Boolean read FParseSQL write SetParseSQL;
+    Property DataSource : TDatasource Read GetDataSource Write SetDatasource;
 //    property SchemaInfo : TSchemaInfo read FSchemaInfo default stNoSchema;
   end;
 
@@ -545,8 +550,9 @@ begin
   UnPrepare;
   if (FSQL <> nil) then
     begin
-    if not assigned(FParams) then FParams := TParams.create(self);
     FParams.ParseSQL(FSQL.Text,True);
+    If Assigned(FMasterLink) then
+      FMasterLink.RefreshParamNames;
     end;
 end;
 
@@ -708,6 +714,8 @@ end;
 
 procedure TSQLQuery.Execute;
 begin
+  If (FParams.Count>0) and Assigned(FMasterLink) then
+    FMasterLink.CopyParamsFromMaster(False);
   (Database as tsqlconnection).execute(Fcursor,Transaction as tsqltransaction, FParams);
 end;
 
@@ -921,6 +929,7 @@ end;
 constructor TSQLQuery.Create(AOwner : TComponent);
 begin
   inherited Create(AOwner);
+  FParams := TParams.create(self);
   FSQL := TStringList.Create;
   FSQL.OnChange := @OnChangeSQL;
   FIndexDefs := TIndexDefs.Create(Self);
@@ -929,7 +938,6 @@ begin
 // Delphi has upWhereAll as default, but since strings and oldvalue's don't work yet
 // (variants) set it to upWhereKeyOnly
   FUpdateMode := upWhereKeyOnly;
-
   FUsePrimaryKeyAsKey := True;
 end;
 
@@ -938,6 +946,7 @@ begin
   if Active then Close;
   UnPrepare;
   if assigned(FCursor) then (Database as TSQLConnection).DeAllocateCursorHandle(FCursor);
+  FreeAndNil(FMasterLink);
   FreeAndNil(FParams);
   FreeAndNil(FSQL);
   FreeAndNil(FIndexDefs);
@@ -1134,4 +1143,43 @@ begin
     else Result := stNone;
 end;
 
+Procedure TSQLQuery.SetDataSource(AVAlue : TDatasource);
+
+Var
+  DS : TDatasource;
+
+begin
+  DS:=DataSource;
+  If (AValue<>DS) then
+    begin
+    If Assigned(DS) then
+      DS.RemoveFreeNotification(Self);
+    If Assigned(AValue) then
+      begin
+      AValue.FreeNotification(Self);  
+      FMasterLink:=TMasterParamsDataLink.Create(Self);
+      FMasterLink.Datasource:=AValue;
+      end
+    else
+      FreeAndNil(FMasterLink);  
+    end;
+end;
+
+Function TSQLQuery.GetDataSource : TDatasource;
+
+begin
+  If Assigned(FMasterLink) then
+    Result:=FMasterLink.DataSource
+  else
+    Result:=Nil;
+end;
+
+procedure TSQLQuery.Notification(AComponent: TComponent; Operation: TOperation); 
+
+begin
+  Inherited;
+  If (Operation=opRemove) and (AComponent=DataSource) then
+    DataSource:=Nil;
+end;
+
 end.