View Issue Details

IDProjectCategoryView StatusLast Update
0001090LazarusLCLpublic2011-12-01 11:25
ReportersimonAssigned ToJesus Reyes 
PrioritynormalSeverityfeatureReproducibilityalways
Status closedResolutionfixed 
Product VersionProduct Build 
Target Version0.9.30Fixed in Version0.9.29 (SVN) 
Summary0001090: Dropdown box to lookup dataset in DBGrid
DescriptionDropdown box in the DBGrid to select a record in a lookupdataset. After selecting, filling the lookupfield(s) of the dataset presented in the DBGrid
Tagsdbgrids
Fixed in Revision28425
LazTarget0.9.30
WidgetsetGTK, GTK 2, Win32/Win64, Carbon, QT
Attached Files
  • dbgridlookupdropdown.patch (4,149 bytes)
    Index: lcl/dbgrids.pas
    ===================================================================
    --- lcl/dbgrids.pas	(revision 20942)
    +++ lcl/dbgrids.pas	(working copy)
    @@ -40,7 +40,7 @@
     uses
       Classes, SysUtils, FileUtil, DB,
       LCLStrConsts, LCLIntf, LCLProc, LCLType, LMessages, LResources,
    -  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes;
    +  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes, Variants;
     
     type
       TCustomDbGrid = class;
    @@ -551,12 +551,6 @@
     
     implementation
     
    -type
    -  TLookupListCracker = class(TObject)
    -  private
    -    FList: TList;
    -  end;
    -
     procedure Register;
     begin
       RegisterComponents('Data Controls',[TDBGrid]);
    @@ -671,6 +665,39 @@
       end; // if (Field=nil) or (Field.DisplayWidth=0) ...
     end;
     
    +var
    +  LookupTmpSetActive: Boolean;
    +  LookupBookMark: TBookmark;
    +
    +procedure LookupGetBookMark(ALookupField: TField);
    +begin
    +  LookupTmpSetActive := not ALookupField.LookupDataSet.Active;
    +  if LookupTmpSetActive then
    +    ALookupField.LookupDataSet.Active := True
    +  else
    +  begin
    +    LookupBookMark := ALookupField.LookupDataSet.GetBookmark;
    +    ALookupField.LookupDataSet.DisableControls;
    +  end;
    +end;
    +
    +procedure LookupGotoBookMark(ALookupField: TField);
    +begin
    +  if LookupTmpSetActive then
    +  begin
    +    ALookupField.LookupDataSet.Active := False;
    +    LookupTmpSetActive := False;
    +  end
    +  else
    +  try
    +    ALookupField.LookupDataSet.GotoBookmark(LookupBookMark);
    +    ALookupField.LookupDataSet.FreeBookmark(LookupBookMark);
    +  finally
    +    ALookupField.LookupDataSet.EnableControls;
    +  end;
    +end;
    +
    +
     { TCustomDBGrid }
     
     procedure TCustomDBGrid.OnRecordChanged(Field: TField);
    @@ -1033,8 +1060,7 @@
     procedure TCustomDBGrid.UpdateData;
     var
       selField,edField: TField;
    -  i: Integer;
    -  lst: TList;
    +  LookupKeyValues: Variant;
     begin
       // get Editor text and update field content
       if not UpdatingData and (FEditingColumn>-1) and FDatalink.Editing then begin
    @@ -1048,17 +1074,24 @@
     
           StartUpdating;
           edField.Text := FTempText;
    -      if edField.Lookup and edField.LookupCache then begin
    -        {$WARNINGS OFF}
    -        lst := TLookupListCracker(edField.LookupList).FList;
    -        {$WARNINGS ON}
    -        for i := 0 to lst.Count - 1 do begin
    -          with PLookupListRec(lst[i])^ do
    -            if Value = FTempText then begin
    -              edField.DataSet.FieldValues[edField.KeyFields] := Key;
    -              break;
    -             end;
    +      if edField.Lookup then
    +      begin
    +        LookupKeyValues := Null;
    +        if edField.LookupCache then
    +          LookupKeyValues := edField.LookupList.ValueOfKey(FTempText)
    +        else
    +        begin
    +          LookupGetBookMark(edField);
    +          try
    +            if edField.LookupDataSet.Locate(edField.LookupResultField,
    +              VarArrayOf([FTempText]), []) then
    +                LookupKeyValues :=
    +                  edField.LookupDataSet.FieldValues[edField.LookupKeyFields];
    +          finally
    +            LookupGotoBookMark(edField);
    +          end;
             end;
    +        edField.DataSet.FieldValues[edField.KeyFields] := LookupKeyValues;
           end;
           EndUpdating;
     
    @@ -3230,20 +3263,29 @@
     end;
     
     function TColumn.GetPickList: TStrings;
    -var
    -  i: Integer;
    -  lst: TList;
    -  p: PLookupListRec;
     begin
       Result := inherited GetPickList;
    -  if (Field<>nil) and Field.Lookup and Field.LookupCache then begin
    -    Result.Clear;
    -    {$WARNINGS OFF}
    -    lst := TLookupListCracker(Field.LookupList).FList;
    -    {$WARNINGS ON}
    -    for i := 0 to lst.Count - 1 do begin
    -      p := PLookupListRec(lst.Items[i]);
    -      Result.AddObject(p^.Value, TObject(p));
    +  if (Field<>nil) and FField.Lookup then
    +  begin
    +    if FField.LookupCache then
    +      FField.LookupList.ValuesToStrings(Result)
    +    else
    +    begin
    +      Result.Clear;
    +      LookupGetBookMark(FField);
    +      try
    +      with FField.LookupDataSet do
    +      begin
    +        First;
    +        while not EOF do
    +        begin
    +          Result.Add(FieldbyName(FField.LookupResultField).AsString);
    +          Next;
    +        end;
    +      end;
    +      finally
    +        LookupGotoBookMark(FField);
    +      end;
         end;
       end;
     end;
    
  • dbgridlookupdropdownrevised.patch (7,199 bytes)
    Index: lcl/dbgrids.pas
    ===================================================================
    --- lcl/dbgrids.pas	(revision 20987)
    +++ lcl/dbgrids.pas	(working copy)
    @@ -40,7 +40,7 @@
     uses
       Classes, SysUtils, FileUtil, DB,
       LCLStrConsts, LCLIntf, LCLProc, LCLType, LMessages, LResources,
    -  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes;
    +  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes, Variants;
     
     type
       TCustomDbGrid = class;
    @@ -363,6 +363,7 @@
         procedure CreateWnd; override;
         procedure DefineProperties(Filer: TFiler); override;
         procedure DefaultDrawCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState);
    +    procedure DoEditorShow; override;
         procedure DoExit; override;
         function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
         function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    @@ -551,12 +552,6 @@
     
     implementation
     
    -type
    -  TLookupListCracker = class(TObject)
    -  private
    -    FList: TList;
    -  end;
    -
     procedure Register;
     begin
       RegisterComponents('Data Controls',[TDBGrid]);
    @@ -671,6 +666,39 @@
       end; // if (Field=nil) or (Field.DisplayWidth=0) ...
     end;
     
    +var
    +  LookupTmpSetActive: Boolean;
    +  LookupBookMark: TBookmark;
    +
    +procedure LookupGetBookMark(ALookupField: TField);
    +begin
    +  LookupTmpSetActive := not ALookupField.LookupDataSet.Active;
    +  if LookupTmpSetActive then
    +    ALookupField.LookupDataSet.Active := True
    +  else
    +  begin
    +    LookupBookMark := ALookupField.LookupDataSet.GetBookmark;
    +    ALookupField.LookupDataSet.DisableControls;
    +  end;
    +end;
    +
    +procedure LookupGotoBookMark(ALookupField: TField);
    +begin
    +  if LookupTmpSetActive then
    +  begin
    +    ALookupField.LookupDataSet.Active := False;
    +    LookupTmpSetActive := False;
    +  end
    +  else
    +  try
    +    ALookupField.LookupDataSet.GotoBookmark(LookupBookMark);
    +    ALookupField.LookupDataSet.FreeBookmark(LookupBookMark);
    +  finally
    +    ALookupField.LookupDataSet.EnableControls;
    +  end;
    +end;
    +
    +
     { TCustomDBGrid }
     
     procedure TCustomDBGrid.OnRecordChanged(Field: TField);
    @@ -1033,10 +1061,10 @@
     procedure TCustomDBGrid.UpdateData;
     var
       selField,edField: TField;
    -  i: Integer;
    -  lst: TList;
    +  LookupKeyValues: Variant;
     begin
       // get Editor text and update field content
    +  Showmessage(FTempText);
       if not UpdatingData and (FEditingColumn>-1) and FDatalink.Editing then begin
         SelField := SelectedField;
         edField := GetFieldFromGridColumn(FEditingColumn);
    @@ -1045,20 +1073,26 @@
           {$ifdef dbgDBGrid}
           DebugLn('---> UpdateData: Field[', edField.Fieldname, '(',edField.AsString,')]=', FTempText,' INIT');
           {$endif}
    -
           StartUpdating;
           edField.Text := FTempText;
    -      if edField.Lookup and edField.LookupCache then begin
    -        {$WARNINGS OFF}
    -        lst := TLookupListCracker(edField.LookupList).FList;
    -        {$WARNINGS ON}
    -        for i := 0 to lst.Count - 1 do begin
    -          with PLookupListRec(lst[i])^ do
    -            if Value = FTempText then begin
    -              edField.DataSet.FieldValues[edField.KeyFields] := Key;
    -              break;
    -             end;
    +      if edField.Lookup then
    +      begin
    +        LookupKeyValues := Null;
    +        if edField.LookupCache then
    +          LookupKeyValues := edField.LookupList.ValueOfKey(FTempText)
    +        else
    +        begin
    +          LookupGetBookMark(edField);
    +          try
    +            if edField.LookupDataSet.Locate(edField.LookupResultField,
    +              VarArrayOf([FTempText]), []) then
    +                LookupKeyValues :=
    +                  edField.LookupDataSet.FieldValues[edField.LookupKeyFields];
    +          finally
    +            LookupGotoBookMark(edField);
    +          end;
             end;
    +        edField.DataSet.FieldValues[edField.KeyFields] := LookupKeyValues;
           end;
           EndUpdating;
     
    @@ -1723,7 +1757,13 @@
       end;
     end;
     
    +procedure TCustomDBGrid.DoEditorShow;
    +begin
    +  inherited;
    +  FDataLink.Edit;
    +end;
     
    +
     procedure TCustomDBGrid.DoOnChangeBounds;
     begin
       BeginUpdate;
    @@ -2629,16 +2669,34 @@
     function TCustomDBGrid.EditorIsReadOnly: boolean;
     var
       AField : TField;
    +  FieldList: TList;
    +  I: Integer;
     begin
       Result := inherited EditorIsReadOnly;
    +
       if not Result then begin
         AField := GetFieldFromGridColumn(Col);
         if assigned(AField) then
    +    begin
           Result := not AField.CanModify;
    -    if not result then
    -      Result := not FDataLink.Edit;
    -    EditingColumn(Col, not Result);
    +      if not Result and (AField.FieldKind = fkLookup) then
    +      begin
    +        FieldList := TList.Create;
    +        try
    +          AField.DataSet.GetFieldList(FieldList, AField.KeyFields);
    +          for I := 0 to FieldList.Count-1 do
    +            if not TField(FieldList[I]).CanModify then
    +            begin
    +              Result := True;
    +              break;
    +          end;
    +        finally
    +          FieldList.Free;
    +        end;
    +      end;
    +    end;
       end;
    +  EditingColumn(Col, not Result);
     end;
     
     procedure TCustomDBGrid.HeaderSized(IsColumn: Boolean; Index: Integer);
    @@ -3230,20 +3288,29 @@
     end;
     
     function TColumn.GetPickList: TStrings;
    -var
    -  i: Integer;
    -  lst: TList;
    -  p: PLookupListRec;
     begin
       Result := inherited GetPickList;
    -  if (Field<>nil) and Field.Lookup and Field.LookupCache then begin
    -    Result.Clear;
    -    {$WARNINGS OFF}
    -    lst := TLookupListCracker(Field.LookupList).FList;
    -    {$WARNINGS ON}
    -    for i := 0 to lst.Count - 1 do begin
    -      p := PLookupListRec(lst.Items[i]);
    -      Result.AddObject(p^.Value, TObject(p));
    +  if (Field<>nil) and FField.Lookup then
    +  begin
    +    if FField.LookupCache then
    +      FField.LookupList.ValuesToStrings(Result)
    +    else
    +    begin
    +      Result.Clear;
    +      LookupGetBookMark(FField);
    +      try
    +      with FField.LookupDataSet do
    +      begin
    +        First;
    +        while not EOF do
    +        begin
    +          Result.Add(FieldbyName(FField.LookupResultField).AsString);
    +          Next;
    +        end;
    +      end;
    +      finally
    +        LookupGotoBookMark(FField);
    +      end;
         end;
       end;
     end;
    Index: lcl/grids.pas
    ===================================================================
    --- lcl/grids.pas	(revision 20987)
    +++ lcl/grids.pas	(working copy)
    @@ -2921,8 +2921,9 @@
     
     function TCustomGrid.CanEditShow: Boolean;
     begin
    -  Result := EditingAllowed(FCol) and not (csDesigning in ComponentState)
    -            and CanFocus;
    +  Result := CanFocus and not (csDesigning in ComponentState);
    +  if Result then
    +    Result := EditingAllowed(FCol);
     end;
     
     procedure TCustomGrid.Paint;
    @@ -6197,7 +6198,7 @@
       Result:=(goEditing in options);
       if Result and (ACol>=0) and (ACol<FColumns.Count) then begin
         C:=ColumnFromGridColumn(ACol);
    -    Result:=(C<>nil) and (not C.ReadOnly);
    +    Result:=(C<>nil) and (not EditorIsReadOnly);
       end;
     end;
     
    @@ -6208,7 +6209,7 @@
       or (not HandleAllocated) then
         Exit;
     
    -  if EditingAllowed(FCol) and CanEditShow and
    +  if CanEditShow and
          (not FEditorShowing) and (Editor<>nil) and (not Editor.Visible) then
       begin
         {$ifdef dbgGrid} DebugLn('EditorShow [',Editor.ClassName,'] INIT FCol=',IntToStr(FCol),' FRow=',IntToStr(FRow));{$endif}
    
  • dbgridlookupdropdownrevised2.patch (7,240 bytes)
    Index: lcl/dbgrids.pas
    ===================================================================
    --- lcl/dbgrids.pas	(revision 20987)
    +++ lcl/dbgrids.pas	(working copy)
    @@ -40,7 +40,7 @@
     uses
       Classes, SysUtils, FileUtil, DB,
       LCLStrConsts, LCLIntf, LCLProc, LCLType, LMessages, LResources,
    -  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes;
    +  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes, Variants;
     
     type
       TCustomDbGrid = class;
    @@ -363,6 +363,7 @@
         procedure CreateWnd; override;
         procedure DefineProperties(Filer: TFiler); override;
         procedure DefaultDrawCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState);
    +    procedure DoEditorShow; override;
         procedure DoExit; override;
         function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
         function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
    @@ -551,12 +552,6 @@
     
     implementation
     
    -type
    -  TLookupListCracker = class(TObject)
    -  private
    -    FList: TList;
    -  end;
    -
     procedure Register;
     begin
       RegisterComponents('Data Controls',[TDBGrid]);
    @@ -671,6 +666,39 @@
       end; // if (Field=nil) or (Field.DisplayWidth=0) ...
     end;
     
    +var
    +  LookupTmpSetActive: Boolean;
    +  LookupBookMark: TBookmark;
    +
    +procedure LookupGetBookMark(ALookupField: TField);
    +begin
    +  LookupTmpSetActive := not ALookupField.LookupDataSet.Active;
    +  if LookupTmpSetActive then
    +    ALookupField.LookupDataSet.Active := True
    +  else
    +  begin
    +    LookupBookMark := ALookupField.LookupDataSet.GetBookmark;
    +    ALookupField.LookupDataSet.DisableControls;
    +  end;
    +end;
    +
    +procedure LookupGotoBookMark(ALookupField: TField);
    +begin
    +  if LookupTmpSetActive then
    +  begin
    +    ALookupField.LookupDataSet.Active := False;
    +    LookupTmpSetActive := False;
    +  end
    +  else
    +  try
    +    ALookupField.LookupDataSet.GotoBookmark(LookupBookMark);
    +    ALookupField.LookupDataSet.FreeBookmark(LookupBookMark);
    +  finally
    +    ALookupField.LookupDataSet.EnableControls;
    +  end;
    +end;
    +
    +
     { TCustomDBGrid }
     
     procedure TCustomDBGrid.OnRecordChanged(Field: TField);
    @@ -1033,8 +1061,7 @@
     procedure TCustomDBGrid.UpdateData;
     var
       selField,edField: TField;
    -  i: Integer;
    -  lst: TList;
    +  LookupKeyValues: Variant;
     begin
       // get Editor text and update field content
       if not UpdatingData and (FEditingColumn>-1) and FDatalink.Editing then begin
    @@ -1045,20 +1072,26 @@
           {$ifdef dbgDBGrid}
           DebugLn('---> UpdateData: Field[', edField.Fieldname, '(',edField.AsString,')]=', FTempText,' INIT');
           {$endif}
    -
           StartUpdating;
           edField.Text := FTempText;
    -      if edField.Lookup and edField.LookupCache then begin
    -        {$WARNINGS OFF}
    -        lst := TLookupListCracker(edField.LookupList).FList;
    -        {$WARNINGS ON}
    -        for i := 0 to lst.Count - 1 do begin
    -          with PLookupListRec(lst[i])^ do
    -            if Value = FTempText then begin
    -              edField.DataSet.FieldValues[edField.KeyFields] := Key;
    -              break;
    -             end;
    +      if edField.Lookup then
    +      begin
    +        LookupKeyValues := Null;
    +        if edField.LookupCache then
    +          LookupKeyValues := edField.LookupList.ValueOfKey(FTempText)
    +        else
    +        begin
    +          LookupGetBookMark(edField);
    +          try
    +            if edField.LookupDataSet.Locate(edField.LookupResultField,
    +              VarArrayOf([FTempText]), []) then
    +                LookupKeyValues :=
    +                  edField.LookupDataSet.FieldValues[edField.LookupKeyFields];
    +          finally
    +            LookupGotoBookMark(edField);
    +          end;
             end;
    +        edField.DataSet.FieldValues[edField.KeyFields] := LookupKeyValues;
           end;
           EndUpdating;
     
    @@ -1723,7 +1756,13 @@
       end;
     end;
     
    +procedure TCustomDBGrid.DoEditorShow;
    +begin
    +  inherited;
    +  FDataLink.Edit;
    +end;
     
    +
     procedure TCustomDBGrid.DoOnChangeBounds;
     begin
       BeginUpdate;
    @@ -2629,14 +2668,32 @@
     function TCustomDBGrid.EditorIsReadOnly: boolean;
     var
       AField : TField;
    +  FieldList: TList;
    +  I: Integer;
     begin
       Result := inherited EditorIsReadOnly;
    +
       if not Result then begin
         AField := GetFieldFromGridColumn(Col);
         if assigned(AField) then
    +    begin
           Result := not AField.CanModify;
    -    if not result then
    -      Result := not FDataLink.Edit;
    +      if not Result and (AField.FieldKind = fkLookup) then
    +      begin
    +        FieldList := TList.Create;
    +        try
    +          AField.DataSet.GetFieldList(FieldList, AField.KeyFields);
    +          for I := 0 to FieldList.Count-1 do
    +            if not TField(FieldList[I]).CanModify then
    +            begin
    +              Result := True;
    +              break;
    +          end;
    +        finally
    +          FieldList.Free;
    +        end;
    +      end;
    +    end;
         EditingColumn(Col, not Result);
       end;
     end;
    @@ -3230,20 +3287,29 @@
     end;
     
     function TColumn.GetPickList: TStrings;
    -var
    -  i: Integer;
    -  lst: TList;
    -  p: PLookupListRec;
     begin
       Result := inherited GetPickList;
    -  if (Field<>nil) and Field.Lookup and Field.LookupCache then begin
    -    Result.Clear;
    -    {$WARNINGS OFF}
    -    lst := TLookupListCracker(Field.LookupList).FList;
    -    {$WARNINGS ON}
    -    for i := 0 to lst.Count - 1 do begin
    -      p := PLookupListRec(lst.Items[i]);
    -      Result.AddObject(p^.Value, TObject(p));
    +  if (Field<>nil) and FField.Lookup then
    +  begin
    +    if FField.LookupCache then
    +      FField.LookupList.ValuesToStrings(Result)
    +    else
    +    begin
    +      Result.Clear;
    +      LookupGetBookMark(FField);
    +      try
    +      with FField.LookupDataSet do
    +      begin
    +        First;
    +        while not EOF do
    +        begin
    +          Result.Add(FieldbyName(FField.LookupResultField).AsString);
    +          Next;
    +        end;
    +      end;
    +      finally
    +        LookupGotoBookMark(FField);
    +      end;
         end;
       end;
     end;
    Index: lcl/grids.pas
    ===================================================================
    --- lcl/grids.pas	(revision 20987)
    +++ lcl/grids.pas	(working copy)
    @@ -2921,8 +2921,9 @@
     
     function TCustomGrid.CanEditShow: Boolean;
     begin
    -  Result := EditingAllowed(FCol) and not (csDesigning in ComponentState)
    -            and CanFocus;
    +  Result := CanFocus and not (csDesigning in ComponentState);
    +  if Result then
    +    Result := EditingAllowed(FCol);
     end;
     
     procedure TCustomGrid.Paint;
    @@ -6197,7 +6198,7 @@
       Result:=(goEditing in options);
       if Result and (ACol>=0) and (ACol<FColumns.Count) then begin
         C:=ColumnFromGridColumn(ACol);
    -    Result:=(C<>nil) and (not C.ReadOnly);
    +    Result:=(C<>nil) and (not EditorIsReadOnly);
       end;
     end;
     
    @@ -6208,7 +6209,7 @@
       or (not HandleAllocated) then
         Exit;
     
    -  if EditingAllowed(FCol) and CanEditShow and
    +  if CanEditShow and
          (not FEditorShowing) and (Editor<>nil) and (not Editor.Visible) then
       begin
         {$ifdef dbgGrid} DebugLn('EditorShow [',Editor.ClassName,'] INIT FCol=',IntToStr(FCol),' FRow=',IntToStr(FRow));{$endif}
    @@ -7210,6 +7211,7 @@
     
       FPicklistEditor := TPickListCellEditor.Create(nil);
       FPickListEditor.Name := 'PickListEditor';
    +  FPicklistEditor.Style := csDropDownList;
       FPickListEditor.Visible := False;
     
       FButtonStringEditor := TCompositeCellEditor.Create(nil);
    

