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 -
This commit is contained in:
jesus 2009-03-28 16:01:10 +00:00
parent aa41109af3
commit d72c8f6da9
4 changed files with 220 additions and 97 deletions

View File

@ -132,28 +132,32 @@ Type
FHasLookUpField: Boolean;
FListLink: TFieldDataLink;
FListSource: TDataSource;
FKeyFieldName: string;
FKeyFieldValue: string;
FDataFieldNames: string;
FKeyFieldNames: string;
FListFieldName: string;
FListFieldValue: string;
FListFieldIndex: Integer;
FKeyField: TField;
FListField: TField;
procedure ActiveChange(Sender: TObject);
FLookUpFieldIsCached: Boolean;
FDataFields: TList; // Data Fields to lookup/edit
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 ListFieldValueOf(const AKeyFieldValue: string): string;
function ListFieldValue: 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;

View File

@ -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
Exit;
FControlItems.Clear;
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;
FLookupCache := Value;
if (Value and not Assigned(FLookupList)) then
FLookupList := TLookupList.Create;
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;
FKeyFieldValue:= '';
FDataFields.Clear;
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(DataField) then
if not Assigned(AControlDataLink.Field) then
Exit;
// TDBLookupListBox(Owner).Items.Add('Assigned DataField');
FHasLookUpField:= (DataField.FieldKind = fkLookup);
FHasLookUpField := (AControlDataLink.Field.FieldKind = fkLookup);
FLookUpFieldIsCached := (FHasLookupField and AControlDataLink.Field.LookupCache);
if FHasLookUpField then
begin
FListLink.DataSource.DataSet:= DataField.LookupDataSet;
FKeyFieldName:= DataField.LookupKeyFields;
FListLink.DataSource.DataSet:= AControlDataLink.Field.LookupDataSet;
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);
if (Assigned(FKeyField) and (ListFields.IndexOf(FKeyField) < 0)) then
ListFields.Insert(0, FKeyField);
FListField := FListLink.DataSet.FindField(AControlDataLink.Field.LookupResultField);
if (Assigned(FListField) and (ListFields.IndexOf(FListField) < 0)) then
ListFields.Insert(0, FListField);
if (ListFields.Count > 0) then
FListField := TField(ListFields[0]);
end else
begin
FKeyField:= FListLink.DataSet.FindField(FKeyFieldName);
if (Assigned(FKeyField) and (ListFields.Count = 0)) then
ListFields.Add(FKeyField);
if ((FKeyFields.Count > 0) and (ListFields.Count = 0)) then
ListFields.Add(FKeyFields[0]);
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 FHasLookUpField or (AListFieldValue = '') or not Assigned(FKeyField) then
FKeyFieldValue := AListFieldValue
else if (Assigned(FListLink.DataSet) and FListLink.DataSet.Active) then
begin
LinkGetBookMark;
try
if FListLink.DataSet.Locate(FListFieldName, VarArrayOf([AListFieldValue]), []) then
FKeyFieldValue := FKeyField.AsString
else FKeyFieldValue:= '';
finally
LinkGotoBookMark;
end;
end;
if (FLookupCache and not FLookUpFieldIsCached) then
Result := FLookupList.ValueOfKey(Key)
else
Result := FControlLink.Field.AsString;
Exit;
end;
if FLookupCache then
begin
Result := FLookupList.ValueOfKey(Key);
Exit;
end;
TmpActive := FListLink.DataSet.Active;
if TmpActive then
LinkGetBookMark
else
FListLink.DataSet.Active := True;
try
if FListLink.DataSet.Locate(FKeyFieldNames,
FControlLink.DataSet.FieldValues[FDataFieldNames], []) then
Result := FListField.AsString
else Result:= '';
finally
if TmpActive then
LinkGotoBookMark
else
FListLink.DataSet.Active := False;
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;
if FHasLookUpField or (AKeyFieldValue = '') or not Assigned(FKeyField) then
FListFieldValue := AKeyFieldValue
else if (Assigned(FListLink.DataSet) and FListLink.DataSet.Active) then
Key := FLookupList.FirstKeyByValue(AListFieldValue);
if not VarIsNull(Key) then
begin
LinkGetBookMark;
try
if FListLink.DataSet.Locate(FKeyFieldName, VarArrayOf([AKeyFieldValue]), []) then
FListFieldValue := FListField.AsString
else FListFieldValue:= '';
finally
LinkGotoBookMark;
end;
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(FListField.FieldName, VarArrayOf([AListFieldValue]), []) then
begin
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
if TmpActive then
LinkGotoBookMark
else
FListLink.DataSet.Active := False;
end;
Result := FListFieldValue;
end;

View File

@ -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.ListFieldValueOf(FDataLink.Field.AsString)
else
inherited UpdateText;
Text:= FLookup.ListFieldValue;
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;

View File

@ -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.ListFieldValueOf(FDataLink.Field.AsString))
else
ItemIndex:= -1;
ItemIndex:= Items.IndexOf(FLookup.ListFieldValue);
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;