mieki256's diary

Windows11 x64 25H2 + Lazarus 4.4 で勉強中。

Lazarus でJSONを扱いたい。record 配列と Integer を持っているクラスの内容を、JSON にして保存して、その JSON を読み込んでクラスの内容に反映させたい。何をどうすればいいのだろう。

AI君(Google Gemini)に尋ねてみたら、fpjson と jsonparser なるものがあると紹介してくれた。ついでに色々要望を出して、サンプルも作成してもらった。コンソールアプリとして作成。

_JsonReadWrite2.lpr

program JsonReadWrite2;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes { you can add units after this },
  SysUtils,
  fpjson,
  jsonparser;

type
  { 各アイテムのデータを保持するレコード型 }
  TMyRecord = record
    Name: string;
    Path: string;
    Args: string;
  end;

  { 配列アクセス用の型定義 }
  TMyRecordArray = array of TMyRecord;

  { 設定管理クラス }
  TMyConfig = class(TPersistent)
  private
    FItems: TMyRecordArray;
    FIndexed: integer;
    function GetItem(Index: integer): TMyRecord;
    procedure SetItem(Index: integer; const AValue: TMyRecord);
  public
    constructor Create;
    destructor Destroy; override;

    { --- JSON & ファイル操作 --- }
    function ToJsonString: string;
    procedure FromJsonString(const AJsonStr: string);
    procedure SaveToFile(const AFileName: string);
    procedure LoadFromFile(const AFileName: string);

    { --- データ操作メソッド (CRUD) --- }
    procedure AddItem(const AName, APath, AArgs: string);
    procedure UpdateItem(Index: integer; const AName, APath, AArgs: string);
    procedure RemoveItem(Index: integer);
    procedure ClearItems;
    function Count: integer;

    { --- 表示用プロシージャ --- }
    procedure PrintAll(const Msg: string);

    { --- プロパティ --- }
    property Items[Index: integer]: TMyRecord read GetItem write SetItem; default;
    property Indexed: integer read FIndexed write FIndexed;
  end;

  { --- TMyConfig クラスの実装 --- }

constructor TMyConfig.Create;
begin
  inherited Create;
  FIndexed := 0;
  SetLength(FItems, 0);
end;

destructor TMyConfig.Destroy;
begin
  SetLength(FItems, 0);
  inherited Destroy;
end;

function TMyConfig.GetItem(Index: integer): TMyRecord;
begin
  if (Index >= 0) and (Index < Length(FItems)) then
    Result := FItems[Index]
  else
    raise Exception.CreateFmt('Error: Index %d is out of bounds.', [Index]);
end;

procedure TMyConfig.SetItem(Index: integer; const AValue: TMyRecord);
begin
  if (Index >= 0) and (Index < Length(FItems)) then
    FItems[Index] := AValue
  else
    raise Exception.CreateFmt('Error: Index %d is out of bounds.', [Index]);
end;

procedure TMyConfig.AddItem(const AName, APath, AArgs: string);
var
  NewIdx: integer;
begin
  NewIdx := Length(FItems);
  SetLength(FItems, NewIdx + 1);
  FItems[NewIdx].Name := AName;
  FItems[NewIdx].Path := APath;
  FItems[NewIdx].Args := AArgs;
end;

procedure TMyConfig.UpdateItem(Index: integer; const AName, APath, AArgs: string);
begin
  if (Index >= 0) and (Index < Length(FItems)) then
  begin
    FItems[Index].Name := AName;
    FItems[Index].Path := APath;
    FItems[Index].Args := AArgs;
  end
  else
    raise Exception.CreateFmt('Error: Index %d is out of bounds for UpdateItem.',
      [Index]);
end;

procedure TMyConfig.RemoveItem(Index: integer);
begin
  if (Index >= 0) and (Index < Length(FItems)) then
  begin
    Delete(FItems, Index, 1);
  end
  else
    raise Exception.CreateFmt('Error: Index %d is out of bounds for RemoveItem.',
      [Index]);
end;

procedure TMyConfig.ClearItems;
begin
  SetLength(FItems, 0);
end;

function TMyConfig.Count: integer;
begin
  Result := Length(FItems);
end;

{ 一覧を出力するプロシージャ }
procedure TMyConfig.PrintAll(const Msg: string);
var
  i: integer;
begin
  WriteLn('--- ', Msg, ' ---');
  WriteLn(Format('Indexed: %d, Total Items: %d', [FIndexed, Count]));

  if Count = 0 then
    WriteLn('(No items)')
  else
  begin
    for i := 0 to Count - 1 do
    begin
      { Format関数を使って綺麗に整列させて出力 }
      WriteLn(Format('[%d] Name: %-15s | Path: %-20s | Args: %s',
        [i, FItems[i].Name, FItems[i].Path, FItems[i].Args]));
    end;
  end;
  WriteLn('----------------------------');
  WriteLn;
end;

function TMyConfig.ToJsonString: string;
var
  Root, ItemObj: TJSONObject;
  ItemsArr: TJSONArray;
  i: integer;
begin
  Root := TJSONObject.Create;
  try
    Root.Add('Indexed', FIndexed);
    ItemsArr := TJSONArray.Create;
    for i := 0 to High(FItems) do
    begin
      ItemObj := TJSONObject.Create;
      ItemObj.Add('Name', FItems[i].Name);
      ItemObj.Add('Path', FItems[i].Path);
      ItemObj.Add('Args', FItems[i].Args);
      ItemsArr.Add(ItemObj);
    end;
    Root.Add('Items', ItemsArr);
    Result := Root.FormatJSON;
  finally
    Root.Free;
  end;
end;

procedure TMyConfig.FromJsonString(const AJsonStr: string);
var
  JSONData: TJSONData;
  Root: TJSONObject;
  ItemsArr: TJSONArray;
  i: integer;
begin
  JSONData := GetJSON(AJsonStr);
  try
    if JSONData is TJSONObject then
    begin
      Root := TJSONObject(JSONData);
      FIndexed := Root.Get('Indexed', 0);

      if Root.Find('Items', JSONData) and (JSONData is TJSONArray) then
      begin
        ItemsArr := TJSONArray(JSONData);
        SetLength(FItems, ItemsArr.Count);
        for i := 0 to ItemsArr.Count - 1 do
        begin
          FItems[i].Name := ItemsArr.Objects[i].Get('Name', '');
          FItems[i].Path := ItemsArr.Objects[i].Get('Path', '');
          FItems[i].Args := ItemsArr.Objects[i].Get('Args', '');
        end;
      end;
    end;
  finally
    JSONData.Free;
  end;
end;

procedure TMyConfig.SaveToFile(const AFileName: string);
var
  L: TStringList;
begin
  L := TStringList.Create;
  try
    L.Text := ToJsonString;
    L.SaveToFile(AFileName);
  finally
    L.Free;
  end;
end;

procedure TMyConfig.LoadFromFile(const AFileName: string);
var
  L: TStringList;
begin
  if not FileExists(AFileName) then exit;
  L := TStringList.Create;
  try
    L.LoadFromFile(AFileName);
    FromJsonString(L.Text);
  finally
    L.Free;
  end;
end;

{ --- メインプログラム --- }

var
  Config: TMyConfig;
  FileName: string = 'settings.json';
begin
  Config := TMyConfig.Create;
  try
    { 1. 初期データの追加テスト }
    Config.AddItem('Lazarus', '/usr/bin/lazarus', '--version');
    Config.AddItem('Calculator', 'calc.exe', '');
    Config.AddItem('Notepad', 'notepad.exe', 'readme.txt');
    Config.Indexed := 100;
    Config.PrintAll('After Adding Items');

    { 2. 更新テスト }
    Config.UpdateItem(0, 'Lazarus IDE', '/opt/lazarus', '--debug');
    Config.PrintAll('After Updating Item[0]');

    { 3. 削除テスト }
    Config.RemoveItem(1); // Calculator を削除
    Config.PrintAll('After Removing Item[1]');

    { 4. ファイル保存と読み込みテスト }
    WriteLn('Saving to file: ', FileName);
    Config.SaveToFile(FileName);

    Config.ClearItems;
    Config.PrintAll('After Clear (Memory Empty)');

    WriteLn('Loading from file...');
    Config.LoadFromFile(FileName);
    Config.PrintAll('After Loading from File');

  except
    on E: Exception do
      WriteLn('Error: ', E.Message);
  end;

  Config.Free;
  WriteLn('Press Enter to quit.');
  ReadLn;
