All Projects FPC fpcprojects fpprofilerfpGUI Lazarus Packages PatchesLazarus CCR Mantis pas2js

View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0036035LazarusLCLpublic2019-09-01 10:282020-05-05 12:45
ReporterZdravko Gabrovski Assigned ToJuha Manninen  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionreopened 
PlatformAllOSAll 
Product Version2.1 (SVN) 
Summary0036035: Create "EmptyValue" and "DisplayEmpty" properties for TBLookupCombobox and TDBLookupListBox components
DescriptionI am porting my existing old D5/D7 project to lazarus/fpc. I have a lot of TRxDBLookupCombo and TRXDBLookupListBox components, for most of the user selections for various data input (business forms and report parameters).
Delphi TRxDBLookupCombo and TRXDBLookupListBox I am converting to LCL TDBLookupComboBox and TDBLookupListBox components, everything is fine.
But, there is in the TRxDBLookupCombo and TRXDBLookupListBox functionality, do display an empty value, when the user does not want to select any of the values, that are in existing data into lookup data set.
It is very useful in my project, when the user must select some of the value into lookup data set, or some other different value, which will cover for example "All values".

Small example:
Let have a small database list of values table, called "roomstypes" with a fields "roomtypeid", "roomtypename" with a values 1 - One bed room, 2 - Two beds room and 3 - Apartment.
 If I must develop a report for accomodations, with an option to select some of the room type or "all rooms type", I am setting a "DisplayEmpty" property of RXDbLookupCombo to "All room types" and "EmptyValue" property to -1. In that case, on my report generation I am checking if keyvalue=emptyvalue, which means, that the user select "All room types" into RX DB lookup combo box.

I develop this missing functionality for TBLookupComboBox and TDBLookupListBox, by creating properties "DisplayEmpty" and "EmptyValue" into TDBLookup, TDBLookupCombobox and TDBLookupListBox components, and change FetchLookup method inside a TDBLookup class, by adding following code:

    if FEmptyValue<>'' then begin
      KeyIndex := FControlItems.Add(FDisplayEmpty);
      SetLength(FListKeys, ListLinkDataSet.RecordCount+1); // Add one more
      FListKeys[KeyIndex] := FEmptyValue;
      KeyListCount := 1;
    end;

Which handles filleng of the object.

I am creating svn patch diff file, .7z archive with a full unit changes, and small testing project, which uses new functionallity.
Steps To ReproduceAs described with a test project attached.
TagsNo tags attached.
Fixed in Revisionr62884, r63052
LazTarget-
Widgetset
Attached Files

Activities

Zdravko Gabrovski

2019-09-01 10:28

reporter  

allfilesemptyvalues.7z (13,505 bytes)
emptyvaluesfix.diff (7,687 bytes)    
Index: lcl/dbctrls.pp
===================================================================
--- lcl/dbctrls.pp	(revision 61758)
+++ lcl/dbctrls.pp	(working copy)
@@ -123,6 +123,8 @@
     FDataFieldNames: string;
     FKeyFieldNames: string;
     FListFieldName: string;
+    FEmptyValue : String;
+    FDisplayEmpty : String;
     FListFieldIndex: Integer;
     FDataFields: TList;  // Data Fields to lookup/edit
     FKeyFields: TList;   // Keyfields in lookup dataset
@@ -142,6 +144,8 @@
     procedure FetchLookupData;
     function GetKeyFieldName: string;
     function GetListSource: TDataSource;
+    procedure SetDisplayEmpty(AValue: String);
+    procedure SetEmptyVAlue(AValue: String);
     procedure SetKeyFieldName(const Value: string);
     procedure SetListFieldName(const Value: string);
     procedure SetListSource(Value: TDataSource);
@@ -167,6 +171,8 @@
     property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
     property ListSource: TDataSource read GetListSource write SetListSource;
     property NullValueKey: TShortcut read FNullValueKey write FNullValueKey;
