7
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

DelphiでローカルLLMを利用したアプリを開発 その1 チャット管理クラス

Last updated at Posted at 2025-12-02

本投稿はDelphi AdventCalender 2025 #03の記事です。

この記事は,Delphi13でコードを書き,Windows11で動作を確認しています。

はじめに

SmartCore AI Component Packの登場で,OpenAIなどのクラウドの生成AIとのやり取りを自前のRESTでやる必要はなくなりました。さらにSmartCore AI Component Packを使えば画像生成などもできるようになっています。
SmartCore AI Component Packでクラウドの生成AIを利用したアプリがいろいろ開発できそうです。
以下のEmbarcaderoのデベロッパーTVで詳しく紹介されています。

しかし,クラウドの生成AIはコストの問題や,社内の情報をクラウドに出したくないケースもあるのではないかと思います。そうなると,OllamaやLM Studio,vLLMを使ってまずはコストをかけずに始めたいです。

SmartCore AI Component PackではOllamaがサポートされていますが,Ollamaのtemperatureや,その他のパラメータがサポートされておらず,プロンプトの改良とパラメータの指定で落ち着いてきた翻訳や要約のシステムの運用をすぐにSmartCore AI Component Packに移行することは難しそうです。
また,SmartCore AI Component PackのOpenAI API v1を使って,OllamaのOpenAI互換APIやLM Studioを利用しようとしたのですが,うまくいきませんでした。

そこで,自前のRESTでもう少しの間OllamaやLM Studioを使いたいと考えました。まずは,生成AIとのチャット内容を管理するクラスを作りたいと思います。

チャット内容を管理するクラスの概要

生成AIとのチャットシステムを作るための文字列管理の要件は以下のようになるのではないかと思います。

  1. 改行を含む文字列である
  2. 質問と回答があり,交互にやり取りが行われる
  3. 一括翻訳をする場合には,先に質問が大量にあり,先頭から順番に回答される
  4. 質問とそれまでの履歴を交互に並べて生成AIに渡し,回答を受け取って履歴に追加する
  5. 会話の内容の履歴の数を設定して,それより多い履歴は消す
  6. チャット内容を簡単に表示する機能を持つ

そこで,質問と回答,生成AIへの送信を簡単に管理できるクラスとそのクラスを利用した関数群を書きました。

KP.ListString.pas
KP.ListString.pas
unit KP.ListString;
(*
TListString: 改行を含む文字列を管理するTList<string>を内包するクラス

LICENSE
Copyright (c) 2025 Yuzuru Kato
Released under the MIT license
http://opensource.org/licenses/mit-license.php

procedure ListStringCopy(FromListString, ToListString: TListString); // TListStringのコピー
procedure ListStringQAMarge(ATextQ, ATextA, LText: TListString);     // 質問と回答を交互に並べて一つにまとめる
function ChatQAToString(ATextQA: TListString): string;               // まとめられた質問と回答を文字列に出力
function ChatQAToString(ATextQ, ATextA: TListString): string;        // 個別の質問と回答を文字列に出力
function ChatQAToHTML(ATextQ, ATextA: TListString): string;          // 個別の質問と回答をチャットバブル風のHTML文字列に出力
*)

interface

uses
  System.Generics.Collections;

type
  TListString = class(TObject)
  private
    FStrings:TList<String>;
    function StringsGet(AIndex: Integer): string;
    procedure StringsPut(AIndex: Integer; const Value: string);
    function CountGet: integer;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure Add(AText:string);
    procedure Delete(AIndex: integer);
    property Strings[AIndex: integer]: string read StringsGet write StringsPut; default;
    property Count: integer read CountGet;
  end;

procedure ListStringCopy(FromListString, ToListString: TListString);    // TListStringのコピー
procedure ListStringQAMarge(ATextQ, ATextA, LText: TListString);        // 質問と回答を交互に並べて一つにまとめる
function ChatQAToString(ATextQA: TListString): string; overload;        // まとめられた質問と回答を文字列に出力
function ChatQAToString(ATextQ, ATextA: TListString): string; overload; // 個別の質問と回答を文字列に出力
function ChatQAToHTML(ATextQ, ATextA: TListString): string;             // 個別の質問と回答をチャットバブル風のHTML文字列に出力

implementation

uses
  System.Classes, System.SysUtils,
  System.RegularExpressions;

{ TListString }

constructor TListString.Create;
begin
  FStrings:=TList<String>.Create;
end;

destructor TListString.Destroy;
begin
  FStrings.Free;
  inherited;
end;

