[fpc-devel] Class field reordering
Martin Schreiber
mse00000 at gmail.com
Mon Jul 16 16:40:41 CEST 2012
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
More information about the fpc-devel
mailing list