sign, имхо несколько тяжеловесно, не?
ТС хотел
...Нужно чтобы шустро работало, и без заморочек в коде, типа указателя на данные в куче.
Например если А и В оба типа TElement можно было бы сделать красиво A:=B при этом данные из экземпляра В скопировались в экземпляр А;
а тут ручное выделение/освобождение памяти, полное копирование строк?
serbod, +1, я как-то упустил массив из внимания.
VarArrayCreate, хмм, правильно ли я понимаю, даже если массив динамический, его все равно придется в структуру полностью копировать?
Добавлено спустя 2 часа 57 минут 34 секунды:Во, наваял
,
правда ценой оверхеда в два указателя и требует версии компилятора не меньше 3.2.0:
Код: Выделить всё
unit vdata;
{$mode objfpc}{$H+}
{$modeswitch advancedrecords}
interface
uses
SysUtils;
type
TMyData = record
public
type
TKind = (knEmpty, knInt64, knCurrency, knWideString, knBytes);
strict private
FKind: TKind;
FBuffer: record
case Boolean of
False: (Int: Int64);
True: (Cur: Currency);
end;
FStr: widestring;
FBytes: TBytes;
procedure Release(aNewKind: TKind);
procedure CheckMismatch(aReqKind: TKind);
class operator Initialize(var d: TMyData);
public
class operator := (aValue: Int64): TMyData;
class operator := (aValue: Currency): TMyData;
class operator := (const aValue: widestring): TMyData;
class operator := (const aValue: TBytes): TMyData;
class operator := (constref aData: TMyData): Int64;
class operator := (constref aData: TMyData): Currency;
class operator := (constref aData: TMyData): widestring;
class operator := (constref aData: TMyData): TBytes;
property Kind: TKind read FKind;
end;
implementation
procedure TMyData.Release(aNewKind: TKind);
begin
if aNewKind <> Kind then
begin
case Kind of
knWideString: FStr := '';
knBytes: FBytes := nil;
else
end;
FKind := aNewKind;
end;
end;
procedure TMyData.CheckMismatch(aReqKind: TKind);
begin
if (Kind <> knEmpty) and (aReqKind <> Kind) then
raise EInvalidCast.Create('Data type mismatch');
end;
class operator TMyData.Initialize(var d: TMyData);
begin
d.FKind := knEmpty;
end;
class operator TMyData.:=(aValue: Int64): TMyData;
begin
Result.Release(knInt64);
Result.FBuffer.Int := aValue;
end;
class operator TMyData.:=(aValue: Currency): TMyData;
begin
Result.Release(knCurrency);
Result.FBuffer.Cur := aValue;
end;
class operator TMyData.:=(const aValue: widestring): TMyData;
begin
Result.Release(knWideString);
Result.FStr := aValue;
end;
class operator TMyData.:=(const aValue: TBytes): TMyData;
begin
Result.Release(knBytes);
Result.FBytes := aValue;
end;
class operator TMyData.:=(constref aData: TMyData): Int64;
begin
if aData.Kind = knEmpty then
exit(0);
aData.CheckMismatch(knInt64);
Result := aData.FBuffer.Int;
end;
class operator TMyData.:=(constref aData: TMyData): Currency;
begin
if aData.Kind = knEmpty then
exit(0);
aData.CheckMismatch(knCurrency);
Result := aData.FBuffer.Cur;
end;
class operator TMyData.:=(constref aData: TMyData): widestring;
begin
if aData.Kind = knEmpty then
exit('');
aData.CheckMismatch(knWideString);
Result := aData.FStr;
end;
class operator TMyData.:=(constref aData: TMyData): TBytes;
begin
if aData.Kind = knEmpty then
exit(nil);
aData.CheckMismatch(knBytes);
Result := aData.FBytes;
end;
end.
тест:
Код: Выделить всё
program vr_test;
{$mode objfpc}{$H+}
uses
heaptrc, SysUtils, typinfo, vdata;
type
TMyElem = record
Name: string;
Data: TMyData;
end;
var
Elem1, Elem2: TMyElem;
procedure Test;
var
LocElem: TMyElem;
WStr: widestring = '';
b: TBytes = nil;
begin
LocElem.Name := 'My element cool name';
WriteLn('LocElem.Name = ', LocElem.Name);
WriteLn('test assign Int64:');
//-------------------------------------------------
LocElem.Data := 1234567890157;
//-------------------------------------------------
WriteLn(' LocElem.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(LocElem.Data.Kind)));
WriteLn(' LocElem.Data = ', Int64(LocElem.Data));
WriteLn('test assign Currency:');
//-------------------------------------------------
LocElem.Data := 12345678901.0175;
//-------------------------------------------------
WriteLn(' LocElem.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(LocElem.Data.Kind)));
WriteLn(' LocElem.Data = ', CurrToStr(LocElem.Data));
Elem1 := LocElem;
LocElem.Name := 'Another cool name';
WriteLn('test assign widestring:');
//-------------------------------------------------
LocElem.Data := Copy(ParamStr(0), 1, Length(ParamStr(0)));
//-------------------------------------------------
WriteLn(' LocElem.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(LocElem.Data.Kind)));
WriteLn(' LocElem.Data = ', widestring(LocElem.Data));
WriteLn('test record copy:');
//-------------------------------------------------
Elem2 := LocElem;
//-------------------------------------------------
WriteLn(' Elem2.Name = ', Elem2.Name);
WriteLn(' Elem2.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem2.Data.Kind)));
WriteLn(' Elem2.Data = ', widestring(Elem2.Data));
WriteLn('test assign bytes:');
//-------------------------------------------------
LocElem.Data := [1, 2, 3, 5, 157, 211];
//-------------------------------------------------
WriteLn(' LocElem.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(LocElem.Data.Kind)));
WriteLn(' LocElem.Data.Length = ', Length(TBytes(LocElem.Data)));
WriteLn('test assign to bytes:');
//-------------------------------------------------
b := LocElem.Data;
//-------------------------------------------------
WriteLn(' b.Length = ', Length(b));
WriteLn(' b[High(b)] = ', b[High(b)]);
WriteLn('test type mismatch:');
try
WStr := LocElem.Data;
WriteLn(' WStr = ', WStr);
except
on e: Exception do
WriteLn(' raised exception ', e.ClassName, ' with message "', e.Message,'"');
end;
end;
begin
SetHeapTraceOutput('heap.log');
Elem1.Name := 'Unnamed';
Elem1.Data := 'test string';
WriteLn('global Elem1 is:');
WriteLn(' Name = ', Elem1.Name);
WriteLn(' Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem1.Data.Kind)));
WriteLn(' Data = ', widestring(Elem1.Data));
WriteLn('global Elem2 is:');
WriteLn(' Name = ', Elem2.Name);
WriteLn(' Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem2.Data.Kind)));
WriteLn(' Data = ', CurrToStr(Elem2.Data));
Test;
WriteLn('global Elem1 is:');
WriteLn(' Name = ', Elem1.Name);
WriteLn(' Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem1.Data.Kind)));
WriteLn(' Data = ', CurrToStr(Elem1.Data));
WriteLn('global Elem2 is:');
WriteLn(' Name = ', Elem2.Name);
WriteLn(' Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem2.Data.Kind)));
WriteLn(' Data = ', widestring(Elem2.Data));
ReadLn;
end.
Не понял, как версия 3.2 компилятора когда только 3.1.х в разработке а 3.0.4 релиз последней???