procedure TListString.Clear;
begin
  FStrings.Clear;
end;

function TListString.CountGet: integer;
begin
  Result:=FStrings.Count;
end;

function TListString.StringsGet(AIndex: Integer): string;
begin
  if (0<=AIndex)and(AIndex<FStrings.Count) then begin
    Result:=FStrings[AIndex];
  end else begin
    Result:='';
  end;
end;

procedure TListString.StringsPut(AIndex: Integer; const Value: string);
begin
  if (0<=AIndex)and(AIndex<FStrings.Count) then begin
    FStrings[AIndex]:=Value;
  end;
end;

procedure TListString.Add(AText: string);
begin
  FStrings.Add(AText);
end;

procedure TListString.Delete(AIndex: integer);
begin
  if (0<=AIndex)and(AIndex<FStrings.Count) then begin
    FStrings.Delete(AIndex);
  end;
end;

// TListStringのサポート関数

procedure ListStringCopy(FromListString, ToListString: TListString);
var
  s:string;
begin
  ToListString.Clear;
  for s in FromListString.FStrings do begin
    ToListString.FStrings.Add(s);
  end;
end;

procedure ListStringQAMarge(ATextQ, ATextA, LText: TListString);
var
  i,cq,ca:integer;
begin
  cq:=ATextQ.Count;
  ca:=ATextA.Count;
  LText.Clear;
  if (cq>0)and(cq>ca) then begin
    for i:=0 to ca-1 do begin
      LText.Add(ATextQ[i]);
      LText.Add(ATextA[i]);
    end;
    LText.Add(ATextQ[ca]);
  end;
end;

function ChatQAToString(ATextQA: TListString): string; overload;
var
  st:TStringList;
  i,c:integer;
begin
  st:=TStringList.Create;
  c:=ATextQA.Count;
  for i:=0 to c-1 do begin
    if i mod 2=0 then begin
      st.Add('Q ---')
    end else begin
      st.Add('A ---')
    end;
    st.Add(ATextQA[i]);
  end;
  Result:=st.Text;
  st.Free;
end;

function ChatQAToString(ATextQ, ATextA: TListString): string; overload;
var
  st:TStringList;
  i,cq,ca:integer;
begin
  st:=TStringList.Create;
  cq:=ATextQ.Count;
  ca:=ATextA.Count;
  for i:=0 to cq-1 do begin
    st.Add('Q ---');
    st.Add(ATextQ[i]);
    if i<ca then begin
      st.Add('A ---');
      st.Add(ATextA[i]);
    end;
  end;
  Result:=st.Text;
  st.Free;
end;

function CRLFToHTMLBR(AString:string):string;
begin
  Result := StringReplace(AString,
    {$IFDEF MSWINDOWS} #13#10 {$ELSE} #10{$ENDIF},  // WindowsならCRLF,それ以外はLF
    '<br>', [rfReplaceAll]);
end;

function ChatQAToHTML(ATextQ, ATextA: TListString): string; overload;
var
  st:TStringList;
  i,cq,ca:integer;