+    property EmptyValue : String read FEmptyValue write SetEmptyVAlue;
+    property DisplayEmpty : String read FDisplayEmpty write SetDisplayEmpty;
   end;
 
   { TDBEdit }
@@ -450,6 +456,8 @@
     FLookup: TDBLookup;
     FScrollListDataset: Boolean;
     procedure ActiveChange(Sender: TObject);
+    function GetDisplayEmpty: String;
+    function GetEmptyValue: String;
     function GetKeyField: string;
     function GetKeyValue: Variant;
     function GetListField: string;
@@ -457,6 +465,8 @@
     function GetListSource: TDataSource;
     function GetLookupCache: boolean;
     function GetNullValueKey: TShortCut;
+    procedure SetDisplayEmpty(AValue: String);
+    procedure SetEmptyValue(AValue: String);
     procedure SetKeyField(const Value: string);
     procedure SetKeyValue(const AValue: Variant);
     procedure SetListField(const Value: string);
@@ -501,6 +511,8 @@
     property ListSource: TDataSource read GetListSource write SetListSource;
     property LookupCache: boolean read GetLookupCache  write SetLookupCache;
     property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
+    property EmptyValue: String read GetEmptyValue write SetEmptyValue;
+    property DisplayEmpty: String read GetDisplayEmpty write SetDisplayEmpty;
 //    property MultiSelect;
     property OnClick;
     property OnDblClick;
@@ -850,6 +862,8 @@
     FLookup: TDBLookup;
     FScrollListDataset: Boolean;
     procedure ActiveChange(Sender: TObject);
+    function GetDisplayEmpty: String;
+    function GetEmptyValue: String;
     function GetKeyField: string;
     function GetKeyValue: variant;
     function GetListField: string;
@@ -857,6 +871,8 @@
     function GetListSource: TDataSource;
     function GetLookupCache: boolean;
     function GetNullValueKey: TShortCut;
+    procedure SetDisplayEmpty(AValue: String);
+    procedure SetEmptyValue(AValue: String);
     procedure SetKeyField(const Value: string);
     procedure SetKeyValue(const AValue: variant);
     procedure SetListField(const Value: string);
@@ -911,6 +927,8 @@
     property LookupCache: boolean read GetLookupCache  write SetLookupCache;
 //    property MaxLength default -1;
     property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
+    property EmptyValue: String read GetEmptyValue write SetEmptyValue;
+    property DisplayEmpty: String read GetDisplayEmpty write SetDisplayEmpty;
     property OnChange;
     property OnChangeBounds;
     property OnClick;
Index: lcl/include/dblookup.inc
===================================================================
--- lcl/include/dblookup.inc	(revision 61758)
+++ lcl/include/dblookup.inc	(working copy)
@@ -106,6 +106,8 @@
   FDataFields := TList.Create;
   FKeyFields := TList.Create;
   FListLink := TDBLookupDataLink.Create(Self);
+  FDisplayEmpty := '';
+  FEmptyValue := '';
   //FHasLookUpField := False;
   //FLookupCache := False;
 end;
@@ -175,6 +177,18 @@
     Result:= FListSource;
 end;
 
+procedure TDBLookup.SetDisplayEmpty(AValue: String);
+begin
+  if FDisplayEmpty=AValue then Exit;
+  FDisplayEmpty:=AValue;
+end;
+
+procedure TDBLookup.SetEmptyVAlue(AValue: String);
+begin
+  if FEmptyValue=AValue then Exit;
+  FEmptyValue:=AValue;
+end;
+
 procedure TDBLookup.SetKeyFieldName(const Value: string);
 begin
   FKeyFieldNames := Value;
@@ -259,7 +273,7 @@
 
 procedure TDBLookup.FetchLookupData;
 var
-  KeyIndex, KeyListCount: Integer;
+  KeyIndex, KeyListCount : Integer;
   ListLinkDataSet: TDataSet;
   Bookmark: TBookmark;
   {$IF FPC_FULLVERSION < 30000}
