Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2005年03月03日] [更新 2013年11月03日]　Delphi サンプルプログラム集
150_オブジェクトリスト ( クラス型 ) の保存 - TImage
動作確認等 Windows 7 U64(SP1) + Delphi XE Pro
150_SaveComponentList2.zip　[2,270 KB]　2013年11月03日版 (EXE 同梱)



  • 2013年11月03日
  • ジェネリックスを使用したサンプルを追加
  • 記事とコードを整備して，Windows 7 U64(SP1) + Delphi XE で動作確認



オブジェクトリスト ( クラス型 ) の保存と読み出し


オブジェクト (コントロールまたはコンポーネント) のリストを保存したり，保存した内容を読出して表示するサンプルです．
ここでは，例として，TImage の派生コンポーネントまたは TImage を操作します．[140_オブジェクトリスト (クラス型) の保存 - TLabel] でも画像を表示しましたが，TLagel では Paint メソッド内に描画コードを書かないと，再描画の際に消えてしまいます．TImage は，内部的に再描画が行われるので，そのような必要はありません．
サンプルでは，コンポーネントのマウスドラッグでの移動も可能にしています．保存と読み出しのコード以外に，コンポーネントの実行時生成と，移動ドラッグのコードが追加されていることになります．そのため，サンプルとしては少々長めのコードとなっています．

実際に生成したコンポーネントをリストとして保存するのは，SaveComponentList 関数です．また，保存したコンポーネントのリストから読み出すのは，LoadComponentList 関数です．

本ページのサンプルでは，選択状態を表わす点線は表示しません．操作対象の TImage オブジェクトは現在マウス下にあるものとしています．

マウスの移動範囲の設定には，ClipCursor 関数を使用しています．ClipCursor 関数は，引数にクリップする領域を指定すると，その領域外にマウスカーソルが移動できなくなります．引数に nil を与えるとクリップ解除となります．





01_TImage 派生クラスのリストの保存と読み出し


各コンポーネントのリストの格納用リストに，TComponentList を使用したサンプルです．
実行時に生成するのは，TImage の派生クラスのですが，派生クラスにはプロパティやメソッド類は実装していません．必要であれば実装することになります．

TComponentList で，リスト内の各要素，Item を操作をする際，その要素 のオブジェクトのクラスでキャストする必要があります．そこで，このサンプルでは，TComponentList の派生クラスで，要素の追加や削除類のメソッドを実装し，実行時にキャストしなくても済むようにしています．


図1
設計時画面
図2
新規に画像ファイルを読み込む
  • メニュー左上の座標が画像表示開始位置
図3
PNG 画像を読込んで表示した例
  • 画像の変更は，ダブルクリック
  • マウスドラッグで移動が可能
  • [保存] ボタンで現在の状態を保存
  • [読込] で前回保存時の状態を復元
図4
操作可能なメニュー
図5
保存ファイル
  • ルートフォルダ内の ATest.dat

リスト1
オブジェクトリスト (クラス型) の保存と読出し 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, contnrs, ExtDlgs, Jpeg, GifImg, PNGImage, ExtCtrls;

type

  //生成するTImageのItem
  //他に保存する必要があるものはpublishedなプロパティとして追加する
  TImageListItem = class (TImage);

  //ImageListItemを管理するクラス
  TImageDataList = class(TComponentList)
  private
  protected
    function GetItem(Index: Integer): TImageListItem;
    procedure SetItem(Index: Integer; AObject: TImageListItem);
  public
    function Add(AObject: TImageListItem): Integer;
    function Remove(AObject: TImageListItem): Integer;
    function IndexOf(AObject: TImageListItem): Integer;
    property Items[Index: Integer]: TImageListItem
                                    read GetItem write SetItem; default;
  end;

  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    MenuCreateNew: TMenuItem;
    MenuDelete: TMenuItem;
    MenuMoveTop: TMenuItem;
    MenuMoveLast: TMenuItem;
    N3: TMenuItem;
    MenuDeleteAll: TMenuItem;
    Button1: TButton;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure MenuCreateNewClick(Sender: TObject);
    procedure MenuDeleteClick(Sender: TObject);
    procedure MenuDeleteAllClick(Sender: TObject);
    procedure MenuMoveTopClick(Sender: TObject);
    procedure MenuMoveLastClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    FImageDataList : TImageDataList;
    FFilePath      : TFileName;
    //マウスカーソル下にあるTImageListItemオブジェクト
    FImageItemUnderMouse : TImageListItem;
    //マウス座標値(描画開始の左上座標値として使用)
    FMouseX  : Integer;
    FMouseY  : Integer;
    //ドラッグ開始位置のマウス座標
    //コントロールの移動距離の計算に使用
    FBeginMouseX : Integer;
    FBeginMouseY : Integer;
    //ドラッグ中のフラグ
    FDragFlag : Boolean;
    //画像ファイルのディレクトリ
    FPictDir : String;
    procedure SaveComponentList(FFilePath: String);
    procedure LoadComponentList(FFilePath: String);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TImageDataList }

//-----------------------------------------------------------------------------
//  TImageListItemの追加
//-----------------------------------------------------------------------------
function TImageDataList.Add(AObject: TImageListItem): Integer;
begin
  Result := inherited Add(AObject);
end;

//-----------------------------------------------------------------------------
//  TImageListItemの設定
//-----------------------------------------------------------------------------
procedure TImageDataList.SetItem(Index: Integer; AObject: TImageListItem);
begin
  inherited Items[Index] := AObject;
end;

//-----------------------------------------------------------------------------
//  指定IndexのImageListItemの取得
//-----------------------------------------------------------------------------
function TImageDataList.GetItem(Index: Integer): TImageListItem;
begin
  Result := TImageListItem(inherited Items[Index]);
end;

//-----------------------------------------------------------------------------
//  指定ImageListItemの削除
//-----------------------------------------------------------------------------
function TImageDataList.Remove(AObject: TImageListItem): Integer;
begin
  Result := inherited Remove(AObject);
end;

//-----------------------------------------------------------------------------
//  指定ImageListItemの検索
//-----------------------------------------------------------------------------
function TImageDataList.IndexOf(AObject: TImageListItem): Integer;
begin
  Result := inherited IndexOf(AObject);
end;

{ TForm1 }

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //生成オブジェクトを自動破棄するには引数をTureにする
  FImageDataList := TImageDataList.Create(True);
  //保存ファイル名
  FFilePath := ExpandFileName('..\ATest.dat');
  //コントロールのドラッグフラグ
  FDragFlag :=False;

  //必要に応じて
  Panel1.DoubleBuffered := True;
end;

//=============================================================================
//  Formがなくなる前にFImageDataListを解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FImageDataList);
end;

//=============================================================================
//  保存ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  SaveComponentList(FFilePath);
end;

//=============================================================================
//  読込ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  LoadComponentList(FFilePath);
end;

//=============================================================================
//  現在のデータを保存
//  保存可能なのはTImageListItemのpublishedなプロパティのみ
//=============================================================================
procedure TForm1.SaveComponentList(FFilePath: String);
var
  i       : Integer;
  AStream : TFileStream;
begin
  AStream := TFileStream.Create(FFilePath, fmCreate or fmOpenReadWrite);
  try
    for i := 0 to FImageDataList.Count - 1 do begin
      AStream.WriteComponent(FImageDataList.Items[i]);
      Application.ProcessMessages;

    end;
  finally
    FreeAndNil(AStream);
  end;
end;

//=============================================================================
//  保存してあるデータを読出す
//=============================================================================
procedure TForm1.LoadComponentList(FFilePath: String);
var
  DI      : TImageListItem;
  AStream : TFileStream;
  i       : Integer;
begin
  FDragFlag := False;
  //FFilePathというファイルがなければ何もしない
  if not FileExists(FFilePath) then exit;

  AStream := TFileStream.Create(FFilePath, fmOpenRead);
  try
    AStream.Position := 0;
    if AStream.Size > 0 then begin
      FImageDataList.Clear;

      while True do begin
        DI := TImageListItem.Create(nil);
        AStream.ReadComponent(DI);
        FImageDataList.Add(DI);
        if AStream.Position >= AStream.Size then break;
        Application.ProcessMessages;
      end;
    end;
  finally
    AStream.Free;
  end;

  //WriteComponentで書込まれていない値等を設定
  for i := 0 to FImageDataList.Count - 1 do begin
    FImageDataList.Items[i].Parent      := Panel1;
    FImageDataList.Items[i].OnMouseMove := Panel1MouseMove;
    FImageDataList.Items[i].OnMouseDown := Panel1MouseDown;
    FImageDataList.Items[i].OnMouseUp   := Panel1MouseUp;
  end;
end;

//=============================================================================
//  Panel1とTImageListItemのOnMouseDownイベント
//=============================================================================
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ARect    : TRect;
  PointLT  : TPoint;
  PointRB  : TPoint;
begin
  if Sender is TImageListItem then begin
    FImageItemUnderMouse := TImageListItem(Sender);
  end else begin
    FImageItemUnderMouse := nil;
  end;

  //ダブルクリックの場合
  if ssDouble in Shift then begin
    if FImageItemUnderMouse <> nil then begin
      MenuCreateNewClick(nil);
    end;
    exit;
  end;

  if Button = mbLeft then begin
    if FImageItemUnderMouse <> nil then begin
      PointLT       := ClientToScreen(Point(0,0));
      PointRB       := ClientToScreen(Point(ClientWidth, ClientHeight));
      ARect         := Rect(PointLT.x, PointLT.y, PointRB.x, PointRB.y);
      Screen.Cursor := crSizeAll;
      ClipCursor(@ARect);

      FBeginMouseX  := X;
      FBeginMouseY  := Y;
      FDragFlag     := True;
    end else begin
      //生成したコンポーネント以外をクリックした場合
      FImageItemUnderMouse := nil;
    end;
  end;
end;

//=============================================================================
//  コントロールのドラッグ中はマウスの移動に伴ってコントロールの位置を変更
//  FImageItemUnderMouseは操作対象のTImageListItem
//=============================================================================
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDragFlag then begin
    FImageItemUnderMouse.Left := FImageItemUnderMouse.Left - (FBeginMouseX - X);
    FImageItemUnderMouse.Top  := FImageItemUnderMouse.Top  - (FBeginMouseY - Y);
  end else begin
    if Sender is TImageListItem then begin
      FImageItemUnderMouse := TImageListItem(Sender);
    end else begin
      FImageItemUnderMouse := nil;
    end;
  end;
end;

//=============================================================================
//  マウスボタンをUPしたらドラッグ終了
//  マウスの移動範囲をスクリーン画面サイズに戻す
//=============================================================================
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if FDragFlag then begin;
    FDragFlag     := False;
    Screen.Cursor := crDefault;
    ClipCursor(nil);
  end;
end;

//=============================================================================
//  ポップアップメニューを表示したら位置をMouseX,MouseYに保持
//  この値は新規作成TImageListItemの左上座標となる
//=============================================================================
procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  IsOnItem : Boolean;
  CurPos   : TPoint;
  APoint   : TPoint;
  AItems   : TMenuItem;
begin
  GetCursorPos(CurPos);
  //この親コントロール(TWinControl)上の座標値に変換
  APoint  := Panel1.ScreenToClient(CurPos);
  FMouseX := APoint.X;
  FMouseY := APoint.Y;

  //マウスカーソルがTImageListItem上にあるかの判定
  IsOnItem := FindDragTarget(CurPos, True) is TImageListItem;

  AItems := TPopupMenu(Sender).Items;
  //生成したコンポーネント上の時とそうでない時でメニューの使用可否を設定
  AItems[AItems.IndexOf(MenuCreateNew)].Visible := not IsOnItem;
  AItems[AItems.IndexOf(MenuDelete)].Enabled    := IsOnItem;
  AItems[AItems.IndexOf(MenuDeleteAll)].Enabled := (FImageDataList.Count > 0);
  AItems[AItems.IndexOf(MenuMoveTop)].Enabled   := IsOnItem;
  AItems[AItems.IndexOf(MenuMoveLast)].Enabled  := IsOnItem;