end.

実行すると以下の出力が出てくる。クラスに対して record 追加、内容更新、削除をして、その内容をJSONとして保存、JSONから読み込み、ができている。

--- After Adding Items ---
Indexed: 100, Total Items: 3
[0] Name: Lazarus         | Path: /usr/bin/lazarus     | Args: --version
[1] Name: Calculator      | Path: calc.exe             | Args:
[2] Name: Notepad         | Path: notepad.exe          | Args: readme.txt
----------------------------

--- After Updating Item[0] ---
Indexed: 100, Total Items: 3
[0] Name: Lazarus IDE     | Path: /opt/lazarus         | Args: --debug
[1] Name: Calculator      | Path: calc.exe             | Args:
[2] Name: Notepad         | Path: notepad.exe          | Args: readme.txt
----------------------------

--- After Removing Item[1] ---
Indexed: 100, Total Items: 2
[0] Name: Lazarus IDE     | Path: /opt/lazarus         | Args: --debug
[1] Name: Notepad         | Path: notepad.exe          | Args: readme.txt
----------------------------

Saving to file: settings.json
--- After Clear (Memory Empty) ---
Indexed: 100, Total Items: 0
(No items)
----------------------------

Loading from file...
--- After Loading from File ---
Indexed: 100, Total Items: 2
[0] Name: Lazarus IDE     | Path: /opt/lazarus         | Args: --debug
[1] Name: Notepad         | Path: notepad.exe          | Args: readme.txt
----------------------------

Press Enter to quit.

保存された JSON は以下。

_settings.json

{
  "Indexed" : 100,
  "Items" : [
    {
      "Name" : "Lazarus IDE",
      "Path" : "/opt/lazarus",
      "Args" : "--debug"
    },
    {
      "Name" : "Notepad",
      "Path" : "notepad.exe",
      "Args" : "readme.txt"
    }
  ]
}

◎ プロジェクト新規作成時の種類について :

◎ 他の方法 :

昨日、金曜ロードショーで放送されていた版を視聴した、とメモ。大ヒット漫画を原作とする実写映画。監督は「翔んで埼玉」実写映画版も手掛けた武内英樹監督。漫画作品の実写化には定評がある監督さん。

VFXやアクションがかなり頑張ってる感じで、よくまあここまで作ったなと感心してしまった。ホントかウソかは知らないけれど、肛門近辺のコーン一つ作るのに70万円かけたそうで、そんなものを作る時点でこのスタッフはどう考えても本気で作ってるなと…。何より、キャスティングが上手い。原作漫画に登場する各キャラのイメージをかなり再現できてるキャスティングに思えた。世の中の実写化企画がどれもこんな感じだったらいいのに…。

「はたらく細胞BLACK」版の内容も盛り込んであって、この構成は上手いなと…。比較的健康な側との対比によって、体内の状態が更に分かりやすくなったというか…。

ドラマパートにはちょっとやられた…。いやまあ、シチュエーション的には邦画でありがちなソレだけど、この作品でまさかそういうネタを盛り込んでくるとは思わなかった。しかもそのシチュエーションを盛り込むことで、 抗がん剤や放射線治療が体内の細胞にどんな影響を与えるのかまで視覚化できるわけで、見ているだけで勉強になるというか…。

個人的に、原作漫画は学習漫画の面が強い印象を持っているのだけど。ざっくりでも十分だから、一度はこのシリーズに目を通すべきだよなと…。原作漫画を読んでもいいし、アニメ版を見てもいいし、実写映画版を見るのでもいい。一応ザーッと目を通しておけば、自分の体の中で何が起きてるのかイメージしやすくなるので…。口頭で説明されてもなんだかよく分からないけれど、こういう形で視覚化すればちょっとは分かったような気分になれるはず。