@@ -297,8 +311,19 @@
     //needed to handle sqldb.TSQLQuery that does not has a reliable recordcount after Open
     ListLinkDataSet.Last;
     ListLinkDataSet.First;
+    // Handle Empty Value and Empty Display
+
+    KeyListCount := 0;
     SetLength(FListKeys, ListLinkDataSet.RecordCount);
-    KeyListCount := 0;
+
+    if FEmptyValue<>'' then begin
+      KeyIndex := FControlItems.Add(FDisplayEmpty);
+      SetLength(FListKeys, ListLinkDataSet.RecordCount+1); // Add one more
+      FListKeys[KeyIndex] := FEmptyValue;
+      KeyListCount := 1;
+    end;
+
+
     while not ListLinkDataSet.EOF do
     begin
       KeyIndex := FControlItems.Add(FListField.DisplayText);
Index: lcl/include/dblookupcombobox.inc
===================================================================
--- lcl/include/dblookupcombobox.inc	(revision 61758)
+++ lcl/include/dblookupcombobox.inc	(working copy)
@@ -21,6 +21,8 @@
 begin
   inherited Create(AOwner);
   FLookup := TDBLookup.Create(Self);
+  EmptyValue := '';
+  DisplayEmpty := '';
   FDataLink.OnActiveChange := @ActiveChange;
 end;
 
@@ -68,6 +70,16 @@
     UpdateLookup;
 end;
 
+function TDBLookupComboBox.GetDisplayEmpty: String;
+begin
+  Result := FLookup.DisplayEmpty;
+end;
+
+function TDBLookupComboBox.GetEmptyValue: string;
+begin
+ Result := FLookup.EmptyValue;
+end;
+
 procedure TDBLookupComboBox.DataChange(Sender: TObject);
 begin
   UpdateItemIndex;
@@ -153,6 +165,18 @@
   result := FLookup.NullValueKey;
 end;
 
+procedure TDBLookupComboBox.SetDisplayEmpty(AValue: String);
+begin
+  FLookup.DisplayEmpty:=AValue;
+  UpdateLookup;
+end;
+
+procedure TDBLookupComboBox.SetEmptyValue(AValue: string);
+begin
+  FLookup.EmptyValue:=AValue;
+  UpdateLookup;
+end;
+
 procedure TDBLookupComboBox.SetKeyField(const Value: string);
 begin
   FLookup.KeyField := Value;
Index: lcl/include/dblookuplistbox.inc
===================================================================
--- lcl/include/dblookuplistbox.inc	(revision 61758)
+++ lcl/include/dblookuplistbox.inc	(working copy)
@@ -20,6 +20,8 @@
 begin
   inherited Create(AOwner);
   FLookup:= TDBLookup.Create(Self);
+  EmptyValue := '';
+  DisplayEmpty := '';
   FDataLink.OnActiveChange:= @ActiveChange;
 end;
 
@@ -41,6 +43,16 @@
     UpdateLookup;
 end;
 
+function TDBLookupListBox.GetDisplayEmpty: String;
+begin
+  Result := FLookup.DisplayEmpty;
+end;
+
+function TDBLookupListBox.GetEmptyValue: string;
+begin
+  Result := FLookup.EmptyValue;
+end;
+
 procedure TDBLookupListBox.DataChange(Sender: TObject);
 begin
   if FDatalink.Active then
@@ -134,6 +146,18 @@
   Result := FLookup.NullValueKey;
 end;
 
+procedure TDBLookupListBox.SetDisplayEmpty(AValue: String);
+begin
+  FLookup.DisplayEmpty := AValue;
+  UpdateLookup;
+end;
+
+procedure TDBLookupListBox.SetEmptyValue(AValue: String);
+begin
+  FLookup.EmptyValue := AValue;
+  UpdateLookup;
+end;
+
 procedure TDBLookupListBox.SetKeyField(const Value: string);
 begin
   FLookup.KeyField:= Value;
