此代码支持 Delphi 2007+，使用 QJSON 做为序列化的支持库。你可以自己改为使用其它的 JSON库（注：此文写法未完善，仅为示意）。
uses typinfo, qjson, qstring;
type
TComponentJsonHelper = class helper for TComponent
protected
procedure DoSaveToJson(AStream: TStream; AJson: TQJson);
procedure DoLoadFromJson(AParent: TComponent; AJson: TQJson;
ALoaded: TList);
public
procedure SaveToJson(AJson: TQJson);
procedure LoadFromJson(AJson: TQJson);
end;
{ TComponentJsonHelper }
procedure TComponentJsonHelper.LoadFromJson(AJson: TQJson);
var
ALoaded: TList;
I: Integer;
begin
ALoaded := TList.Create;
GlobalNameSpace.BeginWrite;
try
DoLoadFromJson(nil, AJson, ALoaded);
for I := 0 to ALoaded.Count - 1 do
TComponent(ALoaded[I]).Loaded;
Loaded;
finally
GlobalNameSpace.EndWrite;
end;
end;
procedure TComponentJsonHelper.DoLoadFromJson(AParent: TComponent;
AJson: TQJson; ALoaded: TList);
type
PComponentState = ^TComponentState;
var
AChildPos: Integer;
AList: TQJson;
ACompState: PComponentState;
function JsonToSet(AValues: TQJson): String;
var
I: Integer;
begin
Result := '[';
for I := 0 to AValues.Count - 1 do
begin
if I = 0 then
Result := AValues[I].AsString
else
Result := Result + ',' + AValues[I].AsString;
end;
Result := Result + ']';
end;
function PropByPath(var Instance: TObject; APath: String): PPropInfo;
var
AName: String;
APos: Integer;
begin
AName := DecodeTokenW(APath, '.', #0, true, true);
Result := GetPropInfo(Instance, AName);
if (Length(APath) > 0) then
begin
if (Result.PropType^.Kind = tkClass) then
begin
Instance := TObject(GetOrdProp(Instance, Result));
if Assigned(Instance) then
Result := PropByPath(Instance, APath)
else
Result := nil;
end
else
Result := nil;
end;
end;
procedure LoadProps(ARootInstance: TObject; AProps: TQJson);
var
I: Integer;
AProp: PPropInfo;
APropJson: TQJson;
AInstance: TObject;
begin
if not Assigned(ARootInstance) then
Exit;
for I := 0 to AProps.Count - 1 do
begin
APropJson := AProps[I];
AInstance := ARootInstance;
AProp := PropByPath(AInstance, APropJson.Name);
if Assigned(AProp) then
begin
case AProp.PropType^.Kind of
tkInteger:
SetOrdProp(AInstance, AProp, APropJson.AsInteger);
tkChar, tkWChar:
begin
if APropJson.IsString then
SetOrdProp(AInstance, AProp, Ord(PChar(APropJson.AsString)^))
else
SetOrdProp(AInstance, AProp, APropJson.AsInteger);
end;
tkEnumeration:
SetEnumProp(AInstance, AProp, APropJson.AsString);
tkFloat:
SetFloatProp(AInstance, AProp, APropJson.AsFloat);
tkString, tkLString, tkWString, tkUString:
SetStrProp(AInstance, AProp, APropJson.AsString);
tkSet:
SetSetProp(AInstance, AProp, JsonToSet(APropJson));
tkClass:
LoadProps(Pointer(GetOrdProp(AInstance, AProp)), APropJson);
tkVariant:
SetVariantProp(AInstance, AProp, APropJson.AsVariant);
// tkArray,tkDynArray,tkRecord, tkInterface,tkClassRef,tkPointer, tkProcedure
tkInt64:
SetInt64Prop(AInstance, AProp, APropJson.AsInt64);
end;
end;
end;
end;
procedure LoadChildren(AObjects: TQJson);
var
I: Integer;
AChildComp: TComponent;
AClass: TClass;
AClassName: String;
begin
for I := 0 to AObjects.Count - 1 do
begin
AClassName := AObjects[I].ValueByName('ClassName', '');
AClass := FindClass(AClassName);
if AClass = TComponent then
begin
if Assigned(Owner) then
AChildComp := TComponentClass(AClass).Create(Owner)
else
AChildComp := TComponentClass(AClass).Create(Self);
AChildComp.DoLoadFromJson(Self, AObjects[I], ALoaded);
end
else
raise EClassNotFound.CreateFmt('Class %s not found', [AClassName]);
end;
end;
begin
ACompState := @ComponentState;
ACompState^ := ACompState^ + [csLoading, csReading];
try
Name := AJson.ValueByName('Name', '');
if AJson.HasChild('Props', AList) then
LoadProps(Self, AList);
if AJson.HasChild('Children', AList) then
LoadChildren(AList);
finally
ACompState^ := ACompState^ - [csLoading, csReading];
if Assigned(ALoaded) then
ALoaded.Add(Self);
end;
if Assigned(AParent) then
begin
AChildPos := AJson.IntByName('ChildPos', -1);
if AChildPos > 0 then
AParent.SetChildOrder(Self, AChildPos);
end;
end;
procedure TComponentJsonHelper.DoSaveToJson(AStream: TStream; AJson: TQJson);
var
Reader: TReader;
ObjectName, PropName: string;
procedure ConvertValue(AItem: TQJson); forward;
procedure ConvertHeader(AItem: TQJson);
var
ClassName: string;
Flags: TFilerFlags;
Position: Integer;
begin
Reader.ReadPrefix(Flags, Position);
ClassName := Reader.ReadStr;
ObjectName := Reader.ReadStr;
AItem.Add('Name').AsString := Name;
AItem.Add('ClassName').AsString := ClassName;
if ffInherited in Flags then
AItem.Add('InstanceType').AsString := 'inherited'
else if ffInline in Flags then
AItem.Add('InstanceType').AsString := 'inline'
else
AItem.Add('InstanceType').AsString := 'object';
if ffChildPos in Flags then
AItem.Add('ChildPos').AsInteger := Position;
end;
procedure ConvertBinary(AItem: TQJson);
var
Count: Integer;
Buffer: TBytes;
begin
Reader.ReadValue;
Reader.Read(Count, SizeOf(Count));
SetLength(Buffer, Count);
Reader.Read(Buffer, Count);
AItem.AsBytes := Buffer;
end;
procedure ConvertProperty(AItem: TQJson); forward;
procedure ConvertValue(AItem: TQJson);
const
LineLength = 64;
var
S: String;
begin
case Reader.NextValue of
vaList:
begin
Reader.ReadValue;
AItem.DataType := jdtArray;
while not Reader.EndOfList do
ConvertValue(AItem.Add);
end;
vaInt8, vaInt16, vaInt32:
AItem.AsInteger := Reader.ReadInteger;
vaExtended, vaDouble:
AItem.AsFloat := Reader.ReadFloat;
vaSingle:
AItem.AsFloat := Reader.ReadSingle;
vaCurrency:
AItem.AsFloat := Reader.ReadCurrency;
vaDate:
AItem.AsDateTime := Reader.ReadDate;
vaWString, vaUTF8String, vaString, vaLString:
AItem.AsString := Reader.ReadString;
vaIdent:
AItem.AsString := Reader.ReadIdent;
vaFalse:
AItem.AsBoolean := False;
vaTrue:
AItem.AsBoolean := true;
vaNil, vaNull:
AItem.ResetNull;
vaBinary:
ConvertBinary(AItem);
vaSet:
begin
Reader.ReadValue;
AItem.DataType := jdtArray;
while true do
begin
S := Reader.ReadStr;
if S = '' then
Break;
AItem.Add.AsString := S;
end;
end;
vaCollection:
begin
Reader.ReadValue;
AItem.DataType := jdtObject;
while not Reader.EndOfList do
begin
with AItem.AddArray('items') do
begin
if Reader.NextValue in [vaInt8, vaInt16, vaInt32] then
ConvertValue(Add);
end;
Reader.CheckValue(vaList);
while not Reader.EndOfList do
ConvertProperty(AItem);
end;
Reader.ReadListEnd;
end;
vaInt64:
AItem.AsInt64 := Reader.ReadInt64;
else
raise EReadError.CreateFmt('Can not read %s property %s',
[ObjectName, PropName]);
end;
end;
procedure ConvertProperty(AItem: TQJson);
begin
ConvertValue(AItem.Add(Reader.ReadStr));
end;
procedure ConvertObject(AItem: TQJson);
var
AObject, AList: TQJson;
begin
ConvertHeader(AItem);
AList := AItem.Add('Props');
while not Reader.EndOfList do
ConvertProperty(AList);
Reader.ReadListEnd;
AList := AItem.Add('Children');
AList.DataType := jdtObject;
while not Reader.EndOfList do
ConvertObject(AList);
Reader.ReadListEnd;
end;
begin
Reader := TReader.Create(AStream, 4096);
try
Reader.ReadSignature;
ConvertObject(AJson);
finally
Reader.Free;
end;
end;
procedure TComponentJsonHelper.SaveToJson(AJson: TQJson);
var
AStream: TMemoryStream;
begin
AStream := TMemoryStream.Create;
try
AStream.WriteComponent(Self);
AStream.Position := 0;
DoSaveToJson(AStream, AJson);
finally
FreeAndNil(AStream);
end;
end;使用示例：
procedure TForm1.Button1Click(Sender: TObject);
var
AJson: TQJson;
begin
AJson := AcquireJson;
try
LabeledEdit1.SaveToJson(AJson);
ShowMessage(AJson.AsJson);
LabeledEdit1.EditLabel.Caption := 'Hello';
LabeledEdit1.Text := '';
Button2.Caption:='Json Converted';
ShowMessage('from json');
LabeledEdit1.LoadFromJson(AJson);
finally
ReleaseJson(AJson);
end;
end;如上面的示例，由于写成了 class helper，所以保存到 Json 里，直接调用组件实例的 SaveToJson 就可以了，而从 Json 中恢复则直接调用组件实例的 LoadFromJson 就可以了。
上面的代码加入 C++Builder，然后可以直接引用。