Relationships

related to 0013174 resolvedJesus Reyes Patches Fix readonly-columns in grids 

Activities

Leslie Kaye

2009-07-25 12:37

reporter   ~0029243

Last edited: 2009-07-28 12:53

I attach dbgridlookupdropdownrevised2.patch which fixes this issue. Please ignore earlier versions.

2009-07-25 12:37

 

dbgridlookupdropdown.patch (4,149 bytes)
Index: lcl/dbgrids.pas
===================================================================
--- lcl/dbgrids.pas	(revision 20942)
+++ lcl/dbgrids.pas	(working copy)
@@ -40,7 +40,7 @@
 uses
   Classes, SysUtils, FileUtil, DB,
   LCLStrConsts, LCLIntf, LCLProc, LCLType, LMessages, LResources,
-  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes;
+  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes, Variants;
 
 type
   TCustomDbGrid = class;
@@ -551,12 +551,6 @@
 
 implementation
 
-type
-  TLookupListCracker = class(TObject)
-  private
-    FList: TList;
-  end;
-
 procedure Register;
 begin
   RegisterComponents('Data Controls',[TDBGrid]);
@@ -671,6 +665,39 @@
   end; // if (Field=nil) or (Field.DisplayWidth=0) ...
 end;
 
+var
+  LookupTmpSetActive: Boolean;
+  LookupBookMark: TBookmark;
+
+procedure LookupGetBookMark(ALookupField: TField);
+begin
+  LookupTmpSetActive := not ALookupField.LookupDataSet.Active;
+  if LookupTmpSetActive then
+    ALookupField.LookupDataSet.Active := True
+  else
+  begin
+    LookupBookMark := ALookupField.LookupDataSet.GetBookmark;
+    ALookupField.LookupDataSet.DisableControls;
+  end;
+end;
+
+procedure LookupGotoBookMark(ALookupField: TField);
+begin
+  if LookupTmpSetActive then
+  begin
+    ALookupField.LookupDataSet.Active := False;
+    LookupTmpSetActive := False;
+  end
+  else
+  try
+    ALookupField.LookupDataSet.GotoBookmark(LookupBookMark);
+    ALookupField.LookupDataSet.FreeBookmark(LookupBookMark);
+  finally
+    ALookupField.LookupDataSet.EnableControls;
+  end;
+end;
+
+
 { TCustomDBGrid }
 
 procedure TCustomDBGrid.OnRecordChanged(Field: TField);