emptyvaluesfix.diff (7,687 bytes)   
LookupComboTestProject.zip (56,404 bytes)

Michael Van Canneyt

2019-09-02 11:21

administrator   ~0117916

I'm all for this functionality. Delphi component suites such as TMS Software or Devexpress have similar functionality.

Mattias Gaertner

2019-09-16 10:10

manager   ~0118089

About:

 if FEmptyValue<>'' then begin
      KeyIndex := FControlItems.Add(FDisplayEmpty);
      SetLength(FListKeys, ListLinkDataSet.RecordCount+1); // Add one more
      FListKeys[KeyIndex] := FEmptyValue;
      KeyListCount := 1;
    end;

This code mixes three values: KeyIndex, length(FListKeys) and ListLinkDataSet.RecordCount. Wouldn't it be better to do

if FEmptyValue<>'' then begin
  KeyIndex := FControlItems.Add(FDisplayEmpty);
  if KeyIndex<>length(FListKeys) then
    raise Exception.Create('inconsistency'); // sanity check failed
  SetLength(FListKeys, KeyIndex+1); // Add one more
  FListKeys[KeyIndex] := FEmptyValue;
  KeyListCount := 1;
end;

Mattias Gaertner

2019-09-16 10:12

manager   ~0118090

About "TMS Software or Devexpress have similar functionality. "

Why not do it like them? Would make sharing/porting code easier.

Zdravko Gabrovski

2019-09-18 15:28

reporter   ~0118104

I Add an option to display an empty value even LookupDataSet is Empty.
I am taking the idea from good old RX Library, because I am porting my existing D7 project to Lazarus/fpc, which uses a lot of RXDbLookupCombo's ans LIsts's.
I have no idea about the TMS or DevExpress.
allfilesemptyvalues-2.7z (13,557 bytes)
emptyvaluesfix-2.diff (8,447 bytes)    
Index: lcl/dbctrls.pp
===================================================================
--- lcl/dbctrls.pp	(revision 61897)
+++ lcl/dbctrls.pp	(working copy)
@@ -123,6 +123,8 @@
     FDataFieldNames: string;
     FKeyFieldNames: string;
     FListFieldName: string;
+    FEmptyValue : String;
+    FDisplayEmpty : String;
     FListFieldIndex: Integer;
     FDataFields: TList;  // Data Fields to lookup/edit
     FKeyFields: TList;   // Keyfields in lookup dataset
@@ -142,6 +144,8 @@
     procedure FetchLookupData;
     function GetKeyFieldName: string;
     function GetListSource: TDataSource;
+    procedure SetDisplayEmpty(AValue: String);
+    procedure SetEmptyVAlue(AValue: String);
     procedure SetKeyFieldName(const Value: string);
     procedure SetListFieldName(const Value: string);
     procedure SetListSource(Value: TDataSource);
@@ -167,6 +171,8 @@
     property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
     property ListSource: TDataSource read GetListSource write SetListSource;
     property NullValueKey: TShortcut read FNullValueKey write FNullValueKey;
+    property EmptyValue : String read FEmptyValue write SetEmptyVAlue;
+    property DisplayEmpty : String read FDisplayEmpty write SetDisplayEmpty;
   end;
 
   { TDBEdit }
@@ -450,6 +456,8 @@
     FLookup: TDBLookup;
     FScrollListDataset: Boolean;
     procedure ActiveChange(Sender: TObject);
+    function GetDisplayEmpty: String;
+    function GetEmptyValue: String;
     function GetKeyField: string;
     function GetKeyValue: Variant;
     function GetListField: string;
@@ -457,6 +465,8 @@
     function GetListSource: TDataSource;
     function GetLookupCache: boolean;
     function GetNullValueKey: TShortCut;
+    procedure SetDisplayEmpty(AValue: String);
+    procedure SetEmptyValue(AValue: String);
     procedure SetKeyField(const Value: string);
     procedure SetKeyValue(const AValue: Variant);
     procedure SetListField(const Value: string);
