3
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@pik(Jun HOSOKAWA)

【Delphi】実験：KAI で作ったコントロールを dot に解説させてみた

3
Posted at

注意

この記事は、実験のため、全文を AI アシスタント dot に執筆してもらいました。コントロールの実装は Codex（KAI）、そのコードを解説する記事の執筆は dot が担当しています。

はじめに

今回作ってもらったのは、FireMonkey 用の画像一覧コントロール TImageListView です。画像をタイル状に並べ、URL からの読み込みや複数選択を扱います。使用環境は Delphi 13.2／Windows 11 です。

image.png

この記事では PK.GUI.ImageListView.pas を、表示部品、配置、画像取得、選択、後始末に分けて読んでいきます。最後に、フォームへ組み込む使用例を載せます。

以下はソースに基づく解説です。dot によるコンパイル・実行確認は行っていません。途中のコードは該当箇所の抜粋で、前後や内部を省略した箇所にはその旨を記しています。

1. 一覧と項目を別のクラスにする

中心になるのは、一覧全体の TImageListView と、一枚分の画像を持つ TImageListViewItem です。宣言から継承元だけを抜き出すと、次の関係になります。

// メンバー宣言は省略
TImageListViewItem = class(TLayout)
  // 省略
end;

TImageListView = class(TVertScrollBox)
  // 省略
end;

TImageListView は、縦スクロールの土台として TVertScrollBox を使います。FMX 標準の TImageList を継承したものではありません。

項目の側は TLayout を土台にして、背景、画像、選択枠、読み込み表示を組み合わせています。図中の「一覧」は TImageListView、「項目」は TImageListViewItem を表します。

表示部品は項目に閉じ込め、項目の配置や選択のルールは一覧が管理する、という分担です。

2. 一枚の画像を表示する部品を組み立てる

TImageListViewItem.Create の画像と選択枠を作る部分です。背景 FBackground は、この直前に TRectangle として生成されています。

// コンストラクタ前半を省略
  FImage := TImage.Create(Self);
  FImage.Parent := FBackground;
  FImage.Align := TAlignLayout.Client;
  FImage.Margins.Rect := TRectF.Create(8, 8, 8, 8);
  FImage.WrapMode := TImageWrapMode.Fit;
  FImage.HitTest := False;

  FSelectionFrame := TRectangle.Create(Self);
  FSelectionFrame.Parent := Self;
  FSelectionFrame.Align := TAlignLayout.Client;
  FSelectionFrame.Fill.Kind := TBrushKind.None;
  FSelectionFrame.Stroke.Color := TAlphaColors.Dodgerblue;
  FSelectionFrame.Stroke.Thickness := 3;
  FSelectionFrame.XRadius := 8;
  FSelectionFrame.YRadius := 8;
  FSelectionFrame.Visible := False;
  FSelectionFrame.HitTest := False;
// コンストラクタ後半を省略

画像の親は背景で、Align := TAlignLayout.Client により背景の内側を使います。さらに四辺に 8 の余白を取り、WrapMode := TImageWrapMode.Fit で縦横比を保って収めています。画像を枠いっぱいに切り抜く設定ではないので、縦長・横長の違いに応じて余白ができます。

選択枠は塗りを None にし、線だけを重ねています。Visible を切り替えれば、画像そのものを書き換えずに選択状態を表せます。画像や枠の HitTest は False にし、マウス操作は項目側の MouseDown で処理します。

読み込み表示の切り替えは、専用の小さなメソッドにまとめています。

procedure TImageListViewItem.SetLoading(const AValue: Boolean);
begin
  FAniIndicator.Enabled := AValue;
  FAniIndicator.Visible := AValue;
end;

TAniIndicator は項目の中央に置かれています。読み込み開始時には動作と表示をともに有効にし、終了時にはともに無効にする構成です。

3. Add で項目を作り、Index は一覧から求める

項目を追加する入口は Add です。

function TImageListView.Add: TImageListViewItem;
begin
  Result := TImageListViewItem.Create(Self);
  Result.Parent := Self;
  Result.FreeNotification(Self);
  Result.ApplyListViewTemplate(Self);
  FItems.Add(Result);
  ArrangeItems;
end;

Create(Self) の Self はコンポーネントの所有者、Parent := Self は表示上の親の指定です。続いて解放通知を登録し、一覧の外観設定を適用してから FItems に登録します。最後の ArrangeItems で、追加した項目を含めて並べ直します。

戻り値が項目自身なので、利用側では FImageListView.Add.LoadFromURL(URL) のように続けて呼び出せます。

各項目の Index は固定の番号を保存しているのではなく、問い合わせ時に一覧から検索します。

function TImageListViewItem.GetIndex: Integer;
begin
  var LOwner := OwnerImageListView;

  if LOwner = nil then
    Exit(-1);

  Result := LOwner.Items.IndexOf(Self);
end;

OwnerImageListView は、Parent を上へたどって所属する一覧を探すメソッドです。名前は Owner ですが、ここで調べているのは表示上の親子関係です。一覧が見つからなければ -1、見つかれば Items.IndexOf(Self) の結果を返します。

したがって、Index は画像の識別 ID ではなく、その時点の並び順です。途中の項目を削除すれば、後ろの項目の値も変わります。

4. 幅から列数を求めてタイル状に並べる

まず GetColumnCount で、横に何項目置けるかを計算します。

function TImageListView.GetColumnCount: Integer;
begin
  var LAvailableWidth := Max(
    FItemWidth,
    Width - Padding.Left - Padding.Right - 16);

  Result := Max(
    1,
    Trunc((LAvailableWidth + FItemSpacing) / (FItemWidth + FItemSpacing)));
end;

一覧の幅から左右の Padding と 16 を引き、項目幅と項目間隔で割っています。外側の Max(1, ...) により、列数は最低でも一列になります。

次に ArrangeItems が、項目番号を行と列へ変換します。以下はその配置ループです。

// ArrangeItems の前半を省略
  for var LIndex := 0 to FItems.Count - 1 do
  begin
    var LColumn := LIndex mod LColumnCount;
    var LRow := LIndex div LColumnCount;
    var LLeft := Padding.Left + LColumn * (FItemWidth + FItemSpacing);
    var LTop := Padding.Top + LRow * (FItemHeight + FItemSpacing);

    FItems[LIndex].SetBounds(
      LLeft,
      LTop,
      LActualItemWidth,
      FItemHeight);
  end;
// メソッド末尾の end; を省略

mod の余りが列番号、div の商が行番号です。たとえば三列なら、インデックス 0〜2 が一行目、3〜5 が二行目になります。座標は「余白＋行または列の番号×項目サイズと間隔」で求め、SetBounds に渡しています。

LActualItemWidth は前半で FItemWidth から決めています。項目を一覧の横幅いっぱいに均等伸縮させる方式ではなく、指定した項目サイズを基本に、列数を変える配置です。Resize やサイズ関連プロパティの変更時にも ArrangeItems が呼ばれます。

ここでは追加済みの全項目を走査します。画面内にある項目だけを生成・再利用する仮想化は入っていません。

5. URL の読み込み要求をキューに積む

項目から一覧へ読み込みを依頼する

LoadFromURL は、その場で HTTP 通信を始めるメソッドではありません。URL と状態を記録し、一覧へ要求を渡します。