@@ -1033,8 +1060,7 @@
 procedure TCustomDBGrid.UpdateData;
 var
   selField,edField: TField;
-  i: Integer;
-  lst: TList;
+  LookupKeyValues: Variant;
 begin
   // get Editor text and update field content
   if not UpdatingData and (FEditingColumn>-1) and FDatalink.Editing then begin
@@ -1048,17 +1074,24 @@
 
       StartUpdating;
       edField.Text := FTempText;
-      if edField.Lookup and edField.LookupCache then begin
-        {$WARNINGS OFF}
-        lst := TLookupListCracker(edField.LookupList).FList;
-        {$WARNINGS ON}
-        for i := 0 to lst.Count - 1 do begin
-          with PLookupListRec(lst[i])^ do
-            if Value = FTempText then begin
-              edField.DataSet.FieldValues[edField.KeyFields] := Key;
-              break;
-             end;
+      if edField.Lookup then
+      begin
+        LookupKeyValues := Null;
+        if edField.LookupCache then
+          LookupKeyValues := edField.LookupList.ValueOfKey(FTempText)
+        else
+        begin
+          LookupGetBookMark(edField);
+          try
+            if edField.LookupDataSet.Locate(edField.LookupResultField,
+              VarArrayOf([FTempText]), []) then
+                LookupKeyValues :=
+                  edField.LookupDataSet.FieldValues[edField.LookupKeyFields];
+          finally
+            LookupGotoBookMark(edField);
+          end;
         end;
+        edField.DataSet.FieldValues[edField.KeyFields] := LookupKeyValues;
       end;
       EndUpdating;
 
@@ -3230,20 +3263,29 @@
 end;
 
 function TColumn.GetPickList: TStrings;
-var
-  i: Integer;
-  lst: TList;
-  p: PLookupListRec;
 begin
   Result := inherited GetPickList;
-  if (Field<>nil) and Field.Lookup and Field.LookupCache then begin
-    Result.Clear;
-    {$WARNINGS OFF}
-    lst := TLookupListCracker(Field.LookupList).FList;
-    {$WARNINGS ON}
-    for i := 0 to lst.Count - 1 do begin
-      p := PLookupListRec(lst.Items[i]);
-      Result.AddObject(p^.Value, TObject(p));
+  if (Field<>nil) and FField.Lookup then
+  begin
+    if FField.LookupCache then
+      FField.LookupList.ValuesToStrings(Result)
+    else
+    begin
+      Result.Clear;
+      LookupGetBookMark(FField);
+      try
+      with FField.LookupDataSet do
+      begin
+        First;
+        while not EOF do
+        begin
+          Result.Add(FieldbyName(FField.LookupResultField).AsString);
+          Next;
+        end;
+      end;
+      finally
+        LookupGotoBookMark(FField);
+      end;
     end;
   end;
 end;