@@ -501,6 +511,8 @@
     property ListSource: TDataSource read GetListSource write SetListSource;
     property LookupCache: boolean read GetLookupCache  write SetLookupCache;
     property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
+    property EmptyValue: String read GetEmptyValue write SetEmptyValue;
+    property DisplayEmpty: String read GetDisplayEmpty write SetDisplayEmpty;
 //    property MultiSelect;
     property OnClick;
     property OnDblClick;
@@ -850,6 +862,8 @@
     FLookup: TDBLookup;
     FScrollListDataset: Boolean;
     procedure ActiveChange(Sender: TObject);
+    function GetDisplayEmpty: String;
+    function GetEmptyValue: String;
     function GetKeyField: string;
     function GetKeyValue: variant;
     function GetListField: string;
@@ -857,6 +871,8 @@
     function GetListSource: TDataSource;
     function GetLookupCache: boolean;
     function GetNullValueKey: TShortCut;
+    procedure SetDisplayEmpty(AValue: String);
+    procedure SetEmptyValue(AValue: String);
     procedure SetKeyField(const Value: string);
     procedure SetKeyValue(const AValue: variant);
     procedure SetListField(const Value: string);
@@ -911,6 +927,8 @@
     property LookupCache: boolean read GetLookupCache  write SetLookupCache;
 //    property MaxLength default -1;
     property NullValueKey: TShortCut read GetNullValueKey write SetNullValueKey default 0;
+    property EmptyValue: String read GetEmptyValue write SetEmptyValue;
+    property DisplayEmpty: String read GetDisplayEmpty write SetDisplayEmpty;
     property OnChange;
     property OnChangeBounds;
     property OnClick;
Index: lcl/include/dblookup.inc
===================================================================
--- lcl/include/dblookup.inc	(revision 61897)
+++ lcl/include/dblookup.inc	(working copy)
@@ -106,6 +106,8 @@
   FDataFields := TList.Create;
   FKeyFields := TList.Create;
   FListLink := TDBLookupDataLink.Create(Self);
+  FDisplayEmpty := '';
+  FEmptyValue := '';
   //FHasLookUpField := False;
   //FLookupCache := False;
 end;
@@ -175,6 +177,18 @@
     Result:= FListSource;
 end;
 
+procedure TDBLookup.SetDisplayEmpty(AValue: String);
+begin
+  if FDisplayEmpty=AValue then Exit;
+  FDisplayEmpty:=AValue;
+end;
+
+procedure TDBLookup.SetEmptyVAlue(AValue: String);
+begin
+  if FEmptyValue=AValue then Exit;
+  FEmptyValue:=AValue;
+end;
+
 procedure TDBLookup.SetKeyFieldName(const Value: string);
 begin
   FKeyFieldNames := Value;
@@ -259,7 +273,7 @@
 
 procedure TDBLookup.FetchLookupData;
 var
-  KeyIndex, KeyListCount: Integer;
+  KeyIndex, KeyListCount : Integer;
   ListLinkDataSet: TDataSet;
   Bookmark: TBookmark;
   {$IF FPC_FULLVERSION < 30000}
@@ -276,8 +290,23 @@
   ListLinkDataSet := FListLink.DataSet;
   if not (Assigned(ListLinkDataSet) and Assigned(FListField)) then
     Exit;
-  if ListLinkDataSet.IsEmpty then
+
+  if ListLinkDataSet.IsEmpty then begin
+    // Add Empty value if no recs into dataset
+    if FEmptyValue<>'' then begin
+      FControlItems.BeginUpdate;
+      try
+        KeyIndex := FControlItems.Add(FDisplayEmpty);
+        SetLength(FListKeys, 1);
+        FListKeys[KeyIndex] := FEmptyValue;
+        KeyListCount := 1;
+      finally
+        FControlItems.EndUpdate;
+      end;
+    end;
+
     Exit;
