- Код: Выделить всё
unit btrfields;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TBtrFieldDef }
TBtrFieldType = (
btrAUTOINC2,btrAUTOINC4,btrBFLOAT4,btrBFLOAT8,btrBFLOAT,btrBIGINT,btrBIT,btrBLOB,btrCHAR,
btrCLOB,btrCURRENCY,btrDATE,btrDATETIME,btrDECIMAL,btrDOUBLE,btrFLOAT4,btrFLOAT8,btrGUID,
btrIDENTITY,btrINTEGER1,btrINTEGER2,btrINTEGER4,btrINTEGER8,btrINTEGER,btrLOGICAL,btrLOGICAL2,
btrLONGVARBINARY,btrLONGVARCHAR,btrMONEY,btrNUMERIC,btrNUMERICSA,btrNUMERICSLB,btrNUMERICSLS,
btrNUMERICSTB,btrNUMERICSTS,btrREAL,btrSMALLIDENTITY,btrSMALLINT,btrSTRING,btrTIME,btrTIMESTAMP,
btrTINYINT,btrUBIGINT,btrUINTEGER,btrUNIQUEIDENTIFIER,btrUNSIGNED_BINARY,btrUNSIGNED1_BINARY,
btrUNSIGNED2_BINARY,btrUNSIGNED4_BINARY,btrUNSIGNED8_BINARY,btrUSMALLINT,btrUTINYINT,btrVARCHAR,
btrWSTRING,btrWSZSTRING,btrWZSTRING,btrZSTRING
);
TBtrFieldDef = class(TCollectionItem)
private
FFieldName: string;
FFieldType: TBtrFieldType;
FSize: Integer;
FPrecision: Integer;
procedure SetSize(lSize: Integer);
procedure SetPrecision(lPrecision: Integer);
procedure SetFieldType(lFieldType: TBtrFieldType);
protected
public
FieldValue:string;
constructor Create(ACollection: TCollection); override;
destructor Destroy; override;
procedure SetDefaultSize;
published
property FieldName: string read FFieldName write FFieldName;
property FieldType: TBtrFieldType read FFieldType write SetFieldType;
property Size: Integer read FSize write SetSize;
property Precision: Integer read FPrecision write SetPrecision;
property Value:string read FieldValue write FieldValue;
end;
{ TBtrFieldDefs }
TBtrFieldDefs = class(TCollection)
private
FOwner: TPersistent;
function GetItem(Idx: Integer): TBtrFieldDef;
protected
function GetOwner: TPersistent; override;
public
constructor Create(BOwner: TPersistent);
{$ifdef SUPPORT_DEFAULT_PARAMS}
procedure Add(const Name: string; DataType: TBtrFieldType; Size: Integer = 0);
{$else}
procedure Add(const Name: string; DataType: TBtrFieldType; Size: Integer);
{$endif}
function AddFieldDef: TBtrFieldDef;
property Items[Idx: Integer]: TBtrFieldDef read GetItem;
//function FieldByName(FName)
end;
implementation
procedure TBtrFieldDef.SetDefaultSize;
begin
// choose default values for variable size fields
case FFieldType of
btrINTEGER1, btrUNSIGNED1_BINARY, btrLOGICAL, btrBIT, btrTINYINT, btrUTINYINT :
begin
FSize := 1;
FPrecision := 0;
end;
btrAUTOINC2, btrINTEGER2, btrUNSIGNED2_BINARY, btrLOGICAL2, btrSMALLIDENTITY, btrSMALLINT, btrUSMALLINT :
begin
FSize := 2;
FPrecision := 0;
end;
btrAUTOINC4, btrBFLOAT4, btrDATE, btrFLOAT4, btrINTEGER4, btrTIME, btrUNSIGNED4_BINARY, btrIDENTITY,
btrREAL, btrINTEGER, btrUINTEGER :
begin
FSize := 4;
FPrecision := 0;
end;
btrBFLOAT8, btrCURRENCY, btrDATETIME, btrFLOAT8, btrINTEGER8, btrTIMESTAMP, btrUNSIGNED8_BINARY,
btrDOUBLE, btrBIGINT, btrUBIGINT :
begin
FSize := 8;
FPrecision := 0;
end;
//&&&!!!!!!????
btrGUID, btrUNIQUEIDENTIFIER :
begin
FSize := 16;
FPrecision := 0;
end;
btrNUMERIC, btrNUMERICSA, btrNUMERICSLB, btrNUMERICSLS, btrNUMERICSTB, btrNUMERICSTS :
begin
FSize := 37;
FPrecision := 0;
end;
btrDECIMAL :
begin
FSize := 64;
FPrecision := 0;
end;
btrSTRING, btrZSTRING, btrVARCHAR, btrCHAR :
begin
FSize := 8000;
FPrecision := 0;
end;
end;
end;
function TBtrFieldDefs.GetItem(Idx: Integer): TBtrFieldDef;
begin
Result := TBtrFieldDef(inherited GetItem(Idx));
end;
constructor TBtrFieldDefs.Create(BOwner: TPersistent);
begin
inherited Create(TBtrFieldDef);
FOwner := BOwner;
end;
function TBtrFieldDefs.AddFieldDef: TBtrFieldDef;
begin
Result := TBtrFieldDef(inherited Add);
end;
function TBtrFieldDefs.GetOwner: TPersistent; {override;}
begin
Result := FOwner;
end;
procedure TBtrFieldDefs.Add(const Name: string; DataType: TBtrFieldType; Size: Integer);
var
FieldDef: TBtrFieldDef;
begin
FieldDef := AddFieldDef;
FieldDef.FieldName := Name;
FieldDef.FieldType := DataType;
if Size <> 0 then
FieldDef.Size := Size;
end;
constructor TBtrFieldDef.Create(ACollection: TCollection); {virtual}
begin
inherited;
FPrecision := 0;
end;
destructor TBtrFieldDef.Destroy; {override}
begin
inherited;
end;
procedure TBtrFieldDef.SetFieldType(lFieldType: TBtrFieldType);
begin
FFieldType := lFieldType;
SetDefaultSize;
end;
procedure TBtrFieldDef.SetSize(lSize: Integer);
begin
FSize := lSize;
end;
procedure TBtrFieldDef.SetPrecision(lPrecision: Integer);
begin
FPrecision := lPrecision;
end;
end.
В основном код ещё сырой и не отлаженный. На данный момент меня интересует реализация метода
- Код: Выделить всё
TBtrFieldDefs.Add
При попытке его вызова
- Код: Выделить всё
var
BTR:TBTRFielddefs;
BTR.Add('Test', btrChar, 1);
Возникает ошибка в строке
- Код: Выделить всё
Result := TBtrFieldDef(inherited Add);
В чём может быть ошибка, куда копать?