2009-07-28 12:46

 

dbgridlookupdropdownrevised.patch (7,199 bytes)
Index: lcl/dbgrids.pas
===================================================================
--- lcl/dbgrids.pas	(revision 20987)
+++ lcl/dbgrids.pas	(working copy)
@@ -40,7 +40,7 @@
 uses
   Classes, SysUtils, FileUtil, DB,
   LCLStrConsts, LCLIntf, LCLProc, LCLType, LMessages, LResources,
-  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes;
+  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes, Variants;
 
 type
   TCustomDbGrid = class;
@@ -363,6 +363,7 @@
     procedure CreateWnd; override;
     procedure DefineProperties(Filer: TFiler); override;
     procedure DefaultDrawCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState);
+    procedure DoEditorShow; override;
     procedure DoExit; override;
     function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
     function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
@@ -551,12 +552,6 @@
 
 implementation
 
-type
-  TLookupListCracker = class(TObject)
-  private
-    FList: TList;
-  end;
-
 procedure Register;
 begin
   RegisterComponents('Data Controls',[TDBGrid]);
@@ -671,6 +666,39 @@
   end; // if (Field=nil) or (Field.DisplayWidth=0) ...
 end;
 
+var
+  LookupTmpSetActive: Boolean;
+  LookupBookMark: TBookmark;
+
+procedure LookupGetBookMark(ALookupField: TField);
+begin
+  LookupTmpSetActive := not ALookupField.LookupDataSet.Active;
+  if LookupTmpSetActive then
+    ALookupField.LookupDataSet.Active := True
+  else
+  begin
+    LookupBookMark := ALookupField.LookupDataSet.GetBookmark;
+    ALookupField.LookupDataSet.DisableControls;
+  end;
+end;
+
+procedure LookupGotoBookMark(ALookupField: TField);
+begin
+  if LookupTmpSetActive then
+  begin
+    ALookupField.LookupDataSet.Active := False;
+    LookupTmpSetActive := False;
+  end
+  else
+  try
+    ALookupField.LookupDataSet.GotoBookmark(LookupBookMark);
+    ALookupField.LookupDataSet.FreeBookmark(LookupBookMark);
+  finally
+    ALookupField.LookupDataSet.EnableControls;
+  end;
+end;
+
+
 { TCustomDBGrid }
 
 procedure TCustomDBGrid.OnRecordChanged(Field: TField);
