[fpc-devel] Class field reordering

[Martin Schreiber]

On Monday 16 July 2012 09:35:16 michael.vancanneyt at wisa.be wrote:
>
> > The DB components mainly because MSEgui stores string fields as
> > UnicodeString in datasets and because of the direct data access by index
> > without scrolling.
>
> So you take away the concept of cursor. That is a radical change.

The cursor concept still exists, direct access without scrolling is an 
extension.

> This assumes that all records are always in memory ?
>
In tmsebufdataset yes.

> The string fields should not necessitate the access of private fields, you
> can just always create TWideStringField instances ?

TWideStringField probably can not handle the MSEgui storage of UnicodeString 
with variable length in datasets.
The code of tmsestringfield:

"
[...]
function tmsebufdataset.getmsestringdata(const sender: tmsestringfield;
               out avalue: msestring): boolean;
var
 po1: pointer;
 int1: integer;
begin
 {$ifdef FPC}{$warnings off}{$endif}
 with tfieldcracker(sender) do begin
 {$ifdef FPC}{$warnings on}{$endif}
  if fvalidating then begin
   result:= (fvaluebuffer <> nil) and (foffset and 1 = 0);
   po1:= fvaluebuffer;
  end
  else begin
   result:= getfieldbuffer(sender,po1,int1);
  end;
 end;
 if result then begin
  avalue:= msestring(po1^);
 end
 else begin
  avalue:= '';
 end;
end;
[...]
{ tmsestringfield }

destructor tmsestringfield.destroy;
begin
 if fdsintf <> nil then begin
  fdsintf.fielddestroyed(ifieldcomponent(self));
 end;
 inherited;
end;

function tmsestringfield.HasParent: Boolean;
begin
 result:= dataset <> nil;
end;

function tmsestringfield.assql: string;
begin
 result:= fieldtosql(self);
end;

function tmsestringfield.getasmsestring: msestring;
begin
 if assigned(fgetmsestringdata) then begin
  fgetmsestringdata(self,result);
 end
 else begin
  result:= fieldgetmsestring(self,fdsintf);
 end;
end;

procedure tmsestringfield.setasnullmsestring(const avalue: msestring);
begin
 if avalue = '' then begin
  clear;
 end
 else begin
  setasmsestring(avalue);
 end;
end;

procedure tmsestringfield.setasmsestring(const avalue: msestring);
begin
 if assigned(fsetmsestringdata) then begin
  fsetmsestringdata(self,avalue);
 end
 else begin
  fieldsetmsestring(avalue,self,fdsintf);
 end;
end;

procedure tmsestringfield.readlookup(reader: treader);
begin
 reader.readboolean;
end;

procedure tmsestringfield.defineproperties(filer: tfiler);
begin
 inherited;
 filer.defineproperty('Lookup', at readlookup,nil,false);
end;

{$ifdef hasaswidestring}
function tmsestringfield.getaswidestring: widestring;
begin
 result:= asmsestring;
end;

procedure tmsestringfield.setaswidestring(const avalue: widestring);
begin
 asmsestring:= avalue;
end;
{$endif}

procedure tmsestringfield.setdsintf(const avalue: idsfieldcontroller);
begin
 fdsintf:= avalue;
end;

function tmsestringfield.getinstance: tfield;
begin
 result:= self;
end;

procedure tmsestringfield.Clear;
begin
 setdata(nil);
end;

function tmsestringfield.oldmsestring(out aisnull: boolean): msestring;
var
 statebefore: tdatasetstate;
begin
 statebefore:= tdataset1(dataset).settempstate(dsoldvalue);
 aisnull:= not getdata(nil);
 result:= getasmsestring;
 tdataset1(dataset).restorestate(statebefore);
end;

function tmsestringfield.oldmsestring: msestring;
var
 bo1: boolean;
begin
 result:= curmsestring(bo1);
end;

function tmsestringfield.curmsestring(out aisnull: boolean): msestring;
var
 statebefore: tdatasetstate;
begin
 statebefore:= tdataset1(dataset).settempstate(dscurvalue);
 aisnull:= not getdata(nil);
 result:= getasmsestring;
 tdataset1(dataset).restorestate(statebefore);
end;


function tmsestringfield.curmsestring: msestring;
var
 bo1: boolean;
begin
 result:= curmsestring(bo1);
end;

procedure tmsestringfield.setismsestring(const getter: getmsestringdataty;
           const setter: setmsestringdataty; const acharacterlength: integer;
           const aisftwidestring: boolean);
begin
 fcharacterlength:= acharacterlength;
 size:= acharacterlength;
 fgetmsestringdata:= getter;
 fsetmsestringdata:= setter;
 fisftwidestring:= aisftwidestring;
end;

{$ifdef integergetdatasize}
function tmsestringfield.GetDataSize: integer;
{$else}
function tmsestringfield.GetDataSize: Word;
{$endif}
begin
 if assigned(fgetmsestringdata) then begin
  result:= sizeof(msestring);
 end
 else begin
  result:= inherited getdatasize;
 end;
end;

function tmsestringfield.GetAsString: string;
begin
 if assigned(fgetmsestringdata) then begin
  result:= getasmsestring;
 end
 else begin
  result:= inherited getasstring;
 end;
end;

function tmsestringfield.GetAsVariant: variant;
var
 mstr1: msestring;
begin
 if assigned(fgetmsestringdata) then begin
  if fgetmsestringdata(self,mstr1) then begin
   result:= mstr1;
  end
  else begin
   result:= null;
  end;
 end
 else begin
  result:= inherited getasvariant;
 end;
end;

procedure tmsestringfield.SetAsString(const AValue: string);
begin
 if assigned(fsetmsestringdata) then begin
  fsetmsestringdata(self,avalue);
 end
 else begin
  inherited;
 end;
end;

procedure tmsestringfield.SetVarValue(const AValue: Variant);
begin
 if assigned(fsetmsestringdata) then begin
  fsetmsestringdata(self,avalue);
 end
 else begin
  inherited;
 end;
end;

function tmsestringfield.asoldsql: string;
begin
 result:= fieldtooldsql(self);
end;

function tmsestringfield.getdefaultexpression: msestring;
begin
 if inherited defaultexpression <> fdefaultexpressionbefore then begin
  fdefaultexpressionbefore:= inherited defaultexpression;
  fdefaultexpression:= fdefaultexpressionbefore;
 end;
 result:= fdefaultexpression;
end;

procedure tmsestringfield.setdefaultexpression(const avalue: msestring);
begin
 fdefaultexpression:= avalue;
 try
  fdefaultexpressionbefore:= avalue;
  inherited defaultexpression:= fdefaultexpressionbefore;
 except        //catch conversion exception
  fdefaultexpressionbefore:= '';
  inherited defaultexpression:= '';
 end;
end;

function tmsestringfield.getproviderflags1: providerflags1ty;
begin
 result:= fproviderflags1;
end;

procedure tmsestringfield.change;
begin
 if not (fis_changing in fstate) then begin
  include(fstate,fis_changing);
  try
   inherited;
  finally
   exclude(fstate,fis_changing);
  end;
 end;
end;

procedure tmsestringfield.SetDataset(AValue: TDataset);
begin
 if fieldname = '' then begin
  fieldname:= fieldnamedummy;
  try
   inherited;
  finally
   fieldname:= '';
  end;
 end
 else begin
  inherited;
 end;
end;

" 
> Maybe we need a function to decide the class of a string field ?
>
Probably does not help if the descendant can not access private base fields.

Martin