+    end;
   Bookmark := ListLinkDataSet.GetBookmark;
   //in fpc 2.6.4, TMemDataset does not supports BlockRead. Issues 26356, 27959
   {$IF FPC_FULLVERSION < 30000}
@@ -297,8 +326,19 @@
     //needed to handle sqldb.TSQLQuery that does not has a reliable recordcount after Open
     ListLinkDataSet.Last;
     ListLinkDataSet.First;
+    // Handle Empty Value and Empty Display
+
+    KeyListCount := 0;
     SetLength(FListKeys, ListLinkDataSet.RecordCount);
-    KeyListCount := 0;
+
+    if FEmptyValue<>'' then begin
+      KeyIndex := FControlItems.Add(FDisplayEmpty);
+      SetLength(FListKeys, ListLinkDataSet.RecordCount+1); // Add one more
+      FListKeys[KeyIndex] := FEmptyValue;
+      KeyListCount := 1;
+    end;
+
+
     while not ListLinkDataSet.EOF do
     begin
       KeyIndex := FControlItems.Add(FListField.DisplayText);
Index: lcl/include/dblookupcombobox.inc
===================================================================
--- lcl/include/dblookupcombobox.inc	(revision 61897)
+++ lcl/include/dblookupcombobox.inc	(working copy)
@@ -21,6 +21,8 @@
 begin
   inherited Create(AOwner);
   FLookup := TDBLookup.Create(Self);
+  EmptyValue := '';
+  DisplayEmpty := '';
   FDataLink.OnActiveChange := @ActiveChange;
 end;
 
@@ -68,6 +70,16 @@
     UpdateLookup;
 end;
 
+function TDBLookupComboBox.GetDisplayEmpty: String;
+begin
+  Result := FLookup.DisplayEmpty;
+end;
+
+function TDBLookupComboBox.GetEmptyValue: string;
+begin
+ Result := FLookup.EmptyValue;
+end;
+
 procedure TDBLookupComboBox.DataChange(Sender: TObject);
 begin
   UpdateItemIndex;
@@ -153,6 +165,18 @@
   result := FLookup.NullValueKey;
 end;
 
+procedure TDBLookupComboBox.SetDisplayEmpty(AValue: String);
+begin
+  FLookup.DisplayEmpty:=AValue;
+  UpdateLookup;
+end;
+
+procedure TDBLookupComboBox.SetEmptyValue(AValue: string);
+begin
+  FLookup.EmptyValue:=AValue;
+  UpdateLookup;
+end;
+
 procedure TDBLookupComboBox.SetKeyField(const Value: string);
 begin
   FLookup.KeyField := Value;
Index: lcl/include/dblookuplistbox.inc
===================================================================
--- lcl/include/dblookuplistbox.inc	(revision 61897)
+++ lcl/include/dblookuplistbox.inc	(working copy)
@@ -20,6 +20,8 @@
 begin
   inherited Create(AOwner);
   FLookup:= TDBLookup.Create(Self);
+  EmptyValue := '';
+  DisplayEmpty := '';
   FDataLink.OnActiveChange:= @ActiveChange;
 end;
 
@@ -41,6 +43,16 @@
     UpdateLookup;
 end;
 
+function TDBLookupListBox.GetDisplayEmpty: String;
+begin
+  Result := FLookup.DisplayEmpty;
+end;
+
+function TDBLookupListBox.GetEmptyValue: string;
+begin
+  Result := FLookup.EmptyValue;
+end;
+
 procedure TDBLookupListBox.DataChange(Sender: TObject);
 begin
   if FDatalink.Active then
@@ -134,6 +146,18 @@
   Result := FLookup.NullValueKey;
 end;
 
+procedure TDBLookupListBox.SetDisplayEmpty(AValue: String);
+begin
+  FLookup.DisplayEmpty := AValue;
+  UpdateLookup;
+end;
+
+procedure TDBLookupListBox.SetEmptyValue(AValue: String);
+begin
+  FLookup.EmptyValue := AValue;
+  UpdateLookup;
+end;
+
 procedure TDBLookupListBox.SetKeyField(const Value: string);
 begin
   FLookup.KeyField:= Value;