procedure TImageListViewItem.LoadFromURL(const AURL: string);
begin
  var LOwner := OwnerImageListView;

  if LOwner = nil then
    raise EInvalidOperation.Create(SItemRequiresListView);

  FURL := AURL;
  FLocalFileName := '';
  FLoadError := '';
  SetLoading(True);
  LOwner.QueueDownload(Self, AURL);
end;

一覧への所属を先に確認するため、項目だけを単独で作って URL 読み込みを始めることはできません。通常は Add を経由して作ります。

要求を受け取る QueueDownload は、項目と URL の組を TImageListViewDownloadRequest にしてキューへ入れます。

procedure TImageListView.QueueDownload(
  const AItem: TImageListViewItem;
  const AURL: string);
begin
  TMonitor.Enter(FQueueLock);
  try
    FQueue.Enqueue(TImageListViewDownloadRequest.Create(AItem, AURL));
    FQueueEvent.SetEvent;
  finally
    TMonitor.Exit(FQueueLock);
  end;
end;

複数のワーカーが同じキューを読むので、追加処理は TMonitor で保護しています。try ... finally にして、処理途中で例外が発生してもロックを解放する形です。

FQueueEvent.SetEvent は、要求を待っているワーカーへの通知です。キューを守る役割は TMonitor、待機と通知の役割は TEvent が受け持ちます。

ワーカーが要求を取り出す

取り出し側の TryDequeue でも、同じ FQueueLock を使います。

function TImageListView.TryDequeue(
  out ARequest: TImageListViewDownloadRequest): Boolean;
begin
  TMonitor.Enter(FQueueLock);
  try
    Result := FQueue.Count > 0;

    if Result then
      ARequest := FQueue.Dequeue
    else
      FQueueEvent.ResetEvent;
  finally
    TMonitor.Exit(FQueueLock);
  end;
end;

要求があれば一件取り出し、なければ通知をリセットして False を返します。ワーカー本体はこの結果に応じて、取得処理へ進むか、イベントを待ちます。

procedure TImageListViewDownloadWorker.Execute;
begin
  while not Terminated do
  begin
    var LRequest: TImageListViewDownloadRequest;

    if FListView.TryDequeue(LRequest) then
      Download(LRequest)
    else
      FListView.FQueueEvent.WaitFor(250);
  end;
end;

WaitFor(250) は、要求がないときの待機です。常にキューを回し続けるのではなく、通知または待機時間の経過後に再び確認します。

ワーカー数を決めるのは DownloadThreadCount で、既定値は 4 です。画像の件数に合わせて一件につき一本のスレッドを作るのではなく、この数のワーカーでキューを処理します。

HTTP で受け取るのはバイト列

Download の HTTP 分岐では、THTTPClient.Get の結果を TMemoryStream に受け取ります。以下は取得結果を確認してバイト列へ移す部分です。

// Download の前半と、クライアント・ストリームの生成処理を省略
          var LResponse := LHTTPClient.Get(ARequest.URL, LStream);

          if (LResponse.StatusCode < 200) or
             (LResponse.StatusCode > 299) then
          begin
            raise ENetHTTPClientException.CreateFmt(
              SHTTPError,
              [LResponse.StatusCode, LResponse.StatusText]);
          end;

          SetLength(LBytes, LStream.Size);
          LStream.Position := 0;

          if LStream.Size > 0 then
            LStream.ReadBuffer(LBytes[0], LStream.Size);
// 解放処理、例外処理、後半を省略

HTTP ステータスが 2xx 以外なら例外とし、そのメッセージを後段へ渡します。この段階では画像を描画せず、データをバイト列として扱っています。なお file:// で始まる URL は別分岐で、ワーカーがローカルファイルをバイト列として読みます。

6. UI スレッドへ渡して画像に反映する

取得が終わったら、Download の末尾で UI スレッドに処理を渡します。

// Download の取得処理と例外処理を省略
  var LItem := ARequest.Item;
  var LListView := FListView;
  var LResultBytes := LBytes;
  var LResultErrorMessage := LErrorMessage;

  TThread.Queue(
    nil,
    procedure
    begin
      if not Terminated and LListView.ContainsItem(LItem) then
        LItem.FinishLoading(LResultBytes, LResultErrorMessage);
    end);
// メソッド末尾の end; を省略

TThread.Queue をワーカーから呼び、UI スレッドで FinishLoading を実行する構成です。コードでは停止状態と、項目が一覧に残っているかを確認しています。ただし、これだけで破棄時の寿命管理がすべて保証されるわけではなく、後述の確認点が残ります。

HTTP 読み込みの経路を図にすると、次のようになります。図中の「UIへ通知」が TThread.Queue、「画像を展開」が FinishLoading 内の処理です。

受け取った項目側の処理は次のとおりです。

procedure TImageListViewItem.FinishLoading(
  const ABytes: TBytes;
  const AErrorMessage: string);
begin
  SetLoading(False);
  FLoadError := AErrorMessage;

  if AErrorMessage <> '' then
    Exit;

  var LStream := TBytesStream.Create(ABytes);
  try
    FImage.Bitmap.LoadFromStream(LStream);
    FLocalFileName := '';
  finally
    LStream.Free;
  end;
end;

最初にインジケータを止め、取得時のエラーを LoadError に記録します。エラーがなければ TBytesStream を作り、Bitmap.LoadFromStream で画像へ変換します。

重要なのは、通信はワーカー側、画像のデコードは UI スレッド側という分担です。小さな枠に表示していても、画像を縮小してから保持する処理はありません。高解像度画像を多く扱う場合は、メモリとデコード負荷を確認する必要があります。

また、このメソッドにはデコード例外を LoadError に入れる処理はありません。取得エラーを受け取れることと、画像形式の不正などを含めたすべての失敗を処理できることは、分けて考えます。

7. 選択は一覧で管理し、項目は枠を表示する

項目の MouseDown は、左クリックを受けたら一覧へ処理を渡します。その際に選択処理を行い、クリックかダブルクリックかに応じたイベントを呼びます。選択ルールの中心は HandleItemMouseDown です。

まず、複数選択時の Shift キーの分岐を見ます。

// HandleItemMouseDown の所属確認・単一選択分岐を省略
  if ssShift in Shift then
  begin
    var LAnchor := FSelectionAnchor;

    if not ContainsItem(LAnchor) then
      LAnchor := AItem;

    if not (ssCtrl in Shift) then
      ClearSelection;

    SelectRange(LAnchor.Index, AItem.Index);
    FSelectionAnchor := LAnchor;
    Exit;
  end;
// Ctrl キーと通常クリックの分岐を省略

FSelectionAnchor が範囲選択の基点です。基点が有効でなければクリックした項目を基点にし、SelectRange で両端の Index の間を選択します。Ctrl を併用していなければ、先に既存の選択を解除します。

Ctrl キーの分岐は、クリックした一件の状態を反転させます。

// HandleItemMouseDown の前半を省略
  if ssCtrl in Shift then
  begin
    SetItemSelected(AItem, not AItem.Selected);

    if AItem.Selected then
      FSelectionAnchor := AItem;

    Exit;
  end;
// 通常クリックの分岐を省略

修飾キーなしでは既存の選択を解除して一件を選びます。MultiSelect := False の場合も一件だけの選択です。矢印キーの処理では、左右はインデックスを一つ、上下は列数分だけ増減させるコードが入っています。

状態を変える SetItemSelected は、項目へ表示変更を伝え、一覧側の選択項目リストを更新します。以下は引数と状態の確認を終えた後の部分です。

// SetItemSelected の引数・状態確認を省略
  AItem.SetSelected(AValue);

  if AValue then
  begin
    if FSelectedItems.IndexOf(AItem) < 0 then
      FSelectedItems.Add(AItem);

    if Assigned(FOnSelected) then
      FOnSelected(Self, AItem);
  end
  else
    FSelectedItems.Remove(AItem);
// メソッド末尾の end; を省略

項目側の SetSelected は FSelected と選択枠の Visible を更新します。選択のルールと選択状態の描画を分けているわけです。

ここで OnSelected は、選択状態になった側だけで呼ばれます。選択解除を含む「選択集合が変わった」という通知ではありません。

利用側が単一の選択項目を読む Selected にも、押さえておきたい条件があります。

function TImageListView.GetSelected: TImageListViewItem;
begin
  if FSelectedItems.Count = 1 then
    Result := FSelectedItems[0]
  else
    Result := nil;
end;

選択数がちょうど一件の場合にだけ項目を返し、未選択でも複数選択でも nil です。最後に選択した項目を返すプロパティではありません。複数件を扱うときは、SelectedItems と SelectedCount を使います。SelectedItems は FItems の順に走査して作るため、クリック順ではなく一覧の並び順です。

8. プロパティ変更を配置と外観へ反映する

サイズを変えるプロパティは、値を設定して配置をやり直します。たとえば高さの setter は次のとおりです。

procedure TImageListView.SetItemHeight(const AValue: Single);
begin
  FItemHeight := Max(MinItemSize, AValue);
  ArrangeItems;
end;

MinItemSize は 48.0 です。ItemWidth にも同じ下限があり、サイズを変えたら ArrangeItems が呼ばれます。

一方、色や角丸などの変更は UpdateItemTemplates を通じて、各項目の ApplyListViewTemplate に伝わります。

procedure TImageListViewItem.ApplyListViewTemplate(
  const AListView: TImageListView);
begin
  FBackground.Fill.Color := AListView.ItemBackgroundColor;
  FBackground.XRadius := AListView.ItemRadius;
  FBackground.YRadius := AListView.ItemRadius;
  FSelectionFrame.Stroke.Color := AListView.SelectionFrameColor;
  FSelectionFrame.Stroke.Thickness := AListView.SelectionFrameThickness;
  FSelectionFrame.XRadius := AListView.ItemRadius;
  FSelectionFrame.YRadius := AListView.ItemRadius;
  AListView.ApplyAniIndicatorTemplate(FAniIndicator);
end;

一覧側にある設定を、背景、選択枠、インジケータへ配る処理です。新しい項目を作るときだけでなく、追加済みの項目へ外観変更を反映するためにも使っています。

AniIndicatorTemplate は表示用インジケータそのものではなく、幅、高さ、StyleLookup などの設定元です。それぞれの項目は自分専用のインジケータを持ちます。

画像を取り出す入口には Bitmap、読み込み済みか調べる入口には HasImage があります。保存処理も短くまとまっています。

procedure TImageListViewItem.SaveToFile(const AFileName: string);
begin
  if not HasImage then
    raise EInvalidOperation.Create(SImageNotLoaded);

  FImage.Bitmap.SaveToFile(AFileName);
end;

ここで保存するのは、取得した元ファイルのバイト列ではなく、読み込んだビットマップです。HasImage が False なら例外になります。

ローカルファイルを直接読む LoadFromFile も用意されていますが、こちらは呼び出し元で Bitmap.LoadFromFile を実行する同期処理です。URL 読み込みと同じキューを経由するわけではありません。

9. 項目の削除と所有権をそろえる

一覧が持つ項目リストは、コンストラクタで次のように作られています。

// TImageListView.Create の他の初期化は省略
  FItems := TObjectList<TImageListViewItem>.Create(False);

Create(False) なので、FItems から削除するだけでは項目は解放されません。項目の生成時には一覧をコンポーネントの所有者に指定していますが、通常の削除では Delete が明示的に後始末します。

procedure TImageListView.Delete(const AIndex: Integer);
begin
  CheckIndex(AIndex);

  var LItem := FItems[AIndex];
  RemoveQueuedDownloads(LItem);
  SetItemSelected(LItem, False);

  if FSelectionAnchor = LItem then
    FSelectionAnchor := nil;

  FItems.Delete(AIndex);
  LItem.RemoveFreeNotification(Self);
  LItem.Parent := nil;
  LItem.Free;
  ArrangeItems;
end;

未処理のダウンロード要求をキューから外し、選択状態と範囲選択の基点を整理してから、リストから除外して項目を解放します。最後に残った項目を並べ直します。

FreeNotification は、項目が別経路で解放された場合にも一覧側を整理するための仕組みです。Notification から DetachItem が呼ばれ、管理リストや選択リストから対象を外す処理が入っています。利用側が Items を直接書き換えるより、Add、Delete、Remove、Clear を使う方が、この後始末と足並みをそろえられます。

一覧自体の破棄は、ワーカーを止めてから項目と管理用オブジェクトを解放する順序になっています。

destructor TImageListView.Destroy;
begin
  StopWorkers;
  Clear;
  FSelectedItems.Free;
  FWorkers.Free;
  FQueueLock.Free;
  FQueueEvent.Free;
  FQueue.Free;
  FItems.Free;

  inherited Destroy;
end;

StopWorkers では終了要求を出し、待機中のワーカーを起こして終了を待ちます。ただし、キューから要求を除去することは、すでに始まった HTTP 通信を即座に中断することとは異なります。

実際の利用前に確認する点

処理の構成が読み取れる一方、非同期処理の境界には確認点もあります。

  • 破棄時のコールバック：完了処理は TThread.Queue(nil, ...) で登録する一方、停止処理では RemoveQueuedEvents(LWorker) を呼んでいます。関連付けが一致していないため、待機中のコールバックとワーカー・一覧の寿命は見直す必要があります。
  • 同じ項目の再読み込み：要求の世代を識別する仕組みがないため、古い URL の結果が後から反映される可能性があります。
  • 失敗時の状態：LoadFromFile は例外を再送出する経路で末尾の SetLoading(False) に到達しません。画像デコード時の例外処理と併せ、失敗時の表示と後始末を確認する必要があります。

ここまでがコントロール本体の構造です。既存の FMX 部品を項目にまとめ、一覧がレイアウト・選択・取得キューを管理する形になっています。

使用例

最後に、フォームへ組み込むコードです。Load ボタンを押すと Picsum Photos の画像を 100 件追加し、読み込み済みの画像をダブルクリックすると別フォームで表示します。

フォームの準備

  1. 新しい FireMonkey アプリケーションを作り、フォームのクラス名を TForm1、ユニット名を Unit1 にします。
  2. プロジェクトへ PK.GUI.ImageListView.pas を追加します。
  3. フォームへ TButton を一つ置き、Name を Button1、Text を Load にします。
  4. フォームの OnCreate を FormCreate、ボタンの OnClick を Button1Click に割り当てます。
  5. Unit1.pas を以下の内容にします。イベントは宣言と実装を両方含めています。フォームの .fmx は、手順3・4で作成したものを使います。

画像の取得にはインターネット接続が必要です。特別なスタイルの配置は不要です。

Unit1.pas

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics,
  FMX.Dialogs, FMX.Objects,
  PK.GUI.ImageListView, FMX.Controls.Presentation, FMX.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FImageListView: TImageListView;
    procedure ImageListViewDblClick(
      const Sender: TObject;
      const Item: TImageListViewItem);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Visible := False;

  for var LIndex := 1 to 100 do
  begin
    var LURL :=
      Format(
        'https://picsum.photos/seed/fmx-image-list-%d/640/360',
        [LIndex]
      );

    FImageListView.Add.LoadFromURL(LURL);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FImageListView := TImageListView.Create(Self);
  FImageListView.Parent := Self;
  FImageListView.Align := TAlignLayout.Client;
  FImageListView.ItemWidth := 200;
  FImageListView.ItemHeight := 150;
  FImageListView.DownloadThreadCount := 4;
  FImageListView.OnDblClick := ImageListViewDblClick;

  Button1.BringToFront;
end;

procedure TForm1.ImageListViewDblClick(
  const Sender: TObject;
  const Item: TImageListViewItem);
begin
  if (Item = nil) or not Item.HasImage then
    Exit;

  var LForm := TForm.CreateNew(Self);
  LForm.Caption := Item.FileName;
  LForm.Width := 900;
  LForm.Height := 700;
  LForm.Position := TFormPosition.ScreenCenter;

  var LImage := TImage.Create(LForm);
  LImage.Parent := LForm;
  LImage.Align := TAlignLayout.Client;
  LImage.Margins.Rect := TRectF.Create(12, 12, 12, 12);
  LImage.WrapMode := TImageWrapMode.Fit;
  LImage.Bitmap.Assign(Item.Bitmap);

  LForm.Show;
end;

end.

FormCreate で一覧をフォームいっぱいに配置し、項目の大きさを幅 200、高さ 150 に指定しています。コントロール本体の既定の高さは 160 ですが、この例では 150 に変更しています。

ボタン側で必要なのは、URL を作って Add.LoadFromURL を呼ぶことです。100 件を一度に要求しても、取得処理は設定した 4 本のワーカーが受け持ちます。URL で指定する画像サイズは 640×360 で、一覧の表示枠の大きさとは別です。

ダブルクリックのハンドラでは HasImage を確認し、別フォームの TImage に Bitmap.Assign で画像を渡しています。画像一覧の中に拡大表示画面まで抱え込ませず、アプリ側のイベントで用途に合わせた処理を付ける使い方です。

なお、ここではプレビュー用フォームをメインフォームの所有物として生成しています。繰り返し開く用途では、閉じたフォームをその都度解放するか、同じフォームを再利用するかをアプリ側で決めます。

ilv.gif

最後に（ここから人間）

AI で作ったコントロールを AI に解説させたら楽なのでは？と思って、dot に書いて貰いましたが、いまいちわかりづらいですね…
dot は無料で使えるのでやらせてみましたが、dot より Codex に書かせた方が良いのかも知れません。

改めて書くと URL からの読込みが実装されたイメージを表示するリストビューコントロールです。
ウェブで良く見る奴です。

以下、ソース全文です。

unit PK.GUI.ImageListView;

interface

uses
  System.Classes,
  System.Generics.Collections,
  System.IOUtils,
  System.Math,
  System.NetEncoding,
  System.Net.HttpClient,
  System.Net.URLClient,
  System.SyncObjs,
  System.SysUtils,
  System.Types,
  System.UITypes,
  FMX.Controls,
  FMX.Graphics,
  FMX.Layouts,
  FMX.Objects,
  FMX.StdCtrls,
  FMX.Types;

type
  TImageListView = class;
  TImageListViewItem = class;

  TImageListViewItemEvent = procedure(
    const Sender: TObject;
    const Item: TImageListViewItem) of object;

  TImageListViewItem = class(TLayout)
  private
    FAniIndicator: TAniIndicator;
    FBackground: TRectangle;
    FImage: TImage;
    FLoadError: string;
    FLocalFileName: string;
    FSelected: Boolean;
    FSelectionFrame: TRectangle;
    FURL: string;
    function GetBitmap: TBitmap;
    function GetFileName: string;
    function GetHasImage: Boolean;
    function GetIndex: Integer;
    function OwnerImageListView: TImageListView;
    procedure ApplyListViewTemplate(const AListView: TImageListView);
    procedure FinishLoading(
      const ABytes: TBytes;
      const AErrorMessage: string);
    procedure SetLoading(const AValue: Boolean);
    procedure SetSelected(const AValue: Boolean);
  protected
    procedure MouseDown(
      Button: TMouseButton;
      Shift: TShiftState;
      X: Single;
      Y: Single); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure LoadFromFile(const AFileName: string);
    procedure LoadFromURL(const AURL: string);
    procedure SaveToFile(const AFileName: string);
    property Bitmap: TBitmap read GetBitmap;
    property FileName: string read GetFileName;
    property HasImage: Boolean read GetHasImage;
    property Index: Integer read GetIndex;
    property LoadError: string read FLoadError;
    property LocalFileName: string read FLocalFileName;
    property Selected: Boolean read FSelected;
    property URL: string read FURL;
  end;

  TImageListViewDownloadRequest = record
    Item: TImageListViewItem;
    URL: string;
    constructor Create(
      const AItem: TImageListViewItem;
      const AURL: string);
  end;

  TImageListViewDownloadWorker = class(TThread)
  private
    FListView: TImageListView;
    class function FileURLToFileName(const AURL: string): string; static;
    procedure Download(const ARequest: TImageListViewDownloadRequest);
  protected
    procedure Execute; override;
  public
    constructor Create(const AListView: TImageListView);
  end;

  TImageListView = class(TVertScrollBox)
  private
    FAniIndicatorTemplate: TAniIndicator;
    FDownloadThreadCount: Integer;
    FItemBackgroundColor: TAlphaColor;
    FItemHeight: Single;
    FItemRadius: Single;
    FItemSpacing: Single;
    FItemWidth: Single;
    FItems: TObjectList<TImageListViewItem>;
    FMultiSelect: Boolean;
    FOnClick: TImageListViewItemEvent;
    FOnDblClick: TImageListViewItemEvent;
    FOnSelected: TImageListViewItemEvent;
    FQueue: TQueue<TImageListViewDownloadRequest>;
    FQueueEvent: TEvent;
    FQueueLock: TObject;
    FSelectedItems: TList<TImageListViewItem>;
    FSelectionAnchor: TImageListViewItem;
    FSelectionFrameColor: TAlphaColor;
    FSelectionFrameThickness: Single;
    FWorkers: TObjectList<TImageListViewDownloadWorker>;
    function ContainsItem(const AItem: TImageListViewItem): Boolean;
    function GetColumnCount: Integer;
    function GetSelected: TImageListViewItem;
    function GetSelectedCount: Integer;
    function GetSelectedItems: TArray<TImageListViewItem>;
    procedure ApplyAniIndicatorTemplate(const AIndicator: TAniIndicator);
    procedure ArrangeItems;
    procedure CheckIndex(const AIndex: Integer);
    procedure DetachItem(const AItem: TImageListViewItem);
    procedure HandleItemMouseDown(
      const AItem: TImageListViewItem;
      const Shift: TShiftState);
    procedure RemoveQueuedDownloads(const AItem: TImageListViewItem);
    procedure SelectRange(
      const AStartIndex: Integer;
      const AEndIndex: Integer);
    procedure SetAniIndicatorTemplate(const AValue: TAniIndicator);
    procedure SetDownloadThreadCount(const AValue: Integer);
    procedure SetItemBackgroundColor(const AValue: TAlphaColor);
    procedure SetItemHeight(const AValue: Single);
    procedure SetItemRadius(const AValue: Single);
    procedure SetItemSpacing(const AValue: Single);
    procedure SetItemSelected(
      const AItem: TImageListViewItem;
      const AValue: Boolean);
    procedure SetItemWidth(const AValue: Single);
    procedure SetMultiSelect(const AValue: Boolean);
    procedure SetSelected(const AItem: TImageListViewItem);
    procedure SetSelectionFrameColor(const AValue: TAlphaColor);
    procedure SetSelectionFrameThickness(const AValue: Single);
    procedure StartWorkers;
    procedure StopWorkers;
    procedure UpdateItemTemplates;
    function TryDequeue(out ARequest: TImageListViewDownloadRequest): Boolean;
  protected
    procedure KeyDown(
      var Key: Word;
      var KeyChar: WideChar;
      Shift: TShiftState); override;
    procedure Notification(
      AComponent: TComponent;
      Operation: TOperation); override;
    procedure QueueDownload(
      const AItem: TImageListViewItem;
      const AURL: string);
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Add: TImageListViewItem;
    procedure Clear;
    procedure ClearSelection;
    procedure ClickItem(const AItem: TImageListViewItem);
    procedure DblClickItem(const AItem: TImageListViewItem);
    procedure Delete(const AIndex: Integer);
    procedure Remove(const AItem: TImageListViewItem);
    procedure SaveToFile(
      const AIndex: Integer;
      const AFileName: string); overload;
    procedure SaveToFile(
      const AItem: TImageListViewItem;
      const AFileName: string); overload;
    property Items: TObjectList<TImageListViewItem> read FItems;
    property Selected: TImageListViewItem read GetSelected write SetSelected;
    property SelectedCount: Integer read GetSelectedCount;
    property SelectedItems: TArray<TImageListViewItem> read GetSelectedItems;
  published
    property AniIndicatorTemplate: TAniIndicator
      read FAniIndicatorTemplate write SetAniIndicatorTemplate;
    property DownloadThreadCount: Integer
      read FDownloadThreadCount write SetDownloadThreadCount default 4;
    property ItemBackgroundColor: TAlphaColor
      read FItemBackgroundColor write SetItemBackgroundColor;
    property ItemHeight: Single read FItemHeight write SetItemHeight;
    property ItemRadius: Single read FItemRadius write SetItemRadius;
    property ItemSpacing: Single read FItemSpacing write SetItemSpacing;
    property ItemWidth: Single read FItemWidth write SetItemWidth;
    property MultiSelect: Boolean
      read FMultiSelect write SetMultiSelect default True;
    property SelectionFrameColor: TAlphaColor
      read FSelectionFrameColor write SetSelectionFrameColor;
    property SelectionFrameThickness: Single
      read FSelectionFrameThickness write SetSelectionFrameThickness;
    property OnClick: TImageListViewItemEvent read FOnClick write FOnClick;
    property OnDblClick: TImageListViewItemEvent
      read FOnDblClick write FOnDblClick;
    property OnSelected: TImageListViewItemEvent
      read FOnSelected write FOnSelected;
  end;

