LCL, patch for the lookup controls implementing the changing of the key fields of a lookup field, from Leslie Kaye, issue #13396

git-svn-id: trunk@19139 -

lcl/dbctrls.pp

@@ -132,28 +132,32 @@ Type
     FHasLookUpField: Boolean;
     FListLink: TFieldDataLink;
     FListSource: TDataSource;
-    FKeyFieldName: string;
+    FDataFieldNames: string;
-    FKeyFieldValue: string;
+    FKeyFieldNames: string;
     FListFieldName: string;
-    FListFieldValue: string;
     FListFieldIndex: Integer;
-    FKeyField: TField;
+    FLookUpFieldIsCached: Boolean;
-    FListField: TField;
+    FDataFields: TList;  // Data Fields to lookup/edit
-    procedure ActiveChange(Sender: TObject);
+    FKeyFields: TList;   // Keyfields in lookup dataset
+    FListField: TField;  // Result field in lookup dataset
+    FLookupCache: boolean;
+    FLookupList: TLookupList;
     procedure EditingChange(Sender: TObject);
     procedure FetchLookupData;
-    procedure LinkGetBookMark;
-    procedure LinkGotoBookMark;
     function GetKeyFieldName: string;
     function GetListSource: TDataSource;
+    procedure LinkGetBookMark;
+    procedure LinkGotoBookMark;
     procedure SetKeyFieldName(const Value: string);
     procedure SetListSource(Value: TDataSource);
+    procedure SetLookupCache(const Value: boolean);
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure Initialize(AControlDataLink: TFieldDataLink; AControlItems: TStrings);
-    function KeyFieldValueOf(const AListFieldValue: string): string;
+    function ListFieldValue: string;
-    function ListFieldValueOf(const AKeyFieldValue: string): string;
+    procedure UpdateData(const AListFieldValue: string);
+    property LookupCache: boolean read FLookupCache  write SetLookupCache;
     // properties to be published by owner control
     // these are not used where data control Field is dbLookup
     property KeyField: string read GetKeyFieldName write SetKeyFieldName;
@@ -407,10 +411,12 @@ Type
     function GetListField: string;
     function GetListFieldIndex: Integer;
     function GetListSource: TDataSource;
+    function GetLookupCache: boolean;
     procedure SetKeyField(const Value: string);
     procedure SetListField(const Value: string);
     procedure SetListFieldIndex(const Value: Integer);
     procedure SetListSource(const Value: TDataSource);
+    procedure SetLookupCache(const Value: boolean);
   protected
     procedure DataChange(Sender: TObject); override;
     procedure Loaded; override;
@@ -432,6 +438,7 @@ Type
     property ListField: string read GetListField write SetListField;
     property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex;
     property ListSource: TDataSource read GetListSource write SetListSource;
+    property LookupCache: boolean read GetLookupCache  write SetLookupCache;
 //    property MultiSelect;
     property OnClick;
     property OnDblClick;
@@ -709,10 +716,12 @@ Type
     function GetListField: string;
     function GetListFieldIndex: Integer;
     function GetListSource: TDataSource;
+    function GetLookupCache: boolean;
     procedure SetKeyField(const Value: string);
     procedure SetListField(const Value: string);
     procedure SetListFieldIndex(const Value: Integer);
     procedure SetListSource(const Value: TDataSource);
+    procedure SetLookupCache(const Value: boolean);
   protected
     procedure Loaded; override;
     procedure UpdateData(Sender: TObject); override;
@@ -740,6 +749,7 @@ Type
     property ListField: string read GetListField write SetListField;
     property ListFieldIndex: Integer read GetListFieldIndex write SetListFieldIndex;
     property ListSource: TDataSource read GetListSource write SetListSource;
+    property LookupCache: boolean read GetLookupCache  write SetLookupCache;
 //    property MaxLength default -1;
     property OnChange;
     property OnChangeBounds;

lcl/include/dblookup.inc

@@ -24,30 +24,62 @@
 
 { TDBLookup }
 