end;

//=============================================================================
//  ポップアップメニュー[新規]
//  保持しておいたMouseX,MouseYを左上としたコンポを作成して画像を読み込む
//=============================================================================
procedure TForm1.MenuCreateNewClick(Sender: TObject);
var
  DI    : TImageListItem;
  APict : TPicture;
begin
  //初期ディレクトリ
  if FPictDir = '' then begin
    OpenPictureDialog1.InitialDir := ExtractFileDir(ExpandFileName('..\'));
  end else begin
    OpenPictureDialog1.InitialDir := FPictDir;
  end;

  if OpenPictureDialog1.Execute then begin
    FPictDir := ExtractFileDir(OpenPictureDialog1.FileName);

    APict := TPicture.Create;
    try
      APict.LoadFromFile(OpenPictureDialog1.FileName);

      if Sender = nil then begin
        FImageItemUnderMouse.Picture.Assign(APict);
      end else begin
        DI             := TImageListItem.Create(nil);
        DI.Left        := FMouseX;
        DI.Top         := FMouseY;
        DI.Parent      := Panel1;
        DI.Transparent := True;
        DI.AutoSize    := True;
        DI.OnMouseMove := Panel1MouseMove;
        DI.OnMouseDown := Panel1MouseDown;
        DI.OnMouseUp   := Panel1MouseUp;
        FImageDataList.Add(DI);

        DI.Picture.Assign(APict);
      end;
      Panel1.Invalidate;
    finally
      FreeAndNil(APict);
    end;
  end;
end;

//=============================================================================
//  ポップアップメニュー[削除]
//  現在マウス下にあるTImageDataListのItemを削除
//=============================================================================
procedure TForm1.MenuDeleteClick(Sender: TObject);
var
  CurPos : TPoint;
begin
  GetCursorPos(CurPos);
  if FImageItemUnderMouse = nil then exit;

  FImageDataList.Remove(FImageItemUnderMouse);
  FImageItemUnderMouse := nil;
end;

//=============================================================================
//  ポップアップメニュー[全て削除]
//=============================================================================
procedure TForm1.MenuDeleteAllClick(Sender: TObject);
begin
  if FImageDataList.Count = 0 then exit;

  FImageDataList.Clear;
  FImageItemUnderMouse := nil;
end;

//=============================================================================
//  ポップアップメニュー[最前面に移動]
//  TImageDataListのItemの位置を変更してBringToFrontで最前面に移動　
//=============================================================================
procedure TForm1.MenuMoveTopClick(Sender: TObject);
var
  i : Integer;
begin
  if FImageItemUnderMouse = nil then exit;

  i := FImageDataList.IndexOf(FImageItemUnderMouse);
  FImageDataList.Move(i, FImageDataList.Count - 1);
  FImageItemUnderMouse.BringToFront;
end;

//=============================================================================
//  ポップアップメニュー[最背面に移動]
//  TImageDataListのItem位置を変更してSendToBackで最背面に移動　
//=============================================================================
procedure TForm1.MenuMoveLastClick(Sender: TObject);
var
    i: Integer;
begin
  if FImageItemUnderMouse = nil then exit;

  i := FImageDataList.IndexOf(FImageItemUnderMouse);
  FImageDataList.Move(i, 0);
  Panel1.Invalidate;
  FImageItemUnderMouse.SendToBack;
end;

end.



02_ジェネリックスの TList<T> を使用したコード


上のサンプルでは，コンポーネントを格納するリストとして，TComponentList を使用しました．
以下のコードは，ジェネリックスの TList<T> を使用して書き換えたものです．ジェネリックスを使用すると，該当するコンポーネントのクラスを指定して生成すれば，コンポーネントを参照する際，クラス型でキャストする必要がありません．

上の TComponentLis ではリスト内の項目の追加や削除のコード が必要ですが，ジェネリックスでは必要ありません．
ジェネリックスは，Delphi 2009 以降で使用可能です．


図6
保存したデータを読込んだところ

リスト2
オブジェクトリスト (クラス型) の保存と読出し
コンポーネントの格納リストにジェネリックスを使用した例 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, contnrs, ExtDlgs, Jpeg, GifImg, PNGImage, ExtCtrls,
  Generics.Collections;

type
  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    MenuCreateNew: TMenuItem;
    MenuDelete: TMenuItem;
    MenuMoveTop: TMenuItem;
    MenuMoveLast: TMenuItem;
    N3: TMenuItem;
    MenuDeleteAll: TMenuItem;
    Button1: TButton;
    Button2: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure MenuCreateNewClick(Sender: TObject);
    procedure MenuDeleteClick(Sender: TObject);
    procedure MenuDeleteAllClick(Sender: TObject);
    procedure MenuMoveTopClick(Sender: TObject);
    procedure MenuMoveLastClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    FImageDataList       : TList<TImage>;
    FFilePath            : TFileName;
    FImageItemUnderMouse : TImage;
    FMouseX              : Integer;
    FMouseY              : Integer;
    FBeginMouseX         : Integer;
    FBeginMouseY         : Integer;
    FDragFlag            : Boolean;
    FPictDir             : String;
    procedure SaveComponentList(FFilePath: String);
    procedure LoadComponentList(FFilePath: String);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{ TForm1 }

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //生成オブジェクトを自動破棄するには引数をTureにする
  FImageDataList := TList<TImage>.Create;
  //保存ファイル名
  FFilePath := ExpandFileName('..\ATest.dat');
  //コントロールのドラッグフラグ
  FDragFlag :=False;

  //必要に応じて
  Panel1.DoubleBuffered := True;
end;

//=============================================================================
//  Formがなくなる前にFImageDataListを解放
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FImageDataList);
end;

//=============================================================================
//  保存ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  SaveComponentList(FFilePath);
end;

//=============================================================================
//  読込ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  LoadComponentList(FFilePath);
end;

//=============================================================================
//  現在のデータを保存
//  保存可能なのはTImageのpublishedなプロパティのみ
//=============================================================================
procedure TForm1.SaveComponentList(FFilePath: String);
var
  i       : Integer;
  AStream : TFileStream;
begin
  AStream := TFileStream.Create(FFilePath, fmCreate or fmOpenReadWrite);
  try
    for i := 0 to FImageDataList.Count - 1 do begin
      AStream.WriteComponent(FImageDataList.Items[i]);
      Application.ProcessMessages;
    end;
  finally
    FreeAndNil(AStream);
  end;
end;

//=============================================================================
//  保存してあるデータを読出す
//=============================================================================
procedure TForm1.LoadComponentList(FFilePath: String);
var
  DI      : TImage;
  AStream : TFileStream;
  i       : Integer;
begin
  FDragFlag := False;
  //FFilePathというファイルがなければ何もしない
  if not FileExists(FFilePath) then exit;

  AStream := TFileStream.Create(FFilePath, fmOpenRead);
  try
    AStream.Position := 0;
    if AStream.Size > 0 then begin
      for i := FImageDataList.Count - 1 downto 0 do begin
        FImageDataList[i].Free;
        FImageDataList[i] := nil;
      end;
      FImageDataList.Clear;

      while True do begin
        DI := TImage.Create(nil);
        AStream.ReadComponent(DI);
        FImageDataList.Add(DI);
        if AStream.Position >= AStream.Size then break;
        Application.ProcessMessages;
      end;
    end;
  finally
    AStream.Free;
  end;

  //WriteComponentで書込まれていない値等を設定
  for i := 0 to FImageDataList.Count - 1 do begin
    FImageDataList.Items[i].Parent      := Panel1;
    FImageDataList.Items[i].OnMouseMove := Panel1MouseMove;
    FImageDataList.Items[i].OnMouseDown := Panel1MouseDown;
    FImageDataList.Items[i].OnMouseUp   := Panel1MouseUp;
  end;
end;

//=============================================================================
//  Panel1とTImageのOnMouseDownイベント
//=============================================================================
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);

var
  ARect    : TRect;
  PointLT  : TPoint;
  PointRB  : TPoint;
begin
  if Sender is TImage then begin
    FImageItemUnderMouse := TImage(Sender);
  end else begin
    FImageItemUnderMouse := nil;
  end;

  //ダブルクリックの場合
  if ssDouble in Shift then begin
    if FImageItemUnderMouse <> nil then begin
      MenuCreateNewClick(nil);
    end;
    exit;
  end;

  if Button = mbLeft then begin
    if FImageItemUnderMouse <> nil then begin
      PointLT       := ClientToScreen(Point(0,0));
      PointRB       := ClientToScreen(Point(ClientWidth, ClientHeight));
      ARect         := Rect(PointLT.x, PointLT.y, PointRB.x, PointRB.y);
      Screen.Cursor := crSizeAll;
      ClipCursor(@ARect);

      FBeginMouseX  := X;
      FBeginMouseY  := Y;
      FDragFlag     := True;
    end else begin
      //生成したコンポーネント以外をクリックした場合
      FImageItemUnderMouse := nil;
    end;
  end;
end;

//=============================================================================
//  コントロールのドラッグ中はマウスの移動に伴ってコントロールの位置を変更
//  FImageItemUnderMouseは操作対象のTImage
//=============================================================================
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDragFlag then begin
    FImageItemUnderMouse.Left := FImageItemUnderMouse.Left - (FBeginMouseX - X);
    FImageItemUnderMouse.Top  := FImageItemUnderMouse.Top  - (FBeginMouseY - Y);
  end else begin
    if Sender is TImage then begin
      FImageItemUnderMouse := TImage(Sender);
    end else begin
      FImageItemUnderMouse := nil;
    end;
  end;
