Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Как сделать что бы всё что записано в Treeview ,edit, memo сохранилось в файл .json по нажатию кнопки

88K
30 апреля 2016 года
Слава Михаловский
2 / / 30.04.2016
Как сделать что бы всё что записано в Treeview ,edit, memo сохранилось в файл .json по нажатию кнопки
8
30 апреля 2016 года
mfender
3.5K / / 15.06.2005
Прям всё-всё? Включая все объекты-предки и их публичные свойства?
88K
01 мая 2016 года
Слава Михаловский
2 / / 30.04.2016
Цитата: mfender
Прям всё-всё? Включая все объекты-предки и их публичные свойства?

да всё всё

8
02 мая 2016 года
mfender
3.5K / / 15.06.2005
На скорую руку набросал такую порчу:
Код:
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.
Прекрасный способ сериализовать в JSON объекты, но не всегда помогает. Например, узлы того же TTreeView через RTTI сериализовать невозможно.

Поэтому лучше всего знать что именно нужно получить в 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.
Компоненты устанавливаются. Соответственно, у них теперь есть свойство только для чтения TComponent.json. Предполагается, что используются эти компоненты. Использовать следует так:

Код:
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;
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог