Как сделать что бы всё что записано в Treeview ,edit, memo сохранилось в файл .json по нажатию кнопки
Как сделать что бы всё что записано в Treeview ,edit, memo сохранилось в файл .json по нажатию кнопки
Прям всё-всё? Включая все объекты-предки и их публичные свойства?
Цитата: mfender
Прям всё-всё? Включая все объекты-предки и их публичные свойства?
да всё всё
Код:
unit helper.json;
interface
uses System.json, RTTI, TypInfo, SysUtils, System.Classes;
type
Hj = class
class function SerializeObject(var AObject: TObject;
PropsOnly: array of string; Deep: Integer = 1): TJSONObject;
class function SplitStr(Str: string; Delimiter: Char = ','): TJSONValue;
class function InArray(Arr: array of string; Value: string;
out Res: Variant): Boolean;
end;
var
{ Текущая глубина сканирования }
DeepScan: Integer;
implementation
{ Hj }
class function Hj.SerializeObject(var AObject: TObject;
PropsOnly: array of string; Deep: Integer = 1): TJSONObject;
{ В этом методе попытаемся пройти по всем публичным свойствам объекта AObject,
и сериализовать их.
Необязательный параметр PropsOnly пусть будет списком
свойств, которые нужно получить на выхлопе.
Например: ['name', 'items', 'align'].
Параметр Deep назначает глубину сканирования инкапсулированных объектов.
Не рекомендуется глубоко ходить, ибо можно уйти в бесконечность. }
var
RC: TRttiContext;
P: TRttiProperty;
Ident: Variant;
Bfr: TJSONValue;
Str: string;
Tmp: TObject;
begin
{ Результирующий выхлоп. Он будет всегда, даже если ничего не сериализуется. }
Result := TJSONObject.Create;
{ Создаём real-time контекст объекта }
RC := TRttiContext.Create;
try
{ Гоним в цикле по всем подряд свойствам контекста }
for P in RC.GetType(AObject.ClassInfo).GetProperties do
begin
try
{ Тут мы проверяем, есть ли текущее свойство объекта в списке PropsOnly,
и что-то делаем только если оно есть, или список пуст.
Иначе уходим на новую итерацию. }
if (Length(PropsOnly) = 0) or
((Length(PropsOnly) > 0) and InArray(PropsOnly, P.Name, Ident)) then
begin
{ Самое интересное: в зависимости от типа свойства
нужно создать соответствующий JSON-тип }
// Result.AddPair(P.Name, TRttiEnumerationType.GetName<TTypeKind>(P.PropertyType.TypeKind));
// Continue;
case P.PropertyType.TypeKind of
tkClass:
begin
Inc(DeepScan);
if DeepScan <= Deep then
begin
Tmp := P.GetValue(AObject).AsObject;
Result.AddPair(P.Name, Hj.SerializeObject(Tmp, PropsOnly));
end;
Dec(DeepScan);
end;
tkEnumeration:
{ Enumeration нужно привести к строкам }
begin
if P.PropertyType.BaseType = TypeInfo(Boolean) then
{ Булевые значения - тоже Enumeration, поэтому нужно проверить
всякое значение, не является ли оно булем... }
begin
if P.GetValue(AObject).AsBoolean then
Bfr := TJSONTrue.Create
else
Bfr := TJSONFalse.Create;
end
else
{ ...иначе чёрт с ним, пишем строку. }
Bfr := TJSONString.Create
(GetEnumProp(AObject, GetPropInfo(P.PropertyType.Handle,
P.Name)));
Result.AddPair(P.Name, Bfr);
end;
tkSet:
begin
{ В Set'ах нужно значения преобразовать в массив. Разобъём строку
и уложим в массив функцией SplitStr() }
Str := GetSetProp(AObject, P.Name);
Result.AddPair(P.Name, SplitStr(Str) as TJSONArray);
end;
tkString, tkLString, tkWString, tkUString:
{ Строковое значение - TJSONString }
begin
Bfr := TJSONString.Create(P.GetValue(AObject).AsString);
Result.AddPair(P.Name, Bfr);
end;
tkInteger:
{ Целочисленный тип - TJSONNumber }
begin
Bfr := TJSONNumber.Create(P.GetValue(AObject).AsInteger);
Result.AddPair(P.Name, Bfr);
end;
tkInt64:
{ То же что и Integer, только Int64 }
begin
Bfr := TJSONNumber.Create(P.GetValue(AObject).AsInt64);
Result.AddPair(P.Name, Bfr);
end;
tkFloat:
begin
{ JSON не подразумевает чисел с плавающей точкой, и они записываются в виде строк }
Bfr := TJSONString.Create(P.GetValue(AObject).AsString);
Result.AddPair(P.Name, Bfr);
end;
end;
end;
except
end;
end;
finally
RC.Free;
end;
end;
class function Hj.SplitStr(Str: string; Delimiter: Char = ','): TJSONValue;
var
S: TStrings;
I: Integer;
begin
Result := TJSONArray.Create;
try
S := TStringList.Create;
S.Delimiter := Delimiter;
S.StrictDelimiter := True;
S.DelimitedText := Str;
for I := 0 to Pred(S.Count) do
(Result as TJSONArray).Add(S[I]);
finally
FreeAndNil(S);
end;
end;
class function Hj.InArray(Arr: array of string; Value: string;
out Res: Variant): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(Arr) to High(Arr) do
if (Arr[I] = Value) then
begin
Result := True;
Res := Value;
Break;
end;
end;
end.
interface
uses System.json, RTTI, TypInfo, SysUtils, System.Classes;
type
Hj = class
class function SerializeObject(var AObject: TObject;
PropsOnly: array of string; Deep: Integer = 1): TJSONObject;
class function SplitStr(Str: string; Delimiter: Char = ','): TJSONValue;
class function InArray(Arr: array of string; Value: string;
out Res: Variant): Boolean;
end;
var
{ Текущая глубина сканирования }
DeepScan: Integer;
implementation
{ Hj }
class function Hj.SerializeObject(var AObject: TObject;
PropsOnly: array of string; Deep: Integer = 1): TJSONObject;
{ В этом методе попытаемся пройти по всем публичным свойствам объекта AObject,
и сериализовать их.
Необязательный параметр PropsOnly пусть будет списком
свойств, которые нужно получить на выхлопе.
Например: ['name', 'items', 'align'].
Параметр Deep назначает глубину сканирования инкапсулированных объектов.
Не рекомендуется глубоко ходить, ибо можно уйти в бесконечность. }
var
RC: TRttiContext;
P: TRttiProperty;
Ident: Variant;
Bfr: TJSONValue;
Str: string;
Tmp: TObject;
begin
{ Результирующий выхлоп. Он будет всегда, даже если ничего не сериализуется. }
Result := TJSONObject.Create;
{ Создаём real-time контекст объекта }
RC := TRttiContext.Create;
try
{ Гоним в цикле по всем подряд свойствам контекста }
for P in RC.GetType(AObject.ClassInfo).GetProperties do
begin
try
{ Тут мы проверяем, есть ли текущее свойство объекта в списке PropsOnly,
и что-то делаем только если оно есть, или список пуст.
Иначе уходим на новую итерацию. }
if (Length(PropsOnly) = 0) or
((Length(PropsOnly) > 0) and InArray(PropsOnly, P.Name, Ident)) then
begin
{ Самое интересное: в зависимости от типа свойства
нужно создать соответствующий JSON-тип }
// Result.AddPair(P.Name, TRttiEnumerationType.GetName<TTypeKind>(P.PropertyType.TypeKind));
// Continue;
case P.PropertyType.TypeKind of
tkClass:
begin
Inc(DeepScan);
if DeepScan <= Deep then
begin
Tmp := P.GetValue(AObject).AsObject;
Result.AddPair(P.Name, Hj.SerializeObject(Tmp, PropsOnly));
end;
Dec(DeepScan);
end;
tkEnumeration:
{ Enumeration нужно привести к строкам }
begin
if P.PropertyType.BaseType = TypeInfo(Boolean) then
{ Булевые значения - тоже Enumeration, поэтому нужно проверить
всякое значение, не является ли оно булем... }
begin
if P.GetValue(AObject).AsBoolean then
Bfr := TJSONTrue.Create
else
Bfr := TJSONFalse.Create;
end
else
{ ...иначе чёрт с ним, пишем строку. }
Bfr := TJSONString.Create
(GetEnumProp(AObject, GetPropInfo(P.PropertyType.Handle,
P.Name)));
Result.AddPair(P.Name, Bfr);
end;
tkSet:
begin
{ В Set'ах нужно значения преобразовать в массив. Разобъём строку
и уложим в массив функцией SplitStr() }
Str := GetSetProp(AObject, P.Name);
Result.AddPair(P.Name, SplitStr(Str) as TJSONArray);
end;
tkString, tkLString, tkWString, tkUString:
{ Строковое значение - TJSONString }
begin
Bfr := TJSONString.Create(P.GetValue(AObject).AsString);
Result.AddPair(P.Name, Bfr);
end;
tkInteger:
{ Целочисленный тип - TJSONNumber }
begin
Bfr := TJSONNumber.Create(P.GetValue(AObject).AsInteger);
Result.AddPair(P.Name, Bfr);
end;
tkInt64:
{ То же что и Integer, только Int64 }
begin
Bfr := TJSONNumber.Create(P.GetValue(AObject).AsInt64);
Result.AddPair(P.Name, Bfr);
end;
tkFloat:
begin
{ JSON не подразумевает чисел с плавающей точкой, и они записываются в виде строк }
Bfr := TJSONString.Create(P.GetValue(AObject).AsString);
Result.AddPair(P.Name, Bfr);
end;
end;
end;
except
end;
end;
finally
RC.Free;
end;
end;
class function Hj.SplitStr(Str: string; Delimiter: Char = ','): TJSONValue;
var
S: TStrings;
I: Integer;
begin
Result := TJSONArray.Create;
try
S := TStringList.Create;
S.Delimiter := Delimiter;
S.StrictDelimiter := True;
S.DelimitedText := Str;
for I := 0 to Pred(S.Count) do
(Result as TJSONArray).Add(S[I]);
finally
FreeAndNil(S);
end;
end;
class function Hj.InArray(Arr: array of string; Value: string;
out Res: Variant): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(Arr) to High(Arr) do
if (Arr[I] = Value) then
begin
Result := True;
Res := Value;
Break;
end;
end;
end.
Поэтому лучше всего знать что именно нужно получить в JSON'е. Я предположил, что для пресловутых TEdit, TMemo и TTreeView нужно имя, текст и узлы. Поэтому лучше немного расширить компоненты. Вот так:
Код:
unit vcl.serialized;
interface
uses System.Classes, System.SysUtils, vcl.StdCtrls, vcl.ComCtrls, System.json;
type
IJsonSerialized = interface
function _GetJson: TJSONValue;
property json: TJSONValue read _GetJson;
end;
TjEdit = class(TEdit, IJsonSerialized)
private
function _GetJson: TJSONValue;
public
property json: TJSONValue read _GetJson;
end;
TjMemo = class(TMemo, IJsonSerialized)
private
function _GetJson: TJSONValue;
public
property json: TJSONValue read _GetJson;
end;
TjTreeView = class(TTreeView, IJsonSerialized)
private
function _GetJson: TJSONValue;
procedure _Serialize(ANode: TTreeNode; var ANodeJson: TJSONValue);
public
property json: TJSONValue read _GetJson;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Json Serialized', [TjEdit, TjMemo, TjTreeView]);
end;
{ TjEdit }
function TjEdit._GetJson: TJSONValue;
begin
Result := TJSONObject.Create;
(Result as TJSONObject).AddPair('Name', Name);
(Result as TJSONObject).AddPair('Text', Text);
end;
{ TjMemo }
function TjMemo._GetJson: TJSONValue;
var
Res: string;
I: Integer;
begin
for I := 0 to Pred(Lines.Count) do
begin
Res := Res + Lines[I];
if I < Pred(Lines.Count) then
Res := Res + 'n';
end;
Result := TJSONObject.Create;
(Result as TJSONObject).AddPair('Name', Name);
(Result as TJSONObject).AddPair('Text', Trim(Res));
end;
{ TjTreeView }
function TjTreeView._GetJson: TJSONValue;
var
Root: TTreeNode;
begin
Result := TJSONArray.Create;
if Items.Count > 0 then
begin
_Serialize(nil, Result);
end;
end;
procedure TjTreeView._Serialize(ANode: TTreeNode; var ANodeJson: TJSONValue);
var
I: Integer;
SelfNode, ChildNode: TTreeNode;
SelfSerNode: TJSONObject;
SelfSerNodeItems: TJSONValue;
begin
if ANode = nil then
SelfNode := Items[0];
while SelfNode <> nil do
begin
SelfSerNode := TJSONObject.Create;
SelfSerNode.AddPair('Oid', TJSONNumber.Create(SelfNode.AbsoluteIndex));
SelfSerNode.AddPair('Text', SelfNode.Text);
if SelfNode.Expanded then
SelfSerNode.AddPair('Exp', TJSONTrue.Create)
else
SelfSerNode.AddPair('Exp', TJSONFalse.Create);
SelfSerNodeItems := TJSONArray.Create;
if SelfNode.HasChildren then
begin
ChildNode := SelfNode.getFirstChild;
_Serialize(ChildNode, SelfSerNodeItems);
end;
SelfSerNode.AddPair('Items', SelfSerNodeItems);
(ANodeJson as TJSONArray).AddElement(SelfSerNode);
SelfNode := SelfNode.getNextSibling;
end;
end;
end.
interface
uses System.Classes, System.SysUtils, vcl.StdCtrls, vcl.ComCtrls, System.json;
type
IJsonSerialized = interface
function _GetJson: TJSONValue;
property json: TJSONValue read _GetJson;
end;
TjEdit = class(TEdit, IJsonSerialized)
private
function _GetJson: TJSONValue;
public
property json: TJSONValue read _GetJson;
end;
TjMemo = class(TMemo, IJsonSerialized)
private
function _GetJson: TJSONValue;
public
property json: TJSONValue read _GetJson;
end;
TjTreeView = class(TTreeView, IJsonSerialized)
private
function _GetJson: TJSONValue;
procedure _Serialize(ANode: TTreeNode; var ANodeJson: TJSONValue);
public
property json: TJSONValue read _GetJson;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Json Serialized', [TjEdit, TjMemo, TjTreeView]);
end;
{ TjEdit }
function TjEdit._GetJson: TJSONValue;
begin
Result := TJSONObject.Create;
(Result as TJSONObject).AddPair('Name', Name);
(Result as TJSONObject).AddPair('Text', Text);
end;
{ TjMemo }
function TjMemo._GetJson: TJSONValue;
var
Res: string;
I: Integer;
begin
for I := 0 to Pred(Lines.Count) do
begin
Res := Res + Lines[I];
if I < Pred(Lines.Count) then
Res := Res + 'n';
end;
Result := TJSONObject.Create;
(Result as TJSONObject).AddPair('Name', Name);
(Result as TJSONObject).AddPair('Text', Trim(Res));
end;
{ TjTreeView }
function TjTreeView._GetJson: TJSONValue;
var
Root: TTreeNode;
begin
Result := TJSONArray.Create;
if Items.Count > 0 then
begin
_Serialize(nil, Result);
end;
end;
procedure TjTreeView._Serialize(ANode: TTreeNode; var ANodeJson: TJSONValue);
var
I: Integer;
SelfNode, ChildNode: TTreeNode;
SelfSerNode: TJSONObject;
SelfSerNodeItems: TJSONValue;
begin
if ANode = nil then
SelfNode := Items[0];
while SelfNode <> nil do
begin
SelfSerNode := TJSONObject.Create;
SelfSerNode.AddPair('Oid', TJSONNumber.Create(SelfNode.AbsoluteIndex));
SelfSerNode.AddPair('Text', SelfNode.Text);
if SelfNode.Expanded then
SelfSerNode.AddPair('Exp', TJSONTrue.Create)
else
SelfSerNode.AddPair('Exp', TJSONFalse.Create);
SelfSerNodeItems := TJSONArray.Create;
if SelfNode.HasChildren then
begin
ChildNode := SelfNode.getFirstChild;
_Serialize(ChildNode, SelfSerNodeItems);
end;
SelfSerNode.AddPair('Items', SelfSerNodeItems);
(ANodeJson as TJSONArray).AddElement(SelfSerNode);
SelfNode := SelfNode.getNextSibling;
end;
end;
end.
Код:
procedure TForm2.Button1Click(Sender: TObject);
var
J: TJSONObject;
SD: TSaveDialog;
Bfr: TStrings;
begin
J := TJSONObject.Create;
J.AddPair('TEdit', jEdit1.json);
J.AddPair('TMemo', jMemo1.json);
J.AddPair('TTreeView', jTreeView1.json);
SD := TSaveDialog.Create(Self);
try
SD.Filter := 'Файл JSON (*.json)|*.json';
SD.InitialDir := ExtractFileDir(ParamStr(0));
SD.DefaultExt := '.json';
if SD.Execute then
begin
try
Bfr := TStringList.Create;
Bfr.Add(J.ToString);
Bfr.SaveToFile(SD.FileName);
finally
FreeAndNil(Bfr);
end;
end;
finally
FreeAndNil(SD);
end;
end;
var
J: TJSONObject;
SD: TSaveDialog;
Bfr: TStrings;
begin
J := TJSONObject.Create;
J.AddPair('TEdit', jEdit1.json);
J.AddPair('TMemo', jMemo1.json);
J.AddPair('TTreeView', jTreeView1.json);
SD := TSaveDialog.Create(Self);
try
SD.Filter := 'Файл JSON (*.json)|*.json';
SD.InitialDir := ExtractFileDir(ParamStr(0));
SD.DefaultExt := '.json';
if SD.Execute then
begin
try
Bfr := TStringList.Create;
Bfr.Add(J.ToString);
Bfr.SaveToFile(SD.FileName);
finally
FreeAndNil(Bfr);
end;
end;
finally
FreeAndNil(SD);
end;
end;