@@ -1033,10 +1061,10 @@
 procedure TCustomDBGrid.UpdateData;
 var
   selField,edField: TField;
-  i: Integer;
-  lst: TList;
+  LookupKeyValues: Variant;
 begin
   // get Editor text and update field content
+  Showmessage(FTempText);
   if not UpdatingData and (FEditingColumn>-1) and FDatalink.Editing then begin
     SelField := SelectedField;
     edField := GetFieldFromGridColumn(FEditingColumn);
@@ -1045,20 +1073,26 @@
       {$ifdef dbgDBGrid}
       DebugLn('---> UpdateData: Field[', edField.Fieldname, '(',edField.AsString,')]=', FTempText,' INIT');
       {$endif}
-
       StartUpdating;
       edField.Text := FTempText;
-      if edField.Lookup and edField.LookupCache then begin
-        {$WARNINGS OFF}
-        lst := TLookupListCracker(edField.LookupList).FList;
-        {$WARNINGS ON}
-        for i := 0 to lst.Count - 1 do begin
-          with PLookupListRec(lst[i])^ do
-            if Value = FTempText then begin
-              edField.DataSet.FieldValues[edField.KeyFields] := Key;
-              break;
-             end;
+      if edField.Lookup then
+      begin
+        LookupKeyValues := Null;
+        if edField.LookupCache then
+          LookupKeyValues := edField.LookupList.ValueOfKey(FTempText)
+        else
+        begin
+          LookupGetBookMark(edField);
+          try
+            if edField.LookupDataSet.Locate(edField.LookupResultField,
+              VarArrayOf([FTempText]), []) then
+                LookupKeyValues :=
+                  edField.LookupDataSet.FieldValues[edField.LookupKeyFields];
+          finally
+            LookupGotoBookMark(edField);
+          end;
         end;
+        edField.DataSet.FieldValues[edField.KeyFields] := LookupKeyValues;
       end;
       EndUpdating;
 
@@ -1723,7 +1757,13 @@
   end;
 end;
 
+procedure TCustomDBGrid.DoEditorShow;
+begin
+  inherited;
+  FDataLink.Edit;
+end;
 
+
 procedure TCustomDBGrid.DoOnChangeBounds;
 begin
   BeginUpdate;
@@ -2629,16 +2669,34 @@
 function TCustomDBGrid.EditorIsReadOnly: boolean;
 var
   AField : TField;
+  FieldList: TList;
+  I: Integer;
 begin
   Result := inherited EditorIsReadOnly;
+
   if not Result then begin
     AField := GetFieldFromGridColumn(Col);
     if assigned(AField) then
+    begin
       Result := not AField.CanModify;
-    if not result then
-      Result := not FDataLink.Edit;
-    EditingColumn(Col, not Result);
+      if not Result and (AField.FieldKind = fkLookup) then
+      begin
+        FieldList := TList.Create;
+        try
+          AField.DataSet.GetFieldList(FieldList, AField.KeyFields);
+          for I := 0 to FieldList.Count-1 do
+            if not TField(FieldList[I]).CanModify then
+            begin
+              Result := True;
+              break;
+          end;
+        finally
+          FieldList.Free;
+        end;
+      end;
+    end;
   end;
+  EditingColumn(Col, not Result);
 end;
 
 procedure TCustomDBGrid.HeaderSized(IsColumn: Boolean; Index: Integer);
@@ -3230,20 +3288,29 @@
 end;
 
 function TColumn.GetPickList: TStrings;
-var
-  i: Integer;
-  lst: TList;
-  p: PLookupListRec;
 begin
   Result := inherited GetPickList;
-  if (Field<>nil) and Field.Lookup and Field.LookupCache then begin
-    Result.Clear;
-    {$WARNINGS OFF}
-    lst := TLookupListCracker(Field.LookupList).FList;
-    {$WARNINGS ON}
-    for i := 0 to lst.Count - 1 do begin
-      p := PLookupListRec(lst.Items[i]);
-      Result.AddObject(p^.Value, TObject(p));
+  if (Field<>nil) and FField.Lookup then
+  begin
+    if FField.LookupCache then
+      FField.LookupList.ValuesToStrings(Result)
+    else
+    begin
+      Result.Clear;
+      LookupGetBookMark(FField);
+      try
+      with FField.LookupDataSet do
+      begin
+        First;
+        while not EOF do
+        begin
+          Result.Add(FieldbyName(FField.LookupResultField).AsString);
+          Next;
+        end;
+      end;
+      finally
+        LookupGotoBookMark(FField);
+      end;
     end;
   end;
 end;
Index: lcl/grids.pas
===================================================================
--- lcl/grids.pas	(revision 20987)
+++ lcl/grids.pas	(working copy)
@@ -2921,8 +2921,9 @@
 
 function TCustomGrid.CanEditShow: Boolean;
 begin