begin
  st:=TStringList.Create;
  st.Add('''
<html lang="ja">
<head>
<meta charset="UTF-8">
<style type="text/css">
/* 全体 */
html {
  font-size: 62.5%;
  background-color: #fff;
}
.sb-box {
  position: relative;
  overflow: hidden;
}
/* 吹き出し */
.sb-side-left {
  position: relative;
  float: left;
  margin: 0 10.5rem 2.0rem 2.0rem; /* 吹き出しの上下左右の余白 */
}
.sb-side-right {
  position: relative;
  float: right;
  margin: 0 2.0rem 2.0rem 10.5rem; /* 吹き出しの上下左右の余白 */
}
/* 吹き出し内のテキスト */
.sb-txt {
  position: relative;
  border: 0.2rem solid #eee; /* 吹き出しの縁取りの太さとカラー */
  border-radius: 0.6rem; /* 吹き出しを角丸に */
  background: #ccc; /* 吹き出しの背景色 */
  color: #333; /* 吹き出し内のテキストのカラー */
  font-size: 1.5rem; /* 吹き出し内のフォントサイズ */
  line-height: 1.7; /* 吹き出し内のテキストが2行以上になった時の行間 */
  padding: 1.8rem; /* 吹き出し内の上下左右の余白 */
}
.sb-txt > p:last-of-type {
  padding-bottom: 0; /* 吹き出し内のテキストを改行した場合、最後のpタグにpadding-bottomをつけない */
  margin-bottom: 0; /* 吹き出し内のテキストを改行した場合、最後のpタグにmargin-bottomをつけない */
}
/* 吹き出しの三角 */
.sb-txt:before {
  content: "";
  position: absolute;
  border-style: solid;
  top: 1.6rem; /* 吹き出し内の三角の位置 */
  z-index: 3;
}
.sb-txt:after {
  content: "";
  position: absolute;
  border-style: solid;
  top: 1.5rem; /* beforeより-0.1rem */
  z-index: 2; /* beforeより-1 */
}
/* 吹き出しの三角(左) */
.sb-txt-left:before {
  left: -0.7rem;
  border-width: 0.7rem 1.0rem 0.7rem 0;
  border-color: transparent #ccc transparent transparent; /* 背景色と同じカラーに */
}
.sb-txt-left:after {
  left: -1.0rem; /* beforeより-3rem */
  border-width: 0.8rem 1.0rem 0.8rem 0; /* beforeより上下+0.1rem */
  border-color: transparent #eee transparent transparent; /* 縁取りと同じカラーに */
}
/* 吹き出しの三角(右) */
.sb-txt-right:before {
  right: -0.7rem;
  border-width: 0.7rem 0 0.7rem 1.0rem;
  border-color: transparent transparent transparent #ccc; /* 背景色と同じカラーに */
}
.sb-txt-right:after {
  right: -1.0rem; /* beforeより-3rem */
  border-width: 0.8rem 0 0.8rem 1.0rem; /* beforeより上下+1rem */
  border-color: transparent transparent transparent #eee; /* 縁取りと同じカラーに */
}

/* 40.0rem 以下 */
@media (max-width: 40.0rem) {
  /* 吹き出し(左) */
  .sb-side-left {
    margin: 0 7.8rem 1.5rem 0; /* 吹き出し(左)の上下左右の余白を狭く */
  }
  /* 吹き出し(右) */
  .sb-side-right {
    margin: 0 0 1.5rem 7.8rem; /* 吹き出し(右)の上下左右の余白を狭く */
  }
  /* 吹き出し内のテキスト */
  .sb-txt {
    padding: 1.2rem; /* 吹き出し内の上下左右の余白を-0.6rem */
  }
}
</style>
</head>
<body>
''');
  cq:=ATextQ.Count;
  ca:=ATextA.Count;
  for i:=0 to cq-1 do begin
    st.Add('<div class="sb-box"><div class="sb-side-right"><div class="sb-txt sb-txt-right">');
    st.Add(CRLFToHTMLBR(ATextQ[i]));
    st.Add('</div></div></div>');
    if i<ca then begin
      st.Add('<div class="sb-box"><div class="sb-side-left"><div class="sb-txt sb-txt-left">');
      st.Add(CRLFToHTMLBR(ATextA[i]));
      st.Add('</div></div></div>');
    end;
  end;
  st.Add('''
</body>
</html>
''');
  Result:=st.Text;
  st.Free;
end;

end.

チャットデモ ~ TMemoを使って

KP.ListString.pasを使って,簡単なデモプログラムを作ります。
delphiでVCLアプリを新規作成して以下のように,Memo1:TMemoMemo2:TMemoButton1:TButtonコンポーネントを配置します。Form1:TFormWidthは800ぐらいにしておくとよいと思います。
フォームをリサイズしても配置がおかしくならないようにそれぞれのコンポーネントのAnchorsを設定してください。
2025-12-03-01.png

そして,Form1OnCreateOnDestoryイベントとButton1OnClickイベントを作成して以下のようにコードを書きます。

Unit1.pas
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Forms, Vcl.Graphics, Vcl.StdCtrls, Vcl.Controls,
  KP.ListString; // 上記のUnitを追加

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    ListStringQ, ListStringA: TListString;  // TListStringを追加
    procedure ListStringToMemo1;            // チャット結果を表示する手続きを追加
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListStringToMemo1; // チャット結果を表示する手続き
begin
  Memo1.Lines.BeginUpdate;
  Memo1.Lines.Text := ChatQAToString(ListStringQ, ListStringA);
  Memo1.Lines.EndUpdate;
  // https://www.gesource.jp/weblog/?p=5970
  Memo1.Perform(EM_LINESCROLL, 0, Memo1.Lines.Count); // 最下行を表示
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo2.Lines.TrailingLineBreak := False; // 最後の改行は不要なのでつけないようにする

  ListStringQ := TListString.Create;
  ListStringA := TListString.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ListStringQ.Free;
  ListStringA.Free;
end;

procedure TForm1.Button1Click(Sender: TObject); // 仮のチャットのやり取り
begin
  if Memo2.Lines.Text='' then exit;
  ListStringQ.Add('質問:' + Memo2.Lines.Text);
  ListStringA.Add(Memo2.Lines.Text + 'の答え(仮)');
  ListStringToMemo1;
end;

end.

実行すると,こんな感じになります。
2025-12-03-02.png

チャットデモ ~ TEdgeBrowserを使って

チェックには上記で十分ですが運用するには少し寂しいので,HTMLで表示してみます。

HTMLを表示するためにTEdgeBrowserを使いますが,32bitアプリケーションでは動作しません。
必ず64bitアプリケーションにして実行してください。

先ほど編集したdelphi VCLアプリから,Memo1:TMemoを削除し,EdgeBrowser1:TEdgeBrowserコンポーネントを配置します。Form1:TFormWidthは800のままにします。
フォームをリサイズしても配置がおかしくならないようにEdgeBrowser1:TEdgeBrowserコンポーネントのAnchorsを設定してください。

2025-12-03-03.png

そして,EdgeBrowser1OnNavigationCompletedイベントを作成してUnit1.pasを以下のように編集します。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Forms, Vcl.Graphics, Vcl.StdCtrls, Vcl.Controls,
- KP.ListString;
+ KP.ListString, Winapi.WebView2, Winapi.ActiveX, Vcl.Edge; // TEdgeBrowserコンポーネントの追加で自動的に更新されます。

type
  TForm1 = class(TForm)
    Button1: TButton;
-   Memo1: TMemo;                // 表示用TMemoコンポーネントを削除
+   EdgeBrowser1: TEdgeBrowser;  // 表示用TWebBrowserを追加
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
+   procedure EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
+       IsSuccess: Boolean; WebErrorStatus: COREWEBVIEW2_WEB_ERROR_STATUS); // OnNavigationCompleted イベントを追加
  private
    { Private 宣言 }
    ListStringQ, ListStringA: TListString;
-   procedure ListStringToMemo1;
+   procedure ListStringToEdgeBrowser1; // TedgeBrowser用に手続きを書き換える
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

-procedure TForm1.ListStringToMemo1;
-begin
-  Memo1.Lines.BeginUpdate;
-  Memo1.Lines.Text := ChatQAToString(ListStringQ, ListStringA);
-  Memo1.Lines.EndUpdate;
-  Memo1.Perform(EM_LINESCROLL, 0, Memo1.Lines.Count); // 最下行を表示
-end;

+procedure TForm1.ListStringToEdgeBrowser1;
+var
+  s:string;
+begin
+ {$IFDEF Win64} // 念のため64bitのみで実行されるように書いています。
+  s:=ChatQAToHTML(ListStringQ, ListStringA);
+  if not EdgeBrowser1.WebViewCreated then begin
+    EdgeBrowser1.CreateWebView;
+    while not EdgeBrowser1.WebViewCreated do begin
+      Application.ProcessMessages;
+      Sleep(100);
+    end;
+  end;
+  EdgeBrowser1.NavigateToString(s);
+ {$ENDIF Win64}
+end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo2.Lines.TrailingLineBreak := False;

  ListStringQ := TListString.Create;
  ListStringA := TListString.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ListStringQ.Free;
  ListStringA.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Memo2.Lines.Text='' then exit;
  ListStringQ.Add('質問:' + Memo2.Lines.Text);
  ListStringA.Add(Memo2.Lines.Text + 'の答え(仮)');
-  ListStringToMemo1;
+  ListStringToEdgeBrowser1; // Memo1の表示からEdgeBrowser1の表示に変更
end;

+procedure TForm1.EdgeBrowser1NavigationCompleted(Sender: TCustomEdgeBrowser;
+    IsSuccess: Boolean; WebErrorStatus: COREWEBVIEW2_WEB_ERROR_STATUS);
+begin
+  // 一番下までスクロールする
+  EdgeBrowser1.ExecuteScript('window.scroll(0, Number.MAX_SAFE_INTEGER);');
+end;

end.

実行すると,こんな感じになります。
2025-12-03-04.png

改良のヒント

  • EdgeWebBrowser1の初期化処理をForm1OnShowでやったほうが良いかもしれません。
  • 生成AIの回答ではMarkDown形式になるケースが多いので,HTMLを返す関数の中でMarkDownをHTMLに変換する関数を挟めばよりきれいな表示になるのではないかと思います。

謝辞

 このクラスと関数群を作るにあたり以下のサイトの情報を参考にしました。この場を借りて感謝します。

7
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
7
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?