El misterio de los 200…

Aunque ya he comentado el contenido de esta entrada en el foro de facebook, necesitaba colgar de algún lado las fuentes que había utilizado para revisar el tema y de paso, dar la oportunidad para quien todavía no forme parte del mismo pueda acceder a su contenido, o por lo menos a las cosas que parecen interesantes. Es por esa razón que he acabado añadiéndola.

En este caso concreto, el hilo de comentarios del foro se originaba cuando uno de los compañeros, siguiendo las indicaciones del código publicado en el blog de Jim Tierney, que forma parte de los blogs de Embarcadero,  se extrañaba de que al intentar llenar los items de un componente TListBox (en tiempo de ejecución) desde una fuente de datos (un clientdataset, el numero de items añadidos al TListBox era como máximo igual o menor a 200. Y eso sucedía aun cuando dicha fuente de datos contuviera una cantidad mayor.

Esta es la entrada en la que me he basado para reproducir el problema y comprenderlo.

LiveBindings: Code to create TBindLink and fill a Listbox

Creo que lo mas interesante de estas lineas no es ya la corrección que se ha hecho para solucionar el problema, que solo ha consistido en añadir la linea de asignación en el procedimiento FillList( ) de la unidad UMain.pas

LBindList.BufferCount:= ARecordCount;

sino en destacar el punto que originaba el problema:

constructor TBindScopeDBEnumerator.Create(ABindScope: TCustomBindScopeDB;
  const AMemberName: string; ABufferCount: Integer);
begin
  FBindScope := ABindScope;
  FMemberName := AMemberName;
  FSaveActiveRecord := FBindScope.FDataLink.ActiveRecord;
  FNextRecord := FSaveActiveRecord;
  if ABufferCount > 0 then
    FBindScope.FDataLink.BufferCount := ABufferCount
  else
    FBindScope.FDataLink.BufferCount := 200;  // default to max 200 records in buffer
end;

 Al final, ese era el motivo por el que, no estando definido el valor del campo BufferCount en TBindList, cualquier movimiento hacia adelante de la estructura del enumerador, comprobaba si habia llegado al ultimo registro por lo que aunque existiera una cantida mayor en el dataset, el enlace le indicaba que había llegado al último.

🙂

En fin… cosas de los valores por defecto que supongo que sería fijado por algún motivo, porque de hecho el comentario en la misma linea corrobora que se hizo por alguna razón que ahora mismo ciertamente no comprendo.

Lo mas gracioso de todo es que pienso que esto debería por la forma en que se ha planteado afectar en tiempo de diseño por lo que quizás deberíamos comprobar que al crear una relación TBindList desde el editor de expresiones, en tiempo de diseño, el valor del campo en cuestión es correcto. Podéis hacer la prueba y comentamos en el foro. Para probarlo, simplemente acceded a la propiedad LiveBindings del TListBox y cread un nuevo enlace de tipo TBindList. Y seguidamente definid para la propiedad Format un nuevo item con los valores indicados en la rutina FillList( ). En las pruebas que he hecho, también se reproduce el error.

Tened en cuenta este punto para no caer en el problema.

unit UMain;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, Data.DB, Data.Win.ADODB,
  Datasnap.DBClient, FMX.Layouts, FMX.ListBox, FMX.Bind.Editors, Data.Bind.Components,
  Data.Bind.DBScope, Datasnap.Provider, Data.Bind.EngExt, Fmx.Bind.DBEngExt;

type
  TfrmFillListBox = class(TForm)
    lbxData: TListBox;
    bnFill: TButton;
    bnClear: TButton;
    cdsData: TClientDataSet;
    Conexion: TADOConnection;
    qData: TADOTable;
    dsData: TDataSource;
    dspData: TDataSetProvider;
    cdsDataOrderNo: TFloatField;
    cdsDataCustNo: TFloatField;
    BindScopeDB1: TBindScopeDB;
    lbRecordCount: TLabel;
    lbItemsCount: TLabel;
    BindingsList1: TBindingsList;
    procedure bnClearClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure bnFillClick(Sender: TObject);
  private
    { Private declarations }
    procedure FillLabelRecordCount;
    procedure FillLabelItemsCount;
  public
    { Public declarations }
  end;

var
  frmFillListBox: TfrmFillListBox;

implementation

{$R *.fmx}

//fuente del procedimiento: http://blogs.embarcadero.com/jimtierney
//         http://blogs.embarcadero.com/jimtierney/2011/10/03/31601
//
//  El procedimiento encapsula los pasos para rellenar distintos
//  tipos de controles, siguiendo lo que haria el usuario en tiempo de
//  diseño. Es util para el tiempo de ejecución
//
procedure FillList(AControl: TComponent; const AControlExpression: string;
  ASource: TBaseBindScopeComponent; const ASourceExpression: string; ARecordCount: Integer; const ASourceMemberName: string = '');
var
  LBindList: TBindList;
begin
  LBindList := TBindList.Create(nil);
  try
    // Turn off auto properties.
    LBindList.AutoFill := False;
    LBindList.AutoActivate := False;
    LBindList.ControlComponent := AControl;
    LBindList.SourceComponent := ASource;
    LBindList.SourceMemberName := ASourceMemberName;
    LBindList.BufferCount:= ARecordCount; //<- Linea añadida
    with LBindList.FormatExpressions.AddExpression do
    begin
      SourceExpression := ASourceExpression;
      ControlExpression := AControlExpression;
    end;
    LBindList.FillList;
  finally
    LBindList.Free;
  end;
end;

procedure TfrmFillListBox.bnClearClick(Sender: TObject);
begin
  lbxData.Clear;
  FillLabelItemsCount;
  FillLabelRecordCount;
end;

procedure TfrmFillListBox.bnFillClick(Sender: TObject);
begin
  FillList(lbxData, 'Text', BindScopeDB1, 'AsString', dsData.DataSet.RecordCount, 'OrderNo', );
  FillLabelItemsCount;
  FillLabelRecordCount;
end;

procedure TfrmFillListBox.FillLabelItemsCount;
begin
  lbItemsCount.Text:=  'Items.Count: '+IntToStr(lbxData.Items.Count);
end;

procedure TfrmFillListBox.FillLabelRecordCount;
begin
  lbRecordCount.Text:=  'RecordCount: '+IntToStr(cdsData.RecordCount);
end;

procedure TfrmFillListBox.FormCreate(Sender: TObject);

begin
  Conexion.ConnectionString:= 'Provider=Microsoft.Jet.OLEDB.4.0;'+
                              'Data Source=C:Program FilesCommon FilesCodeGear SharedDatadbdemos.mdb;'+
                              'Persist Security Info=False';
  cdsData.Open;

  FillLabelItemsCount;
  FillLabelRecordCount;
end;

end.

Nada mas por comentar. Si deseáis ver el ejemplo podéis acceder al siguiente enlace:

Descargar fuentes