emptyvaluesfix-2.diff (8,447 bytes)   

Zdravko Gabrovski

2020-04-02 14:58

reporter   ~0121847

Here is the files aginst last trunk branch today.
AllEmpty_.7z (13,623 bytes)
AllEmptymerge.7z (1,886 bytes)

Juha Manninen

2020-04-02 17:51

developer   ~0121851

Last edited: 2020-04-02 17:53

View 2 revisions

 I have now a local branch with your changes. I am not an expert with data-aware controls but it looks good.
Comments:
procedure TDBLookup.FetchLookupData has 2 identical lines:
 SetLength(FListKeys, ListLinkDataSet.RecordCount);
One of them can be removed I guess.

What do you say about the note from Mattias: #c118089 ?
It is also about procedure TDBLookup.FetchLookupData.

About Michael's comment:
 I understood this is compatible with RxLib, thus TMS Software or Devexpress compatibility would be a conflicting goal.

Your original patch formats were good although they did not apply any more.
I had to extract your last set of patches and apply them one by one. No big problem, just a convenience thing.
The full sources are not needed. Only patches please.

Juha Manninen

2020-04-04 14:52

developer   ~0121895

Applied, thanks.
I added the change proposed by Mattias.

Zdravko Gabrovski

2020-04-20 20:07

reporter   ~0122297

It is working fine, thanks for the implementation!

Zdravko Gabrovski

2020-04-23 11:45

reporter   ~0122352

Last edited: 2020-04-23 11:55

View 2 revisions

 Today i catch a bug with Matias change.
Please revert the code as I proposed before.

My propose was:

  // Handle Empty Value and Empty Display
    if FEmptyValue<>'' then begin
      KeyIndex := FControlItems.Add(FDisplayEmpty);
      SetLength(FListKeys, ListLinkDataSet.RecordCount+1); // Add one more
      FListKeys[KeyIndex] := FEmptyValue;
      KeyListCount := 1;
    end;

Matias was:

if FEmptyValue<>'' then begin
  KeyIndex := FControlItems.Add(FDisplayEmpty); <----------------This will return always 0 for KeyIndex
  if KeyIndex<>length(FListKeys) then <- FlistKeys length is allready set to Lookupdataset record count and the sanity check always will raise an exception
    raise Exception.Create('inconsistency'); // sanity check failed
  SetLength(FListKeys, KeyIndex+1); // Add one more <---- This is also wrong; This will set FListKeys length to 1, which is wrong, In my code I just increase a size of lookupdataset recordcount with 1 (see above)
  FListKeys[KeyIndex] := FEmptyValue;
  KeyListCount := 1;
end;

In that point FcontrolItems is empty; KeyIndex after add is =0, and his "Sanity" check always fails, because FListKeys Length is allready set to lookup dataset record count.

Zdravko Gabrovski

2020-04-23 11:49

reporter   ~0122353

Please, find attached .diff file. that revert the changes in dblookup.inc
dblookup.diff (985 bytes)    
Index: dblookup.inc
===================================================================
--- dblookup.inc	(revision 63037)
+++ dblookup.inc	(working copy)
@@ -321,14 +321,12 @@
     KeyListCount := 0;
     SetLength(FListKeys, ListLinkDataSet.RecordCount);
     // Handle Empty Value and Empty Display
-    if FEmptyValue<>'' then begin
-      KeyIndex := FControlItems.Add(FDisplayEmpty);
-      if KeyIndex<>length(FListKeys) then              // sanity check
-        raise Exception.Create('TDBLookup.FetchLookupData: inconsistency');
-      SetLength(FListKeys, KeyIndex+1); // Add one more
-      FListKeys[KeyIndex] := FEmptyValue;
-      KeyListCount := 1;
-    end;
+      if FEmptyValue<>'' then begin
+        KeyIndex := FControlItems.Add(FDisplayEmpty);
+        SetLength(FListKeys, ListLinkDataSet.RecordCount+1); // Add one more
+        FListKeys[KeyIndex] := FEmptyValue;
+        KeyListCount := 1;
+      end;
 
     while not ListLinkDataSet.EOF do
     begin