+{
+Note:
+TField lookup properties
+  KeyFields: Semicolon separate list of Data fields in TField's dataset
+  LookupDataSet: The Dataset to search for values
+  LookupKeyFields: Semicolon separated list of key field names in LookupDataset
+  lookupResultField: Name of the field in the LookupDataset which must be the
+    same data type as the TField
+The lookup Value of the TField is the Value of the LookupResultField determined
+  by a Locate in the lookupDataSet of the LookupKeyFields based on the Values of
+  the KeyFields
+
+Lookup DataControl properties
+  KeyField: Name of the field in the LookupDataset which must be the
+    same data type as the TField
+  ListSource: The Datasource linking to the lookup dataset
+  ListField: The Name of the field in the lookup dataset to list in the control
+
+Usage
+TDBLookup
+fields:
+  FDataFields is the list of fields in the dataset which provide the lookup
+    values and can be edited based on the Control's selected item
+    If the Control's Datafield is a normal field then the Datafield is pointed
+    to by FDataFields[0] and FDataFields.Count is 1.
+    If the Control's Datafield is a lookup field then the FDataFields point to
+    the field's KeyFields
+  FKeyFields is the list of fields in the lookup dataset used
+    to locate the lookup result based on the values of the FDataFields
+  FKeyFields.Count must equal the FDataFields.Count and the fields be of
+    corresponding types
+
+}
+
 constructor TDBLookup.Create(AOwner: TComponent);
 begin
   inherited;
+  FDataFields := TList.Create;
+  FKeyFields := TList.Create;
   FListLink:= TFieldDataLink.Create;
   FListLink.DataSource := TDataSource.Create(Self);
   FListLink.Control := Self;
-  FListLink.OnActiveChange:= @ActiveChange;
   FListLink.OnEditingChange:=@EditingChange;
   FHasLookUpField:= False;
+  FLookupCache := False;
 end;
 
 destructor TDBLookup.Destroy;
 begin
+  FDataFields.Free;
+  FKeyFields.Free;
   FListLink.Free;
+  FLookupList.Free;
   inherited Destroy;
 end;
 
-procedure TDBLookup.ActiveChange(Sender: TObject);
-begin
-  if FListLink.Active then
-    Initialize(FControlLink, FControlItems)
-  else Initialize(nil,nil);
-end;
-
 procedure TDBLookup.EditingChange(Sender: TObject);
 begin
   if not (FListLink.Editing) then
@@ -60,7 +92,7 @@ begin
   if FHasLookUpField then
     Result:= ''
   else
-    Result := FKeyFieldName;
+    Result := FKeyFieldNames;
 end;
 
 function TDBLookup.GetListSource: TDataSource;
@@ -73,7 +105,7 @@ end;
 
 procedure TDBLookup.SetKeyFieldName(const Value: string);
 begin
-  FKeyFieldName:= Value;
+  FKeyFieldNames := Value;
 end;
 
 procedure TDBLookup.SetListSource(Value: TDataSource);
@@ -81,25 +113,11 @@ begin
   FListSource:= Value;
 end;
 
-procedure TDBLookup.FetchLookupData;
+procedure TDBLookup.SetLookupCache(const Value: boolean);
 begin
-  if not Assigned(FControlItems) then
+  FLookupCache := Value;
-    Exit;
+  if (Value and not Assigned(FLookupList)) then
-  FControlItems.Clear;
+    FLookupList := TLookupList.Create;
-  if (Assigned(FListLink.DataSet) and FListLink.DataSet.Active) then
-  begin
-    LinkGetBookMark;
-    try
-      FListLink.DataSet.First;
-      while not FListLink.DataSet.EOF do
-      begin
-        FControlItems.Add(FListField.AsString);
-        FListLink.DataSet.Next;
-      end;
-    finally
-      LinkGotoBookMark;
-    end;
-  end;
 end;
 
 procedure TDBLookup.LinkGetBookMark;
@@ -118,16 +136,49 @@ begin
   end;
 end;
 