end;

//=============================================================================
//  マウスボタンをUPしたらドラッグ終了
//  マウスの移動範囲をスクリーン画面サイズに戻す
//=============================================================================
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if FDragFlag then begin;
    FDragFlag     := False;
    Screen.Cursor := crDefault;
    ClipCursor(nil);
  end;
end;

//=============================================================================
//  ポップアップメニューを表示したら位置をMouseX,MouseYに保持
//  この値は新規作成TImageの左上座標となる
//=============================================================================
procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  IsOnItem : Boolean;
  CurPos   : TPoint;
  APoint   : TPoint;
  AItems   : TMenuItem;
begin
  GetCursorPos(CurPos);
  //この親コントロール(TWinControl)上の座標値に変換
  APoint  := Panel1.ScreenToClient(CurPos);
  FMouseX := APoint.X;
  FMouseY := APoint.Y;

  //マウスカーソルがTImage上にあるかの判定
  IsOnItem := FindDragTarget(CurPos, True) is TImage;

  AItems := TPopupMenu(Sender).Items;
  //生成したコンポーネント上の時とそうでない時でメニューの使用可否を設定
  AItems[AItems.IndexOf(MenuCreateNew)].Visible := not IsOnItem;
  AItems[AItems.IndexOf(MenuDelete)].Enabled    := IsOnItem;
  AItems[AItems.IndexOf(MenuDeleteAll)].Enabled := (FImageDataList.Count > 0);
  AItems[AItems.IndexOf(MenuMoveTop)].Enabled   := IsOnItem;
  AItems[AItems.IndexOf(MenuMoveLast)].Enabled  := IsOnItem;
end;

//=============================================================================
//  ポップアップメニュー[新規]
//  保持しておいたMouseX,MouseYを左上としたコンポを作成して画像を読み込む
//=============================================================================
procedure TForm1.MenuCreateNewClick(Sender: TObject);
var
  DI    : TImage;
  APict : TPicture;