-  Result := EditingAllowed(FCol) and not (csDesigning in ComponentState)
-            and CanFocus;
+  Result := CanFocus and not (csDesigning in ComponentState);
+  if Result then
+    Result := EditingAllowed(FCol);
 end;
 
 procedure TCustomGrid.Paint;
@@ -6197,7 +6198,7 @@
   Result:=(goEditing in options);
   if Result and (ACol>=0) and (ACol<FColumns.Count) then begin
     C:=ColumnFromGridColumn(ACol);
-    Result:=(C<>nil) and (not C.ReadOnly);
+    Result:=(C<>nil) and (not EditorIsReadOnly);
   end;
 end;
 
@@ -6208,7 +6209,7 @@
   or (not HandleAllocated) then
     Exit;
 
-  if EditingAllowed(FCol) and CanEditShow and
+  if CanEditShow and
      (not FEditorShowing) and (Editor<>nil) and (not Editor.Visible) then
   begin
     {$ifdef dbgGrid} DebugLn('EditorShow [',Editor.ClassName,'] INIT FCol=',IntToStr(FCol),' FRow=',IntToStr(FRow));{$endif}

2009-07-28 12:52

 

dbgridlookupdropdownrevised2.patch (7,240 bytes)
Index: lcl/dbgrids.pas
===================================================================
--- lcl/dbgrids.pas	(revision 20987)
+++ lcl/dbgrids.pas	(working copy)
@@ -40,7 +40,7 @@
 uses
   Classes, SysUtils, FileUtil, DB,
   LCLStrConsts, LCLIntf, LCLProc, LCLType, LMessages, LResources,
-  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes;
+  Controls, StdCtrls, Graphics, Grids, Dialogs, Themes, Variants;
 
 type
   TCustomDbGrid = class;
@@ -363,6 +363,7 @@
     procedure CreateWnd; override;
     procedure DefineProperties(Filer: TFiler); override;
     procedure DefaultDrawCell(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState);
+    procedure DoEditorShow; override;
     procedure DoExit; override;
     function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
     function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
@@ -551,12 +552,6 @@
 
 implementation
 
-type
-  TLookupListCracker = class(TObject)
-  private
-    FList: TList;
-  end;
-
 procedure Register;
 begin
   RegisterComponents('Data Controls',[TDBGrid]);
@@ -671,6 +666,39 @@
   end; // if (Field=nil) or (Field.DisplayWidth=0) ...
 end;
 
+var
+  LookupTmpSetActive: Boolean;
+  LookupBookMark: TBookmark;
+
+procedure LookupGetBookMark(ALookupField: TField);
+begin
+  LookupTmpSetActive := not ALookupField.LookupDataSet.Active;
+  if LookupTmpSetActive then
+    ALookupField.LookupDataSet.Active := True
+  else
+  begin
+    LookupBookMark := ALookupField.LookupDataSet.GetBookmark;
+    ALookupField.LookupDataSet.DisableControls;
+  end;
+end;
+
+procedure LookupGotoBookMark(ALookupField: TField);
+begin
+  if LookupTmpSetActive then
+  begin
+    ALookupField.LookupDataSet.Active := False;
+    LookupTmpSetActive := False;
+  end
+  else
+  try
+    ALookupField.LookupDataSet.GotoBookmark(LookupBookMark);
+    ALookupField.LookupDataSet.FreeBookmark(LookupBookMark);
+  finally
+    ALookupField.LookupDataSet.EnableControls;
+  end;
+end;
+
+
 { TCustomDBGrid }
 
 procedure TCustomDBGrid.OnRecordChanged(Field: TField);
@@ -1033,8 +1061,7 @@
 procedure TCustomDBGrid.UpdateData;
 var
   selField,edField: TField;
-  i: Integer;
-  lst: TList;
+  LookupKeyValues: Variant;
 begin
   // get Editor text and update field content
   if not UpdatingData and (FEditingColumn>-1) and FDatalink.Editing then begin
@@ -1045,20 +1072,26 @@
       {$ifdef dbgDBGrid}
       DebugLn('---> UpdateData: Field[', edField.Fieldname, '(',edField.AsString,')]=', FTempText,' INIT');
       {$endif}
-
       StartUpdating;
       edField.Text := FTempText;
-      if edField.Lookup and edField.LookupCache then begin
-        {$WARNINGS OFF}
-        lst := TLookupListCracker(edField.LookupList).FList;
-        {$WARNINGS ON}
-        for i := 0 to lst.Count - 1 do begin
-          with PLookupListRec(lst[i])^ do
-            if Value = FTempText then begin
-              edField.DataSet.FieldValues[edField.KeyFields] := Key;
-              break;
-             end;
+      if edField.Lookup then
+      begin
+        LookupKeyValues := Null;
+        if edField.LookupCache then
+          LookupKeyValues := edField.LookupList.ValueOfKey(FTempText)
+        else
+        begin
+          LookupGetBookMark(edField);
+          try
+            if edField.LookupDataSet.Locate(edField.LookupResultField,
+              VarArrayOf([FTempText]), []) then
+                LookupKeyValues :=
+                  edField.LookupDataSet.FieldValues[edField.LookupKeyFields];
+          finally
+            LookupGotoBookMark(edField);
+          end;
         end;
+        edField.DataSet.FieldValues[edField.KeyFields] := LookupKeyValues;
       end;
       EndUpdating;
 
@@ -1723,7 +1756,13 @@
   end;
 end;
 
+procedure TCustomDBGrid.DoEditorShow;
+begin
+  inherited;
+  FDataLink.Edit;
+end;
 
+
 procedure TCustomDBGrid.DoOnChangeBounds;
 begin
   BeginUpdate;
@@ -2629,14 +2668,32 @@
 function TCustomDBGrid.EditorIsReadOnly: boolean;
 var
   AField : TField;
+  FieldList: TList;
+  I: Integer;
 begin
   Result := inherited EditorIsReadOnly;