+procedure TDBLookup.FetchLookupData;
+var
+  TmpActive: Boolean;
+begin
+  if not Assigned(FControlItems) then
+    Exit;
+  FControlItems.Clear;
+  if not (Assigned(FListLink.DataSet) and Assigned(FListField)) then
+    Exit;
+  TmpActive := FListLink.DataSet.Active;
+  if TmpActive then
+    LinkGetBookMark
+  else
+    FListLink.DataSet.Active := True;
+  try
+    if FLookupCache then
+      FLookupList.Clear;
+    FListLink.DataSet.First;
+    while not FListLink.DataSet.EOF do
+    begin
+      if (FLookupCache and not FLookUpFieldIsCached) then
+        FLookupList.Add(FListLink.DataSet.FieldValues[FKeyFieldNames],
+          FListField.Value);
+      FControlItems.Add(FListField.AsString);
+      FListLink.DataSet.Next;
+    end;
+  finally
+    if TmpActive then
+      LinkGotoBookMark
+    else
+      FListLink.DataSet.Active := False;
+  end;
+end;
+
 procedure TDBLookup.Initialize(AControlDataLink: TFieldDataLink; AControlItems: TStrings);
 var
-  DataField: TField;
   ListFields: TList;
+  TmpActive: Boolean;
   S: string;
 begin
-  FKeyField := nil;
+  FDataFields.Clear;
-  FKeyFieldValue:= '';
+  FKeyFields.Clear;
   FListField := nil;
-  FListFieldValue:= '';
   if not (Assigned(AControlDataLink) and Assigned(AControlItems)) then
     Exit; // Closing or our DataLink is Active but not the Control's DataLink
   FControlLink:= AControlDataLink;
@@ -139,35 +190,41 @@ begin
     AControlDataLink.FieldName:= '';
     AControlDataLink.FieldName:= S;
   end;
-  DataField := AControlDataLink.Field;
+  if not Assigned(AControlDataLink.Field) then
-  if not Assigned(DataField) then
     Exit;
-//  TDBLookupListBox(Owner).Items.Add('Assigned DataField');
+  FHasLookUpField := (AControlDataLink.Field.FieldKind = fkLookup);
-  FHasLookUpField:= (DataField.FieldKind = fkLookup);
+  FLookUpFieldIsCached := (FHasLookupField and AControlDataLink.Field.LookupCache);
   if FHasLookUpField then
   begin
-    FListLink.DataSource.DataSet:= DataField.LookupDataSet;
+    FListLink.DataSource.DataSet:= AControlDataLink.Field.LookupDataSet;
-    FKeyFieldName:= DataField.LookupKeyFields;
+    FDataFieldNames := AControlDataLink.Field.KeyFields;
+    FKeyFieldNames := AControlDataLink.Field.LookupKeyFields;
   end
   else
+  begin
     FListLink.DataSource.DataSet:= FListSource.DataSet;
-  if FListLink.Active and (FKeyFieldName <> '') then
+    FDataFieldNames := AControlDataLink.Field.FieldName;
+  end;
+  if (FKeyFieldNames <> '') then
   begin
     ListFields := TList.Create;
+    TmpActive := FListLink.DataSet.Active;
     try
+      AControlDataLink.DataSet.GetFieldList(FDataFields, FDataFieldNames);
+      FListLink.DataSet.Active := True;
       FListLink.DataSet.GetFieldList(ListFields, FListFieldName);
+      FListLink.DataSet.GetFieldList(FKeyFields, FKeyFieldNames);
       if FHasLookUpField then
       begin
-        FKeyField := FListLink.DataSet.FindField(DataField.LookupResultField);
+        FListField := FListLink.DataSet.FindField(AControlDataLink.Field.LookupResultField);
-        if (Assigned(FKeyField) and (ListFields.IndexOf(FKeyField) < 0)) then
+        if (Assigned(FListField) and (ListFields.IndexOf(FListField) < 0)) then
-          ListFields.Insert(0, FKeyField);
+          ListFields.Insert(0, FListField);
         if (ListFields.Count > 0) then
           FListField := TField(ListFields[0]);
       end else
       begin