begin
  //初期ディレクトリ
  if FPictDir = '' then begin
    OpenPictureDialog1.InitialDir := ExtractFileDir(ExpandFileName('..\'));
  end else begin
    OpenPictureDialog1.InitialDir := FPictDir;
  end;

  if OpenPictureDialog1.Execute then begin
    FPictDir := ExtractFileDir(OpenPictureDialog1.FileName);

    APict := TPicture.Create;
    try
      APict.LoadFromFile(OpenPictureDialog1.FileName);

      if Sender = nil then begin
        FImageItemUnderMouse.Picture.Assign(APict);
      end else begin
        DI             := TImage.Create(nil);
        DI.Left        := FMouseX;
        DI.Top         := FMouseY;
        DI.Parent      := Panel1;
        DI.Transparent := True;
        DI.AutoSize    := True;
        DI.OnMouseMove := Panel1MouseMove;
        DI.OnMouseDown := Panel1MouseDown;
        DI.OnMouseUp   := Panel1MouseUp;
        FImageDataList.Add(DI);

        DI.Picture.Assign(APict);
      end;
      Panel1.Invalidate;
    finally
      FreeAndNil(APict);
    end;
  end;
end;

//=============================================================================
//  ポップアップメニュー[削除]
//  現在マウス下にあるTImageを削除
//=============================================================================
procedure TForm1.MenuDeleteClick(Sender: TObject);
begin
  if FImageItemUnderMouse = nil then exit;

  FImageDataList.Remove(FImageItemUnderMouse);
  FreeAndNil(FImageItemUnderMouse);
end;

//=============================================================================
//  ポップアップメニュー[全て削除]
//=============================================================================
procedure TForm1.MenuDeleteAllClick(Sender: TObject);
var
  i : Integer;
begin
  if FImageDataList.Count = 0 then exit;

  for i := FImageDataList.Count - 1 downto 0 do begin
    FImageDataList[i].Free;
    FImageDataList[i] := nil;
  end;
  FImageDataList.Clear;
end;

//=============================================================================
//  ポップアップメニュー[最前面に移動]
//  TImageDataListのItemの位置を変更してBringToFrontで最前面に移動　
//=============================================================================
procedure TForm1.MenuMoveTopClick(Sender: TObject);
var
  i : Integer;
begin
  if FImageItemUnderMouse = nil then exit;

  i := FImageDataList.IndexOf(FImageItemUnderMouse);
  FImageDataList.Move(i, FImageDataList.Count - 1);
  FImageItemUnderMouse.BringToFront;
end;

//=============================================================================
//  ポップアップメニュー[最背面に移動]
//  TImageDataListのItem位置を変更してSendToBackで最背面に移動　
//=============================================================================
procedure TForm1.MenuMoveLastClick(Sender: TObject);
var
    i: Integer;
begin
  if FImageItemUnderMouse = nil then exit;

  i := FImageDataList.IndexOf(FImageItemUnderMouse);
  FImageDataList.Move(i, 0);
  Panel1.Invalidate;
  FImageItemUnderMouse.SendToBack;
end;

end.



03_複数のコンポーネントの一括処理


複数のオブジェクトを一括操作するには，リスト内の全ての項目に対して同じ操作をします．
例えば次のコードを実行すると，左端を全て 30 に揃えることができます．
TComponentList の派生クラス，あるいはジェネリックスの派生クラスに，このようなメソッドを実装し，生成するコンポーネントの派生クラスを含むコードを別ユニットにすれば，このような操作をブラックボックス的に扱えます．


図7
左端揃え

リスト3
全ての Image コントロールの位置を，左から 30 の位置に揃える 
//=============================================================================
//  一括処理の例
//  左端揃え
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
  i : Integer;
begin
  for i := 0 to FImageDataList.Count - 1 do begin
    FImageDataList[i].Left := 30;
  end;
end;