implementation

const
  MinItemSize = 48.0;
  SHTTPError = 'HTTP %d: %s';
  SImageNotLoaded = 'The image has not been loaded yet.';
  SIndexOutOfRange = 'Index is out of range.';
  SItemNotOwned = 'The item does not belong to this TImageListView.';
  SItemRequired = 'Item is not assigned.';
  SItemRequiresListView =
    'TImageListViewItem must be parented to TImageListView before loading ' +
    'from URL.';

{ TImageListViewItem }

constructor TImageListViewItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  ClipChildren := True;
  Height := 160;
  HitTest := True;

  FBackground := TRectangle.Create(Self);
  FBackground.Parent := Self;
  FBackground.Align := TAlignLayout.Client;
  FBackground.Fill.Color := TAlphaColors.Bisque;
  FBackground.Stroke.Color := TAlphaColors.Lightgray;
  FBackground.XRadius := 8;
  FBackground.YRadius := 8;
  FBackground.HitTest := False;

  FImage := TImage.Create(Self);
  FImage.Parent := FBackground;
  FImage.Align := TAlignLayout.Client;
  FImage.Margins.Rect := TRectF.Create(8, 8, 8, 8);
  FImage.WrapMode := TImageWrapMode.Fit;
  FImage.HitTest := False;

  FSelectionFrame := TRectangle.Create(Self);
  FSelectionFrame.Parent := Self;
  FSelectionFrame.Align := TAlignLayout.Client;
  FSelectionFrame.Fill.Kind := TBrushKind.None;
  FSelectionFrame.Stroke.Color := TAlphaColors.Dodgerblue;
  FSelectionFrame.Stroke.Thickness := 3;
  FSelectionFrame.XRadius := 8;
  FSelectionFrame.YRadius := 8;
  FSelectionFrame.Visible := False;
  FSelectionFrame.HitTest := False;

  FAniIndicator := TAniIndicator.Create(Self);
  FAniIndicator.Parent := Self;
  FAniIndicator.Align := TAlignLayout.Center;
  FAniIndicator.Width := 48;
  FAniIndicator.Height := 48;
  FAniIndicator.Enabled := False;
  FAniIndicator.Visible := False;
  FAniIndicator.HitTest := False;

  if AOwner is TImageListView then
    ApplyListViewTemplate(TImageListView(AOwner));
end;

procedure TImageListViewItem.ApplyListViewTemplate(
  const AListView: TImageListView);
begin
  FBackground.Fill.Color := AListView.ItemBackgroundColor;
  FBackground.XRadius := AListView.ItemRadius;
  FBackground.YRadius := AListView.ItemRadius;
  FSelectionFrame.Stroke.Color := AListView.SelectionFrameColor;
  FSelectionFrame.Stroke.Thickness := AListView.SelectionFrameThickness;
  FSelectionFrame.XRadius := AListView.ItemRadius;
  FSelectionFrame.YRadius := AListView.ItemRadius;
  AListView.ApplyAniIndicatorTemplate(FAniIndicator);
end;

procedure TImageListViewItem.FinishLoading(
  const ABytes: TBytes;
  const AErrorMessage: string);
begin
  SetLoading(False);
  FLoadError := AErrorMessage;

  if AErrorMessage <> '' then
    Exit;

  var LStream := TBytesStream.Create(ABytes);
  try
    FImage.Bitmap.LoadFromStream(LStream);
    FLocalFileName := '';
  finally
    LStream.Free;
  end;
end;

function TImageListViewItem.GetBitmap: TBitmap;
begin
  Result := FImage.Bitmap;
end;

function TImageListViewItem.GetFileName: string;
begin
  if FLocalFileName <> '' then
    Exit(System.IOUtils.TPath.GetFileName(FLocalFileName));

  if FURL = '' then
    Exit('');

  var LURI := TURI.Create(FURL);
  Result := System.IOUtils.TPath.GetFileName(LURI.Path);

  if Result = '' then
    Result := System.IOUtils.TPath.GetFileName(FURL);