-        FKeyField:= FListLink.DataSet.FindField(FKeyFieldName);
+        if ((FKeyFields.Count > 0) and (ListFields.Count = 0)) then
-        if (Assigned(FKeyField) and (ListFields.Count = 0)) then
+          ListFields.Add(FKeyFields[0]);
-          ListFields.Add(FKeyField);
         if ((FListFieldIndex >= 0) and (FListFieldIndex < ListFields.Count)) then
           FListField := TField(ListFields[FListFieldIndex]) else
           FListField := TField(ListFields[0]);
@@ -176,51 +233,93 @@ begin
         FListLink.FieldName:= FListField.FieldName;
     finally
       ListFields.Free;
+      FListLink.DataSet.Active := TmpActive;
     end;
     FetchLookupData;
   end;
 end;
 
-function TDBLookup.KeyFieldValueOf(const AListFieldValue: string): string;
+function TDBLookup.ListFieldValue: string;
+var
+  Key: Variant;
+  TmpActive: Boolean;
 begin
-  if (FListFieldValue <> AListFieldValue) then
+  Result := '';
+  if not ((Assigned(FControlLink) and FControlLink.Active)) then
+    Exit;
+  Key := FControlLink.DataSet.FieldValues[FDataFieldNames];
+  if FHasLookupField then
   begin
-    FListFieldValue:= AListFieldValue;
+    if (FLookupCache and not FLookUpFieldIsCached) then
-    if FHasLookUpField or (AListFieldValue = '') or not Assigned(FKeyField) then
+      Result := FLookupList.ValueOfKey(Key)
-      FKeyFieldValue := AListFieldValue
+    else
-    else if (Assigned(FListLink.DataSet) and FListLink.DataSet.Active) then
+      Result := FControlLink.Field.AsString;
+    Exit;
+  end;
+  if FLookupCache then
   begin
-      LinkGetBookMark;
+    Result := FLookupList.ValueOfKey(Key);
+    Exit;
+  end;
+  TmpActive := FListLink.DataSet.Active;
+  if TmpActive then
+    LinkGetBookMark
+  else
+    FListLink.DataSet.Active := True;
   try
-        if FListLink.DataSet.Locate(FListFieldName, VarArrayOf([AListFieldValue]), []) then
+    if FListLink.DataSet.Locate(FKeyFieldNames,
-          FKeyFieldValue := FKeyField.AsString
+      FControlLink.DataSet.FieldValues[FDataFieldNames], []) then
-        else FKeyFieldValue:= '';
+      Result := FListField.AsString
+    else Result:= '';
   finally
-        LinkGotoBookMark;
+    if TmpActive then
+      LinkGotoBookMark
+    else
+      FListLink.DataSet.Active := False;
   end;
-    end;
-  end;
-  Result := FKeyFieldValue;
 end;
 
-function TDBLookup.ListFieldValueOf(const AKeyFieldValue: string): string;
+procedure TDBLookup.UpdateData(const AListFieldValue: string);
+var
+  I: Integer;
+  TmpActive: Boolean;
+  Key: Variant;
 begin
-  if (FKeyFieldValue <> AKeyFieldValue) then
+  if AListFieldValue = FControlLink.Field.AsString then
+    Exit;
+  if FLookupCache and not FLookupFieldIsCached then
   begin
-    FKeyFieldValue:= AKeyFieldValue;
+    Key := FLookupList.FirstKeyByValue(AListFieldValue);
-    if FHasLookUpField or (AKeyFieldValue = '') or not Assigned(FKeyField) then
+    if not VarIsNull(Key) then
-      FListFieldValue := AKeyFieldValue
-    else if (Assigned(FListLink.DataSet) and FListLink.DataSet.Active) then
     begin
-      LinkGetBookMark;
+      FControlLink.DataSet.Edit;
+      for I := 0 to FDataFields.Count -1 do
+        TField(FDataFields[I]).Value := Key[I];
+      if FHasLookupField then
+        FControlLink.Field.AsString := AListFieldValue;
+    end;
+    Exit;
+  end;
+  if not (Assigned(FListLink.DataSet) and Assigned(FListField)) then
+    Exit;
+  TmpActive := FListLink.DataSet.Active;
+  if TmpActive then
+    LinkGetBookMark
+  else
+    FListLink.DataSet.Active := True;
   try