dblookup.diff (985 bytes)   

Juha Manninen

2020-04-24 00:59

developer   ~0122372

Applied, thanks!
In future, even better if you create patches from the top level directory.

Zdravko Gabrovski

2020-04-24 09:06

reporter   ~0122375

OK, thanks, I will :) Have a nice day!

Zdravko Gabrovski

2020-05-05 12:45

reporter   ~0122631

Fixed, works fine!

Issue History

Date Modified Username Field Change
2019-09-01 10:28 Zdravko Gabrovski New Issue
2019-09-01 10:28 Zdravko Gabrovski File Added: allfilesemptyvalues.7z
2019-09-01 10:28 Zdravko Gabrovski File Added: emptyvaluesfix.diff
2019-09-01 10:28 Zdravko Gabrovski File Added: LookupComboTestProject.zip
2019-09-02 11:21 Michael Van Canneyt Note Added: 0117916
2019-09-16 10:10 Mattias Gaertner Note Added: 0118089
2019-09-16 10:12 Mattias Gaertner Note Added: 0118090
2019-09-18 15:28 Zdravko Gabrovski File Added: allfilesemptyvalues-2.7z
2019-09-18 15:28 Zdravko Gabrovski File Added: emptyvaluesfix-2.diff
2019-09-18 15:28 Zdravko Gabrovski Note Added: 0118104
2020-04-02 14:58 Zdravko Gabrovski File Added: AllEmpty_.7z
2020-04-02 14:58 Zdravko Gabrovski File Added: AllEmptymerge.7z
2020-04-02 14:58 Zdravko Gabrovski Note Added: 0121847
2020-04-02 15:57 Juha Manninen Assigned To => Juha Manninen
2020-04-02 15:57 Juha Manninen Status new => assigned
2020-04-02 17:51 Juha Manninen Note Added: 0121851
2020-04-02 17:53 Juha Manninen Note Edited: 0121851 View Revisions
2020-04-02 17:54 Juha Manninen Status assigned => feedback
2020-04-02 17:54 Juha Manninen LazTarget => -
2020-04-04 14:52 Juha Manninen Status feedback => resolved
2020-04-04 14:52 Juha Manninen Resolution open => fixed
2020-04-04 14:52 Juha Manninen Fixed in Revision => r62884
2020-04-04 14:52 Juha Manninen Note Added: 0121895
2020-04-20 20:07 Zdravko Gabrovski Status resolved => closed
2020-04-20 20:07 Zdravko Gabrovski Note Added: 0122297
2020-04-23 11:45 Zdravko Gabrovski Status closed => assigned
2020-04-23 11:45 Zdravko Gabrovski Resolution fixed => reopened
2020-04-23 11:45 Zdravko Gabrovski Note Added: 0122352
2020-04-23 11:49 Zdravko Gabrovski Note Added: 0122353
2020-04-23 11:49 Zdravko Gabrovski File Added: dblookup.diff
2020-04-23 11:55 Zdravko Gabrovski Note Edited: 0122352 View Revisions
2020-04-24 00:59 Juha Manninen Status assigned => resolved
2020-04-24 00:59 Juha Manninen Note Added: 0122372
2020-04-24 01:02 Juha Manninen Description Updated View Revisions
2020-04-24 01:02 Juha Manninen Fixed in Revision r62884 => r62884, r63052
2020-04-24 09:06 Zdravko Gabrovski Note Added: 0122375
2020-05-05 12:45 Zdravko Gabrovski Status resolved => closed
2020-05-05 12:45 Zdravko Gabrovski Note Added: 0122631