+
   if not Result then begin
     AField := GetFieldFromGridColumn(Col);
     if assigned(AField) then
+    begin
       Result := not AField.CanModify;
-    if not result then
-      Result := not FDataLink.Edit;
+      if not Result and (AField.FieldKind = fkLookup) then
+      begin
+        FieldList := TList.Create;
+        try
+          AField.DataSet.GetFieldList(FieldList, AField.KeyFields);
+          for I := 0 to FieldList.Count-1 do
+            if not TField(FieldList[I]).CanModify then
+            begin
+              Result := True;
+              break;
+          end;
+        finally
+          FieldList.Free;
+        end;
+      end;
+    end;
     EditingColumn(Col, not Result);
   end;
 end;
@@ -3230,20 +3287,29 @@
 end;
 
 function TColumn.GetPickList: TStrings;
-var
-  i: Integer;
-  lst: TList;
-  p: PLookupListRec;
 begin
   Result := inherited GetPickList;
-  if (Field<>nil) and Field.Lookup and Field.LookupCache then begin
-    Result.Clear;
-    {$WARNINGS OFF}
-    lst := TLookupListCracker(Field.LookupList).FList;
-    {$WARNINGS ON}
-    for i := 0 to lst.Count - 1 do begin
-      p := PLookupListRec(lst.Items[i]);
-      Result.AddObject(p^.Value, TObject(p));
+  if (Field<>nil) and FField.Lookup then
+  begin
+    if FField.LookupCache then
+      FField.LookupList.ValuesToStrings(Result)
+    else
+    begin
+      Result.Clear;
+      LookupGetBookMark(FField);
+      try
+      with FField.LookupDataSet do
+      begin
+        First;
+        while not EOF do
+        begin
+          Result.Add(FieldbyName(FField.LookupResultField).AsString);
+          Next;
+        end;
+      end;
+      finally
+        LookupGotoBookMark(FField);
+      end;
     end;
   end;
 end;
Index: lcl/grids.pas
===================================================================
--- lcl/grids.pas	(revision 20987)
+++ lcl/grids.pas	(working copy)
@@ -2921,8 +2921,9 @@
 
 function TCustomGrid.CanEditShow: Boolean;
 begin
-  Result := EditingAllowed(FCol) and not (csDesigning in ComponentState)
-            and CanFocus;
+  Result := CanFocus and not (csDesigning in ComponentState);
+  if Result then
+    Result := EditingAllowed(FCol);
 end;
 
 procedure TCustomGrid.Paint;
@@ -6197,7 +6198,7 @@
   Result:=(goEditing in options);
   if Result and (ACol>=0) and (ACol<FColumns.Count) then begin
     C:=ColumnFromGridColumn(ACol);
-    Result:=(C<>nil) and (not C.ReadOnly);
+    Result:=(C<>nil) and (not EditorIsReadOnly);
   end;
 end;
 
@@ -6208,7 +6209,7 @@
   or (not HandleAllocated) then
     Exit;
 
-  if EditingAllowed(FCol) and CanEditShow and
+  if CanEditShow and
      (not FEditorShowing) and (Editor<>nil) and (not Editor.Visible) then
   begin
     {$ifdef dbgGrid} DebugLn('EditorShow [',Editor.ClassName,'] INIT FCol=',IntToStr(FCol),' FRow=',IntToStr(FRow));{$endif}
@@ -7210,6 +7211,7 @@
 
   FPicklistEditor := TPickListCellEditor.Create(nil);
   FPickListEditor.Name := 'PickListEditor';
+  FPicklistEditor.Style := csDropDownList;
   FPickListEditor.Visible := False;
 
   FButtonStringEditor := TCompositeCellEditor.Create(nil);

Jesus Reyes

2010-11-23 07:09

developer   ~0043387

Thanks, Applied with changes and fixes.

Issue History

Date Modified Username Field Change
2005-08-12 05:19 simon New Issue
2005-08-12 05:19 simon Widgetset => GTK, GTK 2, Win32, Carbon, QT
2005-08-12 12:15 Jesus Reyes Status new => assigned
2005-08-12 12:15 Jesus Reyes Assigned To => Jesus Reyes
2005-08-13 16:02 Vincent Snijders Target => post 1.0
2006-08-04 07:53 Jesus Reyes Status assigned => acknowledged
2008-07-07 13:58 Vincent Snijders Assigned To Jesus Reyes =>
2009-07-25 12:37 Leslie Kaye Note Added: 0029243
2009-07-25 12:37 Leslie Kaye File Added: dbgridlookupdropdown.patch
2009-07-26 19:43 Jesus Reyes Status acknowledged => assigned
2009-07-26 19:43 Jesus Reyes Assigned To => Jesus Reyes
2009-07-27 09:10 Leslie Kaye Note Edited: 0029243
2009-07-28 12:46 Leslie Kaye File Added: dbgridlookupdropdownrevised.patch
2009-07-28 12:52 Leslie Kaye File Added: dbgridlookupdropdownrevised2.patch
2009-07-28 12:53 Leslie Kaye Note Edited: 0029243
2010-03-15 04:06 Jesus Reyes Tag Attached: dbgrids
2010-07-21 14:21 Felipe Monteiro de Carvalho LazTarget post 1.0 => 0.9.30
2010-11-22 19:28 Jesus Reyes Category Widgetset => LCL
2010-11-23 07:09 Jesus Reyes Fixed in Revision => 28425
2010-11-23 07:09 Jesus Reyes Status assigned => resolved
2010-11-23 07:09 Jesus Reyes Fixed in Version => 0.9.29 (SVN)
2010-11-23 07:09 Jesus Reyes Resolution open => fixed
2010-11-23 07:09 Jesus Reyes Note Added: 0043387
2010-11-23 07:09 Jesus Reyes Target Version => 0.9.30
2011-10-07 20:23 Vincent Snijders Relationship added related to 0013174
2011-12-01 11:25 Marc Weustink Status resolved => closed