end;

function TImageListViewItem.GetHasImage: Boolean;
begin
  Result := (FImage.Bitmap.Width > 0) and (FImage.Bitmap.Height > 0);
end;

function TImageListViewItem.GetIndex: Integer;
begin
  var LOwner := OwnerImageListView;

  if LOwner = nil then
    Exit(-1);

  Result := LOwner.Items.IndexOf(Self);
end;

procedure TImageListViewItem.LoadFromFile(const AFileName: string);
begin
  SetLoading(True);
  try
    FImage.Bitmap.LoadFromFile(AFileName);
    FLocalFileName := AFileName;
    FURL := 'file://' + AFileName.Replace('\', '/');
    FLoadError := '';
  except
    on E: Exception do
    begin
      FLoadError := E.Message;
      raise;
    end;
  end;
  SetLoading(False);
end;

procedure TImageListViewItem.LoadFromURL(const AURL: string);
begin
  var LOwner := OwnerImageListView;

  if LOwner = nil then
    raise EInvalidOperation.Create(SItemRequiresListView);

  FURL := AURL;
  FLocalFileName := '';
  FLoadError := '';
  SetLoading(True);
  LOwner.QueueDownload(Self, AURL);
end;

procedure TImageListViewItem.MouseDown(
  Button: TMouseButton;
  Shift: TShiftState;
  X: Single;
  Y: Single);
begin
  inherited MouseDown(Button, Shift, X, Y);

  if Button <> TMouseButton.mbLeft then
    Exit;

  var LOwner := OwnerImageListView;

  if LOwner <> nil then
  begin
    LOwner.SetFocus;
    LOwner.HandleItemMouseDown(Self, Shift);

    if ssDouble in Shift then
      LOwner.DblClickItem(Self)
    else
      LOwner.ClickItem(Self);
  end;
end;

function TImageListViewItem.OwnerImageListView: TImageListView;
begin
  var LParent := Parent;

  while Assigned(LParent) and not (LParent is TImageListView) do
    LParent := LParent.Parent;

  if LParent is TImageListView then
    Result := TImageListView(LParent)
  else
    Result := nil;
end;

procedure TImageListViewItem.SaveToFile(const AFileName: string);
begin
  if not HasImage then
    raise EInvalidOperation.Create(SImageNotLoaded);

  FImage.Bitmap.SaveToFile(AFileName);
end;

procedure TImageListViewItem.SetLoading(const AValue: Boolean);
begin
  FAniIndicator.Enabled := AValue;
  FAniIndicator.Visible := AValue;
end;

procedure TImageListViewItem.SetSelected(const AValue: Boolean);
begin
  if FSelected = AValue then
    Exit;

  FSelected := AValue;
  FSelectionFrame.Visible := AValue;
end;

{ TImageListViewDownloadRequest }

constructor TImageListViewDownloadRequest.Create(
  const AItem: TImageListViewItem;
  const AURL: string);
begin
  Item := AItem;
  URL := AURL;
end;

{ TImageListViewDownloadWorker }

constructor TImageListViewDownloadWorker.Create(
  const AListView: TImageListView);
begin
  inherited Create(False);
  FreeOnTerminate := False;
  FListView := AListView;
end;

procedure TImageListViewDownloadWorker.Download(
  const ARequest: TImageListViewDownloadRequest);
begin
  var LBytes: TBytes := nil;
  var LErrorMessage := '';

  try
    if ARequest.URL.StartsWith('file://', True) then
      LBytes := System.IOUtils.TFile.ReadAllBytes(
        FileURLToFileName(ARequest.URL))
    else
    begin
      var LStream := TMemoryStream.Create;
      try
        var LHTTPClient := THTTPClient.Create;
        try
          var LResponse := LHTTPClient.Get(ARequest.URL, LStream);

          if (LResponse.StatusCode < 200) or
             (LResponse.StatusCode > 299) then
          begin
            raise ENetHTTPClientException.CreateFmt(
              SHTTPError,
              [LResponse.StatusCode, LResponse.StatusText]);
          end;

          SetLength(LBytes, LStream.Size);
          LStream.Position := 0;

          if LStream.Size > 0 then
            LStream.ReadBuffer(LBytes[0], LStream.Size);
        finally
          LHTTPClient.Free;
        end;
      finally
        LStream.Free;
      end;
    end;
  except
    on E: Exception do
      LErrorMessage := E.Message;
  end;

  var LItem := ARequest.Item;
  var LListView := FListView;
  var LResultBytes := LBytes;
  var LResultErrorMessage := LErrorMessage;

  TThread.Queue(
    nil,
    procedure
    begin
      if not Terminated and LListView.ContainsItem(LItem) then
        LItem.FinishLoading(LResultBytes, LResultErrorMessage);
    end);
end;

procedure TImageListViewDownloadWorker.Execute;
begin
  while not Terminated do
  begin
    var LRequest: TImageListViewDownloadRequest;

    if FListView.TryDequeue(LRequest) then
      Download(LRequest)
    else
      FListView.FQueueEvent.WaitFor(250);
  end;
end;

class function TImageListViewDownloadWorker.FileURLToFileName(
  const AURL: string): string;
begin
  var LURI := TURI.Create(AURL);

  Result := TNetEncoding.URL.Decode(LURI.Path);

  if Result.StartsWith('/') and
     (Result.Length >= 3) and
     (Result.Chars[2] = ':')
  then
  begin
    Result := Result.Substring(1);
  end;

  Result := StringReplace(Result, '/', PathDelim, [rfReplaceAll]);
end;

{ TImageListView }

constructor TImageListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  CanFocus := True;

  FAniIndicatorTemplate := TAniIndicator.Create(Self);
  FAniIndicatorTemplate.Width := 48;
  FAniIndicatorTemplate.Height := 48;
  FAniIndicatorTemplate.Enabled := False;
  FAniIndicatorTemplate.Visible := False;
  FAniIndicatorTemplate.HitTest := False;

  FDownloadThreadCount := 4;
  FItemBackgroundColor := TAlphaColors.WhiteSmoke;
  FItemHeight := 160;
  FItemRadius := 8;
  FItemSpacing := 8;
  FItemWidth := 200;
  FItems := TObjectList<TImageListViewItem>.Create(False);
  FMultiSelect := True;
  FQueue := TQueue<TImageListViewDownloadRequest>.Create;
  FQueueEvent := TEvent.Create(nil, True, False, '');
  FQueueLock := TObject.Create;
  FSelectedItems := TList<TImageListViewItem>.Create;
  FSelectionFrameColor := TAlphaColors.Dodgerblue;
  FSelectionFrameThickness := 3;
  FWorkers := TObjectList<TImageListViewDownloadWorker>.Create(True);

  Padding.Rect := TRectF.Create(8, 8, 8, 8);
  ShowScrollBars := True;
  StartWorkers;
end;

destructor TImageListView.Destroy;
begin
  StopWorkers;
  Clear;
  FSelectedItems.Free;
  FWorkers.Free;
  FQueueLock.Free;
  FQueueEvent.Free;
  FQueue.Free;
  FItems.Free;

  inherited Destroy;
end;

function TImageListView.Add: TImageListViewItem;
begin
  Result := TImageListViewItem.Create(Self);
  Result.Parent := Self;
  Result.FreeNotification(Self);
  Result.ApplyListViewTemplate(Self);
  FItems.Add(Result);
  ArrangeItems;
end;

procedure TImageListView.ApplyAniIndicatorTemplate(
  const AIndicator: TAniIndicator);
begin
  var LWasLoading := AIndicator.Enabled;

  AIndicator.Align := TAlignLayout.Center;
  AIndicator.Width := FAniIndicatorTemplate.Width;
  AIndicator.Height := FAniIndicatorTemplate.Height;
  AIndicator.Opacity := FAniIndicatorTemplate.Opacity;
  AIndicator.StyleLookup := FAniIndicatorTemplate.StyleLookup;
  AIndicator.Margins.Assign(FAniIndicatorTemplate.Margins);
  AIndicator.Padding.Assign(FAniIndicatorTemplate.Padding);
  AIndicator.HitTest := False;
  AIndicator.Enabled := LWasLoading;
  AIndicator.Visible := LWasLoading;
end;

procedure TImageListView.ArrangeItems;
begin
  var LAvailableWidth := Max(
    FItemWidth,
    Width - Padding.Left - Padding.Right - 16);
  var LColumnCount := GetColumnCount;
  var LActualItemWidth := FItemWidth;

  if LColumnCount = 1 then
    LActualItemWidth := Min(FItemWidth, LAvailableWidth);

  for var LIndex := 0 to FItems.Count - 1 do
  begin
    var LColumn := LIndex mod LColumnCount;
    var LRow := LIndex div LColumnCount;
    var LLeft := Padding.Left + LColumn * (FItemWidth + FItemSpacing);
    var LTop := Padding.Top + LRow * (FItemHeight + FItemSpacing);

    FItems[LIndex].SetBounds(
      LLeft,
      LTop,
      LActualItemWidth,
      FItemHeight);
  end;
end;

procedure TImageListView.CheckIndex(const AIndex: Integer);
begin
  if not InRange(AIndex, 0, FItems.Count - 1) then
    raise EArgumentException.Create(SIndexOutOfRange);
end;

procedure TImageListView.Clear;
begin
  while FItems.Count > 0 do
    Delete(0);

  FSelectionAnchor := nil;
end;

procedure TImageListView.ClearSelection;
begin
  for var LItem in GetSelectedItems do
    SetItemSelected(LItem, False);

  FSelectionAnchor := nil;
end;

procedure TImageListView.ClickItem(const AItem: TImageListViewItem);
begin
  if Assigned(FOnClick) then
    FOnClick(Self, AItem);
end;

procedure TImageListView.DblClickItem(const AItem: TImageListViewItem);
begin
  if Assigned(FOnDblClick) then
    FOnDblClick(Self, AItem);
end;

function TImageListView.ContainsItem(const AItem: TImageListViewItem): Boolean;
begin
  Result := (FItems <> nil) and (FItems.IndexOf(AItem) >= 0);
end;

function TImageListView.GetColumnCount: Integer;
begin
  var LAvailableWidth := Max(
    FItemWidth,
    Width - Padding.Left - Padding.Right - 16);

  Result := Max(
    1,
    Trunc((LAvailableWidth + FItemSpacing) / (FItemWidth + FItemSpacing)));
end;

procedure TImageListView.Delete(const AIndex: Integer);
begin
  CheckIndex(AIndex);

  var LItem := FItems[AIndex];
  RemoveQueuedDownloads(LItem);
  SetItemSelected(LItem, False);

  if FSelectionAnchor = LItem then
    FSelectionAnchor := nil;

  FItems.Delete(AIndex);
  LItem.RemoveFreeNotification(Self);
  LItem.Parent := nil;
  LItem.Free;
  ArrangeItems;
end;

procedure TImageListView.DetachItem(const AItem: TImageListViewItem);
begin
  var LIndex := FItems.IndexOf(AItem);

  if LIndex < 0 then
    Exit;

  RemoveQueuedDownloads(AItem);
  FSelectedItems.Remove(AItem);

  if FSelectionAnchor = AItem then
    FSelectionAnchor := nil;

  FItems.Delete(LIndex);
  ArrangeItems;
end;

function TImageListView.GetSelected: TImageListViewItem;
begin
  if FSelectedItems.Count = 1 then
    Result := FSelectedItems[0]
  else
    Result := nil;
end;

function TImageListView.GetSelectedCount: Integer;
begin
  Result := FSelectedItems.Count;
end;

function TImageListView.GetSelectedItems: TArray<TImageListViewItem>;
begin
  var LItems := TList<TImageListViewItem>.Create;
  try
    for var LItem in FItems do
    begin
      if LItem.Selected then
        LItems.Add(LItem);
    end;

    Result := LItems.ToArray;
  finally
    LItems.Free;
  end;
end;

procedure TImageListView.HandleItemMouseDown(
  const AItem: TImageListViewItem;
  const Shift: TShiftState);
begin
  if not ContainsItem(AItem) then
    Exit;

  if not FMultiSelect then
  begin
    ClearSelection;
    SetItemSelected(AItem, True);
    FSelectionAnchor := AItem;
    Exit;
  end;

  if ssShift in Shift then
  begin
    var LAnchor := FSelectionAnchor;

    if not ContainsItem(LAnchor) then
      LAnchor := AItem;

    if not (ssCtrl in Shift) then
      ClearSelection;

    SelectRange(LAnchor.Index, AItem.Index);
    FSelectionAnchor := LAnchor;
    Exit;
  end;

  if ssCtrl in Shift then
  begin
    SetItemSelected(AItem, not AItem.Selected);

    if AItem.Selected then
      FSelectionAnchor := AItem;

    Exit;
  end;

  ClearSelection;
  SetItemSelected(AItem, True);
  FSelectionAnchor := AItem;
end;

procedure TImageListView.KeyDown(
  var Key: Word;
  var KeyChar: WideChar;
  Shift: TShiftState);
begin
  inherited KeyDown(Key, KeyChar, Shift);

  if FItems.Count = 0 then
    Exit;

  var LCurrentIndex := 0;

  if ContainsItem(FSelectionAnchor) then
    LCurrentIndex := FSelectionAnchor.Index
  else if FSelectedItems.Count > 0 then
    LCurrentIndex := FSelectedItems.Last.Index;

  var LTargetIndex := LCurrentIndex;

  case Key of
    vkLeft:
      Dec(LTargetIndex);
    vkRight:
      Inc(LTargetIndex);
    vkUp:
      Dec(LTargetIndex, GetColumnCount);
    vkDown:
      Inc(LTargetIndex, GetColumnCount);
  else
    Exit;
  end;

  LTargetIndex := Max(0, Min(FItems.Count - 1, LTargetIndex));

  if FMultiSelect and (ssShift in Shift) then
  begin
    var LAnchor := FSelectionAnchor;

    if not ContainsItem(LAnchor) then
      LAnchor := FItems[LCurrentIndex];

    if not (ssCtrl in Shift) then
      ClearSelection;

    SelectRange(LAnchor.Index, LTargetIndex);
    FSelectionAnchor := LAnchor;
  end
  else
  begin
    ClearSelection;
    SetItemSelected(FItems[LTargetIndex], True);
    FSelectionAnchor := FItems[LTargetIndex];
  end;

  Key := 0;
end;

procedure TImageListView.Notification(
  AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);

  if Operation <> opRemove then
    Exit;

  if AComponent is TImageListViewItem then
    DetachItem(TImageListViewItem(AComponent));
end;

procedure TImageListView.QueueDownload(
  const AItem: TImageListViewItem;
  const AURL: string);
begin
  TMonitor.Enter(FQueueLock);
  try
    FQueue.Enqueue(TImageListViewDownloadRequest.Create(AItem, AURL));
    FQueueEvent.SetEvent;
  finally
    TMonitor.Exit(FQueueLock);
  end;
end;

procedure TImageListView.Remove(const AItem: TImageListViewItem);
begin
  if AItem = nil then
    raise EArgumentException.Create(SItemRequired);

  if not ContainsItem(AItem) then
    raise EInvalidOperation.Create(SItemNotOwned);

  Delete(AItem.Index);
end;

procedure TImageListView.RemoveQueuedDownloads(const AItem: TImageListViewItem);
begin
  TMonitor.Enter(FQueueLock);
  try
    if FQueue.Count = 0 then
      Exit;

    var LRequests := FQueue.ToArray;
    FQueue.Clear;

    for var LRequest in LRequests do
    begin
      if LRequest.Item <> AItem then
        FQueue.Enqueue(LRequest);
    end;

    if FQueue.Count > 0 then
      FQueueEvent.SetEvent
    else
      FQueueEvent.ResetEvent;
  finally
    TMonitor.Exit(FQueueLock);
  end;
end;

procedure TImageListView.Resize;
begin
  inherited Resize;
  ArrangeItems;
end;

procedure TImageListView.SaveToFile(
  const AIndex: Integer;
  const AFileName: string);
begin
  CheckIndex(AIndex);
  SaveToFile(FItems[AIndex], AFileName);
end;

procedure TImageListView.SaveToFile(
  const AItem: TImageListViewItem;
  const AFileName: string);
begin
  if AItem <> nil then
    AItem.SaveToFile(AFileName);
end;

procedure TImageListView.SelectRange(
  const AStartIndex: Integer;
  const AEndIndex: Integer);
begin
  CheckIndex(AStartIndex);
  CheckIndex(AEndIndex);

  var LFirstIndex := Min(AStartIndex, AEndIndex);
  var LLastIndex := Max(AStartIndex, AEndIndex);

  for var LIndex := LFirstIndex to LLastIndex do
    SetItemSelected(FItems[LIndex], True);
end;

procedure TImageListView.SetAniIndicatorTemplate(const AValue: TAniIndicator);
begin
  if AValue = nil then
    raise EArgumentException.Create(SItemRequired);

  FAniIndicatorTemplate.Width := AValue.Width;
  FAniIndicatorTemplate.Height := AValue.Height;
  FAniIndicatorTemplate.Opacity := AValue.Opacity;
  FAniIndicatorTemplate.StyleLookup := AValue.StyleLookup;
  FAniIndicatorTemplate.Margins.Assign(AValue.Margins);
  FAniIndicatorTemplate.Padding.Assign(AValue.Padding);
  UpdateItemTemplates;
end;

procedure TImageListView.SetDownloadThreadCount(const AValue: Integer);
begin
  var LNewValue := Max(1, AValue);

  if FDownloadThreadCount = LNewValue then
    Exit;

  StopWorkers;
  FDownloadThreadCount := LNewValue;
  StartWorkers;
end;

procedure TImageListView.SetItemBackgroundColor(
  const AValue: TAlphaColor);
begin
  if FItemBackgroundColor = AValue then
    Exit;

  FItemBackgroundColor := AValue;
  UpdateItemTemplates;
end;

procedure TImageListView.SetItemHeight(const AValue: Single);
begin
  FItemHeight := Max(MinItemSize, AValue);
  ArrangeItems;
end;

procedure TImageListView.SetItemRadius(const AValue: Single);
begin
  FItemRadius := Max(0.0, AValue);
  UpdateItemTemplates;
end;

procedure TImageListView.SetItemSpacing(const AValue: Single);
begin
  var LNewValue := Max(0.0, AValue);

  if FItemSpacing = LNewValue then
    Exit;

  FItemSpacing := LNewValue;
  ArrangeItems;
end;

procedure TImageListView.SetItemSelected(
  const AItem: TImageListViewItem;
  const AValue: Boolean);
begin
  if AItem = nil then
    Exit;

  if AItem.Selected = AValue then
    Exit;

  AItem.SetSelected(AValue);

  if AValue then
  begin
    if FSelectedItems.IndexOf(AItem) < 0 then
      FSelectedItems.Add(AItem);

    if Assigned(FOnSelected) then
      FOnSelected(Self, AItem);
  end
  else
    FSelectedItems.Remove(AItem);
end;

procedure TImageListView.SetItemWidth(const AValue: Single);
begin
  FItemWidth := Max(MinItemSize, AValue);
  ArrangeItems;
end;

procedure TImageListView.SetMultiSelect(const AValue: Boolean);
begin
  if FMultiSelect = AValue then
    Exit;

  FMultiSelect := AValue;

  if FMultiSelect or (FSelectedItems.Count <= 1) then
    Exit;

  var LSelectedItem := GetSelectedItems[0];
  ClearSelection;
  SetItemSelected(LSelectedItem, True);
  FSelectionAnchor := LSelectedItem;
end;

procedure TImageListView.SetSelected(const AItem: TImageListViewItem);
begin
  if (AItem <> nil) and not ContainsItem(AItem) then
    raise EInvalidOperation.Create(SItemNotOwned);

  ClearSelection;

  if AItem <> nil then
  begin
    SetItemSelected(AItem, True);
    FSelectionAnchor := AItem;
  end;
end;

procedure TImageListView.SetSelectionFrameColor(
  const AValue: TAlphaColor);
begin
  if FSelectionFrameColor = AValue then
    Exit;

  FSelectionFrameColor := AValue;
  UpdateItemTemplates;
end;

procedure TImageListView.SetSelectionFrameThickness(
  const AValue: Single);
begin
  FSelectionFrameThickness := Max(0.0, AValue);
  UpdateItemTemplates;
end;

procedure TImageListView.StartWorkers;
begin
  for var LIndex := 1 to FDownloadThreadCount do
    FWorkers.Add(TImageListViewDownloadWorker.Create(Self));
end;

procedure TImageListView.StopWorkers;
begin
  if FWorkers = nil then
    Exit;

  for var LWorker in FWorkers do
    LWorker.Terminate;

  if FQueueEvent <> nil then
    FQueueEvent.SetEvent;

  for var LWorker in FWorkers do
  begin
    LWorker.WaitFor;
    TThread.RemoveQueuedEvents(LWorker);
  end;

  FWorkers.Clear;
end;

function TImageListView.TryDequeue(
  out ARequest: TImageListViewDownloadRequest): Boolean;
begin
  TMonitor.Enter(FQueueLock);
  try
    Result := FQueue.Count > 0;

    if Result then
      ARequest := FQueue.Dequeue
    else
      FQueueEvent.ResetEvent;
  finally
    TMonitor.Exit(FQueueLock);
  end;
end;

procedure TImageListView.UpdateItemTemplates;
begin
  for var LItem in FItems do
    LItem.ApplyListViewTemplate(Self);
end;

end.
3
0
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
Sign upLogin
3
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?