View Issue Details

IDProjectCategoryView StatusLast Update
0036035LazarusLCLpublic2019-09-18 15:28
ReporterZdravko GabrovskiAssigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
PlatformAllOSAllOS VersionAll
Product Version2.1 (SVN)Product BuildTrunc 
Target VersionFixed in Version 
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 Revision
LazTarget
Widgetset
Attached Files
  • 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)
  • 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)

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)

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