-        if FListLink.DataSet.Locate(FKeyFieldName, VarArrayOf([AKeyFieldValue]), []) then
+    if FListLink.DataSet.Locate(FListField.FieldName, VarArrayOf([AListFieldValue]), []) then
-          FListFieldValue := FListField.AsString
+    begin
-        else FListFieldValue:= '';
+      FControlLink.DataSet.Edit;
+      for I := 0 to FDataFields.Count -1 do
+        TField(FDataFields[I]).Value := TField(FKeyFields[I]).Value;
+      if FHasLookupField then
+        FControlLink.Field.AsString := AListFieldValue;
+    end;
   finally
-        LinkGotoBookMark;
+    if TmpActive then
+      LinkGotoBookMark
+    else
+      FListLink.DataSet.Active := False;
   end;
-    end;
-  end;
-  Result := FListFieldValue;
 end;

lcl/include/dblookupcombobox.inc

@@ -39,7 +39,7 @@ end;
 
 procedure TDBLookupComboBox.UpdateData(Sender: TObject);
 begin
-  FDataLink.Field.AsString:= FLookup.KeyFieldValueOf(Text);
+  FLookup.UpdateData(Text);
 end;
 
 procedure TDBLookupComboBox.ActiveChange(Sender: TObject);
@@ -52,10 +52,7 @@ end;
 
 procedure TDBLookupComboBox.UpdateText;
 begin
-  if Assigned(FDataLink.Field) then
+  Text:= FLookup.ListFieldValue;
-    Text:= FLookup.ListFieldValueOf(FDataLink.Field.AsString)
-  else
-    inherited UpdateText;
 end;
 
 function TDBLookupComboBox.GetKeyField: string;
@@ -78,6 +75,11 @@ begin
   Result := FLookup.ListSource;
 end;
 
+function TDBLookupComboBox.GetLookupCache: boolean;
+begin
+  Result := FLookup.LookupCache;
+end;
+
 procedure TDBLookupComboBox.SetKeyField(const Value: string);
 begin
   FLookup.KeyField:= Value;
@@ -98,3 +100,8 @@ begin
   FLookup.ListSource:= Value;
 end;
 
+procedure TDBLookupComboBox.SetLookupCache(const Value: boolean);
+begin
+  FLookup.LookupCache := Value;
+end;
+

lcl/include/dblookuplistbox.inc

@@ -41,7 +41,7 @@ procedure TDBLookupListBox.UpdateData(Sender: TObject);
 begin
   if (ItemIndex < 0) then
     Exit;
-  FDataLink.Field.AsString:= FLookup.KeyFieldValueOf(Items[ItemIndex]);
+  FLookup.UpdateData(Items[ItemIndex]);
 end;
 
 procedure TDBLookupListBox.ActiveChange(Sender: TObject);
@@ -56,10 +56,7 @@ end;
 
 procedure TDBLookupListBox.DataChange(Sender: TObject);
 begin
-  if Assigned(FDataLink.Field) then
+  ItemIndex:= Items.IndexOf(FLookup.ListFieldValue);
-    ItemIndex:= Items.IndexOf(FLookup.ListFieldValueOf(FDataLink.Field.AsString))
-  else
-    ItemIndex:= -1;
 end;
 
 function TDBLookupListBox.GetKeyField: string;
@@ -82,6 +79,11 @@ begin
   Result := FLookup.ListSource;
 end;
 
+function TDBLookupListBox.GetLookupCache: boolean;
+begin
+  Result := FLookup.LookupCache;
+end;
+
 procedure TDBLookupListBox.SetKeyField(const Value: string);
 begin
   FLookup.KeyField:= Value;
@@ -102,3 +104,8 @@ begin
   FLookup.ListSource:= Value;
 end;
 
+procedure TDBLookupListBox.SetLookupCache(const Value: boolean);
+begin
+  FLookup.LookupCache := Value;
+end;
+