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



  • 2005年03月02日
  • 単なる TLabel から，前に作成していた縦書き横書き兼用ラベルを使用するサンプルに変更．このコンポーネントでは画像も表示できるので，画像も扱うようにした
  • 2013年11月02日
  • ジェネリックスを使用したサンプルを追加
  • 記事とコードを整備して，Windows 7 U64(SP1) + Delphi XE で動作確認



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


オブジェクト (コントロールまたはコンポーネント) のリストを保存したり，保存した内容を読出して表示するサンプルです．
ここでは，例として，TLabel の派生コンポーネントを操作します．この派生コンポーネントは，文字列と画像が表示できます．そこで，単に保存と読出しだけではなく，キャプション文字列やフォントの属性も変更できるようにしています．また，コンポーネントのマウスドラッグでの移動も可能にしています．保存と読み出しのコード以外に，コンポーネントの実行時生成と，移動ドラッグのコードが追加されていることになります．そのため，サンプルとしては少々長めのコードとなっています．

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

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





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


各コンポーネントのリストの格納用リストに，TComponentList を使用したサンプルです．

TComponentList で，リスト内の各要素，Item を操作をする際，下記のリンクの [03_複数のボタンを作成 (TList を使用)] の記事のコードのように，その要素 のオブジェクトのクラスでキャストする必要があります．
そこで，このサンプルでは，TComponentList の派生クラスで，要素の追加や削除類のメソッドを実装し，実行時にキャストしなくても済むようにしています．


図1
設計時画面
図2
新規作成
  • 右クリックで [新規作成] を選択
  • [新規画像] で画像を選択
  • メニュー左上が描画開始位置
図3
ドラッグも可能
  • 移動範囲はフォーム内
  • [保存] ボタンで現在の状態を保存
  • [読込] ボタンで前回保存時の状態を復元
図4
保存ファイル
  • ルートフォルダ内の ATest.dat

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

interface

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

type

  //縦横兼用ラベル(画像表示可能)用のクラス(TplVertLabel)
  //選択矩形描画のためPaintをoverride
  //選択コントロールを意味するSelectedプロパティ追加
  TLabelListItem = class (TplVertLabel)
  protected
    procedure Paint ; override;
  private
    FSelected : Boolean;
    procedure SetSelected(const Value: Boolean);
  public
    constructor Create(AOwner: TComponent);override;
    property Selected : Boolean read FSelected write SetSelected default False;
  published
  end;

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

  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    MenuCreateNew: TMenuItem;
    MenuDelete: TMenuItem;
    MenuMoveTop: TMenuItem;
    MenuMoveLast: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    MenuCaption: TMenuItem;
    MenuFont: TMenuItem;
    FontDialog1: TFontDialog;
    MenuDeleteAll: TMenuItem;
    Button1: TButton;
    Button2: TButton;
    MenuHorz: TMenuItem;
    MenuVert: TMenuItem;
    MenuCreatePict: TMenuItem;
    MenuChangePict: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    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 MenuCaptionClick(Sender: TObject);
    procedure MenuFontClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure MenuHorzClick(Sender: TObject);
    procedure MenuVertClick(Sender: TObject);
    procedure MenuCreatePictClick(Sender: TObject);
    procedure MenuChangePictClick(Sender: TObject);
  private
    { Private 宣言 }
    //TLabelのParentはTWinControlでなければならない
    FParentControl : TWinControl;
    FLabelDataList : TLabelDataList;
    FFilePath      : TFileName;
    //生成するTLabelListItemオブジェクト
    FSelectLabel : TLabelListItem;
    //マウス座標値(描画開始の左上座標値として使用)
    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}

{ TLabelListItem }

//-----------------------------------------------------------------------------
//  コンストラクタ
//-----------------------------------------------------------------------------
constructor TLabelListItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

//-----------------------------------------------------------------------------
//  TplVertLabelのPaintメソッド
//  ここでは選択中であることを示すために点線矩形の描画コードを追加
//-----------------------------------------------------------------------------
procedure TLabelListItem.Paint;
begin
  inherited;

  //Itemが選択されているならば常に点線矩形を描画
  if FSelected then begin
    Canvas.Pen.Mode    := pmCOPY;
    Canvas.Pen.Color   := clBlack;
    Canvas.Pen.Style   := psDot;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(Rect(0, 0, Width, Height));
  end;
end;

//-----------------------------------------------------------------------------
//  TplVertLabelのSelectedプロパティの設定用メソッド
//  選択中を意味する点線を描画しているので，選択状態が変化したら再描画
//-----------------------------------------------------------------------------
procedure TLabelListItem.SetSelected(const Value: Boolean);
begin
  FSelected := Value;
  Invalidate;
end;

{ TLabelDataList }

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

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

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

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

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

{ TForm1 }

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //親コントロールの指定
  FParentControl :=  Self;
  if FParentControl <> Self then PopupMenu := nil;

  //生成オブジェクトの自動破棄するには引数をTureにする
  FLabelDataList := TLabelDataList.Create(True);
  //保存ファイル名
  FFilePath := ExpandFileName('..\ATest.dat');
  //コントロールのドラッグフラグ
  FDragFlag :=False;

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

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FLabelDataList);
end;

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

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

//=============================================================================
//  現在のコントロール等のデータを保存
//  保存可能なのはTLabelDataListItemのpublished値
//=============================================================================
procedure TForm1.SaveComponentList(FFilePath: String);
var
  i       : Integer;
  AStream : TFileStream;
begin
  AStream := TFileStream.Create(FFilePath, fmCreate or fmOpenReadWrite);
  try
    for i := 0 to FLabelDataList.Count - 1 do begin
      AStream.WriteComponent(FLabelDataList.Items[i]);
      Application.ProcessMessages;
    end;
  finally
    AStream.Free;
  end;
end;

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

  //選択コントロールがあれば選択点線矩形を消去し選択コントロールなしに
  if FSelectLabel <> nil then begin
    FSelectLabel.Selected := False;
    FSelectLabel := nil;
  end;

  AStream := TFileStream.Create(FFilePath, fmOpenRead);
  AStream.Position := 0;
  try
    if AStream.Size > 0 then begin
      FLabelDataList.Clear;
      while True do begin
        DI := TLabelListItem.Create(nil);
        AStream.ReadComponent(DI);
        FLabelDataList.Add(DI);
        if AStream.Position >= AStream.Size then break;
        Application.ProcessMessages;
      end;
    end;
  finally
    AStream.Free;
  end;

  //WriteComponentで書込まれていない値等を設定
  //Parentプロパティとイベントの設定
  for i := 0 to FLabelDataList.Count - 1 do begin
    FLabelDataList.Items[i].Parent      := FParentControl;
    FLabelDataList.Items[i].OnMouseMove := FormMouseMove;
    FLabelDataList.Items[i].OnMouseDown := FormMouseDown;
    FLabelDataList.Items[i].OnMouseUp   := FormMouseUp;
  end;
end;

//=============================================================================
//  Form1のOnMouseDownイベント
//  マウス左ボタンをコントロール上でクリックしたらコントロールを選択状態にする
//  ドラッグ中のフラグDragFlagをTrueにする
//  マウス移動範囲をClipCursorを使用してこのForm1の上だけにする
//=============================================================================
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  PointLT : TPoint;
  PointRB : TPoint;
  ARect   : TRect;
begin
  if Button = mbLeft then begin
    //現在選択コントロールがあれば選択解除
    if FSelectLabel <> nil then FSelectLabel.Selected := False;

    if Sender is TLabelListItem then begin
      //選択したTVertLabelの選択プロパティをTrueに
      FSelectLabel          := TLabelListItem(Sender);
      FSelectLabel.Selected := True;

      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
      //TplVertLabel以外をクリックしたら選択コントロールなしにする
      FSelectLabel := nil;
    end;
  end;
end;

//=============================================================================
//  Form1のOnMouseMoveイベント
//  コントロールのドラッグ中はマウスの移動に伴ってコントロールの位置を変更
//  FSelectLabelは選択中のTLabelListItem(TplVertLabel)
//=============================================================================
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDragFlag then begin
    FSelectLabel.Left := FSelectLabel.Left - (FBeginMouseX - X);
    FSelectLabel.Top  := FSelectLabel.Top  - (FBeginMouseY - Y);
  end;
end;

//=============================================================================
//  Form1のOnMouseUpイベント
//  マウスボタンをUPしたらドラッグ終了
//  マウスの移動範囲をリセット
//=============================================================================
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if FDragFlag then begin;
    FDragFlag     := False;
    Screen.Cursor := crDefault;
    ClipCursor(nil);
  end;
end;

//=============================================================================
//  ポップアップメニューのOnPopupイベント
//  ポップアップメニューの表示位置をFMouseX,FMouseYに保持
//  この値は新規作成TVertLabelの位置(左上)
//  実用的には，マウスカーソルが選択コントロール内かでも処理を分岐すべき
//=============================================================================
procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  CurPos   : TPoint;
  APoint   : TPoint;
  AItems   : TMenuItem;
  IsOnItem : Boolean;
begin
  //このForm上のマウス座標値(スクリーン座標値)を取得
  GetCursorPos(CurPos);
  //この親コントロール(TWinControl)上の座標値に変換
  APoint  := FParentControl.ScreenToClient(CurPos);
  FMouseX := APoint.X;
  FMouseY := APoint.Y;

  AItems := TPopupMenu(Sender).Items;
  if FSelectLabel = nil then begin
    //選択コントロールがない場合
    AItems[AItems.IndexOf(MenuCreateNew)].Visible  := True;
    AItems[AItems.IndexOf(MenuCreatePict)].Visible := True;
    AItems[AItems.IndexOf(MenuDelete)].Enabled     := False;
    AItems[AItems.IndexOf(MenuDeleteAll)].Enabled  := (FLabelDataList.Count > 0);
    AItems[AItems.IndexOf(MenuMoveTop)].Enabled    := False;
    AItems[AItems.IndexOf(MenuMoveLast)].Enabled   := False;
    AItems[AItems.IndexOf(MenuCaption)].Enabled    := False;
    AItems[AItems.IndexOf(MenuFont)].Enabled       := False;
    AItems[AItems.IndexOf(MenuChangePict)].Enabled := False;
    AItems[AItems.IndexOf(MenuHorz)].Visible       := False;
    AItems[AItems.IndexOf(MenuVert)].Visible       := False;
    AItems[AItems.IndexOf(MenuChangePict)].Visible := False;
  end else begin
    //選択コントロールがある場合
    AItems[AItems.IndexOf(MenuCreateNew)].Visible  := True;

    //マウスカーソルがコントロール上にあるかの判定
    IsOnItem := FindDragTarget(CurPos, True).ClassName = 'TLabelListItem';

    AItems[AItems.IndexOf(MenuDelete)].Enabled     := IsOnItem;
    AItems[AItems.IndexOf(MenuDeleteAll)].Enabled  := (FLabelDataList.Count > 0);
    AItems[AItems.IndexOf(MenuMoveTop)].Enabled    := IsOnItem;
    AItems[AItems.IndexOf(MenuMoveLast)].Enabled   := IsOnItem;

    if Assigned(FSelectLabel.Picture.Graphic) then begin
      AItems[AItems.IndexOf(MenuCaption)].Enabled    := False;
      AItems[AItems.IndexOf(MenuFont)].Enabled       := False;
      AItems[AItems.IndexOf(MenuChangePict)].Enabled := IsOnItem;
      AItems[AItems.IndexOf(MenuChangePict)].Visible := IsOnItem;
      AItems[AItems.IndexOf(MenuHorz)].Visible       := False;
      AItems[AItems.IndexOf(MenuVert)].Visible       := False;
    end else begin
      AItems[AItems.IndexOf(MenuCaption)].Enabled    := IsOnItem;
      AItems[AItems.IndexOf(MenuFont)].Enabled       := IsOnItem;
      AItems[AItems.IndexOf(MenuChangePict)].Visible := False;

      if FSelectLabel.Vertical then begin
        AItems[AItems.IndexOf(MenuHorz)].Visible := IsOnItem;
        AItems[AItems.IndexOf(MenuVert)].Visible := False;
      end else begin
        AItems[AItems.IndexOf(MenuHorz)].Visible := False;
        AItems[AItems.IndexOf(MenuVert)].Visible := IsOnItem;
      end;
    end;
  end;
end;

//=============================================================================
//  ポップアップメニュー[新規作成]
//  保持しておいたFMouseX,FMouseYを左上としたラベルを作成
//  新規作成時は横書き
//=============================================================================
procedure TForm1.MenuCreateNewClick(Sender: TObject);
var
  DI: TLabelListItem;
begin
  //Itemを追加
  DI := TLabelListItem.Create(nil);
  DI.Left        := FMouseX;
  DI.Top         := FMouseY;
  DI.Parent      := FParentControl;
  DI.Caption     := '新規ラベル';
  DI.AutoSize    := True;
  DI.Transparent := True;
  DI.Font.Size   := 16;
  DI.Vertical    := False;
  DI.OnMouseMove := FormMouseMove;
  DI.OnMouseDown := FormMouseDown;
  DI.OnMouseUp   := FormMouseUp;
  FLabelDataList.Add(DI);

  //現在の選択は解除
  if FSelectLabel <> nil then FSelectLabel.Selected := False;
  //新規作成したTplVertLabelを選択
  FSelectLabel := DI;
  FSelectLabel.Selected := True;
end;

//=============================================================================
//  ポップアップメニュー[新規画像]
//  新規に画像表示用としてラベル(TplVertLabel)を生成
//  文字列の場合と共通部分があるが，独立して記述
//  TplVertLabelのAutoSizeをTrueとしているので画像サイズと同じサイズとなる
//=============================================================================
procedure TForm1.MenuCreatePictClick(Sender: TObject);
var
  DI    : TLabelListItem;
  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);

    //Itemを追加
    DI := TLabelListItem.Create(nil);
    DI.Left        := FMouseX;
    DI.Top         := FMouseY;
    DI.Parent      := FParentControl;
    DI.AutoSize    := True;
    DI.Transparent := True;
    DI.OnMouseMove := FormMouseMove;
    DI.OnMouseDown := FormMouseDown;
    DI.OnMouseUp   := FormMouseUp;

    APict := TPicture.Create;
    try
      APict.LoadFromFile(OpenPictureDialog1.FileName);
      DI.Picture.Assign(APict);
    finally
      FreeAndNil(APict);
    end;
    FLabelDataList.Add(DI);

    //現在の選択は解除
    if FSelectLabel <> nil then FSelectLabel.Selected := False;
    //新規作成したTplVertLabelを選択
    FSelectLabel := DI;
    FSelectLabel.Selected := True;
  end;
end;

//=============================================================================
//  ポップアップメニュー[削除]
//  現在選択内のTplVertLabelを削除
//=============================================================================
procedure TForm1.MenuDeleteClick(Sender: TObject);
begin
  if FSelectLabel = nil then exit;

  FLabelDataList.Remove(FSelectLabel);
  FSelectLabel := nil;
end;

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

  FLabelDataList.Clear;
  FSelectLabel := nil;
end;

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

  i := FLabelDataList.IndexOf(FSelectLabel);
  FLabelDataList.Move(i, FLabelDataList.Count - 1);
  FSelectLabel.BringToFront;
end;

//=============================================================================
//  ポップアップメニュー[最背面に移動]
//  TLabelDataListのItemを変更してSendToBackで最背面に移動　
//  ParentControlより下位には移動しない
//=============================================================================
procedure TForm1.MenuMoveLastClick(Sender: TObject);
var
  i : Integer;
begin
  if FSelectLabel = nil then exit;

  i := FLabelDataList.IndexOf(FSelectLabel);
  FLabelDataList.Move(i, 0);
  FSelectLabel.SendToBack;
end;

//=============================================================================
//  ポップアップメニュー[キャプション]
//=============================================================================
procedure TForm1.MenuCaptionClick(Sender: TObject);
begin
  if FSelectLabel = nil then exit;

  FSelectLabel.Caption := InputBox('ラベル文字列', '', FSelectLabel.Caption);
end;

//=============================================================================
//  ポップアップメニュー[フォント]
//=============================================================================
procedure TForm1.MenuFontClick(Sender: TObject);
begin
  if FSelectLabel = nil then exit;

  FontDialog1.Font := FSelectLabel.Font;
  if FontDialog1.Execute then begin
    FSelectLabel.Font.Assign(FontDialog1.Font);
  end;
end;

//=============================================================================
//  ポップアップメニュー[横書き]
//=============================================================================
procedure TForm1.MenuHorzClick(Sender: TObject);
begin
  if FSelectLabel <> nil then FSelectLabel.Vertical := False;
end;

//=============================================================================
//  ポップアップメニュー[縦書き]
//=============================================================================
procedure TForm1.MenuVertClick(Sender: TObject);
begin
  if FSelectLabel <> nil then FSelectLabel.Vertical := True;
end;

//=============================================================================
//  ポップアップメニュー[画像変更]
//  ラベル(TplVertLabel)が画像表示している時に画像を変更
//=============================================================================
procedure TForm1.MenuChangePictClick(Sender: TObject);
var
  APict : TPicture;
begin
  if FSelectLabel = nil then exit;

  //初期ディレクトリ
  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);
      FSelectLabel.Picture.Assign(APict);
      //再描画(必要)
      FParentControl.Invalidate;
    finally
      FreeAndNil(APict);
    end;
  end;
end;

end.



02_コントロールをパネル上に表示して動作させる方法


生成したコンポーネントを TPanel 上に配置して動作させるサンプルです．
生成したコンポーネントの親コントロールをフォームに配置した TPanel に，つまり，Parent プロパティの値をこのパネルにします．また，コンポーネントの移動には，このパネルのマウスイベント内で処理するようにしたものです．


図5
パネルを配置
図6
実行例
  • 上のサンプルで保存した内容を読み込み

リスト2
オブジェクトリスト (クラス型) の保存と読出しのサンプル
このコードはメインフォームの部分のみ		 
//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //親コントロールの指定
  Panel1.Caption := '';
  FParentControl :=  Panel1;
  if FParentControl <> Self then PopupMenu := nil;

  //生成オブジェクトの自動破棄するには引数をTureにする
  FLabelDataList := TLabelDataList.Create(True);
  //保存ファイル名
  FFilePath := ExpandFileName('..\ATest.dat');
  //コントロールのドラッグフラグ
  FDragFlag :=False;

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

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FLabelDataList);
end;

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

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

//=============================================================================
//  現在のコントロール等のデータを保存
//  保存可能なのはTLabelDataListItemのpublished値
//=============================================================================
procedure TForm1.SaveComponentList(FFilePath: String);
var
  i       : Integer;
  AStream : TFileStream;
begin
  AStream := TFileStream.Create(FFilePath, fmCreate or fmOpenReadWrite);
  try
    for i := 0 to FLabelDataList.Count - 1 do begin
      AStream.WriteComponent(FLabelDataList.Items[i]);
      Application.ProcessMessages;
    end;
  finally
    AStream.Free;
  end;
end;

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

  //選択コントロールがあれば選択点線矩形を消去し選択コントロールなしに
  if FSelectLabel <> nil then begin
    FSelectLabel.Selected := False;
    FSelectLabel := nil;
  end;

  AStream := TFileStream.Create(FFilePath, fmOpenRead);
  AStream.Position := 0;
  try
    if AStream.Size > 0 then begin
      FLabelDataList.Clear;
      while True do begin
        DI := TLabelListItem.Create(nil);
        AStream.ReadComponent(DI);
        FLabelDataList.Add(DI);
        if AStream.Position >= AStream.Size then break;
        Application.ProcessMessages;
      end;
    end;
  finally
    AStream.Free;
  end;

  //WriteComponentで書込まれていない値等を設定
  //Parentプロパティとイベントの設定
  for i := 0 to FLabelDataList.Count - 1 do begin
    FLabelDataList.Items[i].Parent      := FParentControl;
    FLabelDataList.Items[i].OnMouseMove := Panel1MouseMove;
    FLabelDataList.Items[i].OnMouseDown := Panel1MouseDown;
    FLabelDataList.Items[i].OnMouseUp   := Panel1MouseUp;
  end;
end;

//=============================================================================
//  Panel1のOnMouseDownイベント
//  マウス左ボタンをコントロール上でクリックしたらコントロールを選択状態にする
//  ドラッグ中のフラグDragFlagをTrueにする
//  マウス移動範囲をClipCursorを使用してこのForm1の上だけにする
//=============================================================================
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  PointLT : TPoint;
  PointRB : TPoint;
  ARect   : TRect;
begin
  if Button = mbLeft then begin
    //現在選択コントロールがあれば選択解除
    if FSelectLabel <> nil then FSelectLabel.Selected := False;

    if Sender is TLabelListItem then begin
      //選択したTVertLabelの選択プロパティをTrueに
      FSelectLabel          := TLabelListItem(Sender);
      FSelectLabel.Selected := True;

      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
      //TplVertLabel以外をクリックしたら選択コントロールなしにする
      FSelectLabel := nil;
    end;
  end;
end;

//=============================================================================
//  Panel1のOnMouseMoveイベント
//  コントロールのドラッグ中はマウスの移動に伴ってコントロールの位置を変更
//  FSelectLabelは選択中のTLabelListItem(TplVertLabel)
//=============================================================================
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDragFlag then begin
    FSelectLabel.Left := FSelectLabel.Left - (FBeginMouseX - X);
    FSelectLabel.Top  := FSelectLabel.Top  - (FBeginMouseY - Y);
  end;
end;

//=============================================================================
//  Panel1のOnMouseUpイベント
//  マウスボタンを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;

//=============================================================================
//  ポップアップメニューのOnPopupイベント
//  ポップアップメニューの表示位置をFMouseX,FMouseYに保持
//  この値は新規作成TVertLabelの位置(左上)
//  実用的には，マウスカーソルが選択コントロール内かでも処理を分岐すべき
//=============================================================================
procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  CurPos   : TPoint;
  APoint   : TPoint;
  AItems   : TMenuItem;
  IsOnItem : Boolean;
begin
  //このTPanel上のマウス座標値(スクリーン座標値)を取得
  GetCursorPos(CurPos);
  //この親コントロール(TWinControl)上の座標値に変換
  APoint  := FParentControl.ScreenToClient(CurPos);
  FMouseX := APoint.X;
  FMouseY := APoint.Y;

  AItems := TPopupMenu(Sender).Items;
  if FSelectLabel = nil then begin
    //選択コントロールがない場合
    AItems[AItems.IndexOf(MenuCreateNew)].Visible  := True;
    AItems[AItems.IndexOf(MenuCreatePict)].Visible := True;
    AItems[AItems.IndexOf(MenuDelete)].Enabled     := False;
    AItems[AItems.IndexOf(MenuDeleteAll)].Enabled  := (FLabelDataList.Count > 0);
    AItems[AItems.IndexOf(MenuMoveTop)].Enabled    := False;
    AItems[AItems.IndexOf(MenuMoveLast)].Enabled   := False;
    AItems[AItems.IndexOf(MenuCaption)].Enabled    := False;
    AItems[AItems.IndexOf(MenuFont)].Enabled       := False;
    AItems[AItems.IndexOf(MenuChangePict)].Enabled := False;
    AItems[AItems.IndexOf(MenuHorz)].Visible       := False;
    AItems[AItems.IndexOf(MenuVert)].Visible       := False;
    AItems[AItems.IndexOf(MenuChangePict)].Visible := False;
  end else begin
    //選択コントロールがある場合
    AItems[AItems.IndexOf(MenuCreateNew)].Visible  := True;

    //マウスカーソルがコントロール上にあるかの判定
    IsOnItem := FindDragTarget(CurPos, True).ClassName = 'TLabelListItem';

    AItems[AItems.IndexOf(MenuDelete)].Enabled     := IsOnItem;
    AItems[AItems.IndexOf(MenuDeleteAll)].Enabled  := (FLabelDataList.Count > 0);
    AItems[AItems.IndexOf(MenuMoveTop)].Enabled    := IsOnItem;
    AItems[AItems.IndexOf(MenuMoveLast)].Enabled   := IsOnItem;

    if Assigned(FSelectLabel.Picture.Graphic) then begin
      AItems[AItems.IndexOf(MenuCaption)].Enabled    := False;
      AItems[AItems.IndexOf(MenuFont)].Enabled       := False;
      AItems[AItems.IndexOf(MenuChangePict)].Enabled := IsOnItem;
      AItems[AItems.IndexOf(MenuChangePict)].Visible := IsOnItem;
      AItems[AItems.IndexOf(MenuHorz)].Visible       := False;
      AItems[AItems.IndexOf(MenuVert)].Visible       := False;
    end else begin
      AItems[AItems.IndexOf(MenuCaption)].Enabled    := IsOnItem;
      AItems[AItems.IndexOf(MenuFont)].Enabled       := IsOnItem;
      AItems[AItems.IndexOf(MenuChangePict)].Visible := False;

      if FSelectLabel.Vertical then begin
        AItems[AItems.IndexOf(MenuHorz)].Visible := IsOnItem;
        AItems[AItems.IndexOf(MenuVert)].Visible := False;
      end else begin
        AItems[AItems.IndexOf(MenuHorz)].Visible := False;
        AItems[AItems.IndexOf(MenuVert)].Visible := IsOnItem;
      end;
    end;
  end;
end;

//=============================================================================
//  ポップアップメニュー[新規作成]
//  保持しておいたFMouseX,FMouseYを左上としたラベルを作成
//  新規作成時は横書き
//=============================================================================
procedure TForm1.MenuCreateNewClick(Sender: TObject);
var
  DI: TLabelListItem;
begin
  //Itemを追加
  DI := TLabelListItem.Create(nil);
  DI.Left        := FMouseX;
  DI.Top         := FMouseY;
  DI.Parent      := FParentControl;
  DI.Caption     := '新規ラベル';
  DI.AutoSize    := True;
  DI.Transparent := True;
  DI.Font.Size   := 16;
  DI.Vertical    := False;
  DI.OnMouseMove := Panel1MouseMove;
  DI.OnMouseDown := Panel1MouseDown;
  DI.OnMouseUp   := Panel1MouseUp;
  FLabelDataList.Add(DI);

  //現在の選択は解除
  if FSelectLabel <> nil then FSelectLabel.Selected := False;
  //新規作成したTplVertLabelを選択
  FSelectLabel := DI;
  FSelectLabel.Selected := True;
end;

//=============================================================================
//  ポップアップメニュー[新規画像]
//  新規に画像表示用としてラベル(TplVertLabel)を生成
//  文字列の場合と共通部分があるが，独立して記述
//  TplVertLabelのAutoSizeをTrueとしているので画像サイズと同じサイズとなる
//=============================================================================
procedure TForm1.MenuCreatePictClick(Sender: TObject);
var
  DI    : TLabelListItem;
  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);

    //Itemを追加
    DI := TLabelListItem.Create(nil);
    DI.Left        := FMouseX;
    DI.Top         := FMouseY;
    DI.Parent      := FParentControl;
    DI.AutoSize    := True;
    DI.Transparent := True;
    DI.OnMouseMove := Panel1MouseMove;
    DI.OnMouseDown := Panel1MouseDown;
    DI.OnMouseUp   := Panel1MouseUp;

    APict := TPicture.Create;
    try
      APict.LoadFromFile(OpenPictureDialog1.FileName);
      DI.Picture.Assign(APict);
    finally
      FreeAndNil(APict);
    end;
    FLabelDataList.Add(DI);

    //現在の選択は解除
    if FSelectLabel <> nil then FSelectLabel.Selected := False;
    //新規作成したTplVertLabelを選択
    FSelectLabel := DI;
    FSelectLabel.Selected := True;
  end;
end;

//=============================================================================
//  ポップアップメニュー[削除]
//  現在選択内のTplVertLabelを削除
//=============================================================================
procedure TForm1.MenuDeleteClick(Sender: TObject);
begin
  if FSelectLabel = nil then exit;

  FLabelDataList.Remove(FSelectLabel);
  FSelectLabel := nil;
end;

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

  FLabelDataList.Clear;
  FSelectLabel := nil;
end;

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

  i := FLabelDataList.IndexOf(FSelectLabel);
  FLabelDataList.Move(i, FLabelDataList.Count - 1);
  FSelectLabel.BringToFront;
end;

//=============================================================================
//  ポップアップメニュー[最背面に移動]
//  TLabelDataListのItemを変更してSendToBackで最背面に移動　
//  ParentControlより下位には移動しない
//=============================================================================
procedure TForm1.MenuMoveLastClick(Sender: TObject);
var
  i : Integer;
begin
  if FSelectLabel = nil then exit;

  i := FLabelDataList.IndexOf(FSelectLabel);
  FLabelDataList.Move(i, 0);
  FSelectLabel.SendToBack;
end;

//=============================================================================
//  ポップアップメニュー[キャプション]
//=============================================================================
procedure TForm1.MenuCaptionClick(Sender: TObject);
begin
  if FSelectLabel = nil then exit;

  FSelectLabel.Caption := InputBox('ラベル文字列', '', FSelectLabel.Caption);
end;

//=============================================================================
//  ポップアップメニュー[フォント]
//=============================================================================
procedure TForm1.MenuFontClick(Sender: TObject);
begin
  if FSelectLabel = nil then exit;

  FontDialog1.Font := FSelectLabel.Font;
  if FontDialog1.Execute then begin
    FSelectLabel.Font.Assign(FontDialog1.Font);
  end;
end;

//=============================================================================
//  ポップアップメニュー[横書き]
//=============================================================================
procedure TForm1.MenuHorzClick(Sender: TObject);
begin
  if FSelectLabel <> nil then FSelectLabel.Vertical := False;
end;

//=============================================================================
//  ポップアップメニュー[縦書き]
//=============================================================================
procedure TForm1.MenuVertClick(Sender: TObject);
begin
  if FSelectLabel <> nil then FSelectLabel.Vertical := True;
end;

//=============================================================================
//  ポップアップメニュー[画像変更]
//  ラベル(TplVertLabel)が画像表示している時に画像を変更
//=============================================================================
procedure TForm1.MenuChangePictClick(Sender: TObject);
var
  APict : TPicture;
begin
  if FSelectLabel = nil then exit;

  //初期ディレクトリ
  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);
      FSelectLabel.Picture.Assign(APict);
      //再描画(必要)
      FParentControl.Invalidate;
    finally
      FreeAndNil(APict);
    end;
  end;
end;



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


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

上の TComponentList ではリスト内の項目の追加や削除のコード が必要ですが，ジェネリックスでは必要ありません．なんらかの追加処理が必要であれば，下のコードのように，操作対象のコンポーネントの派生クラスを定義します．そして，その派生クラスのメンバとして実装します．
ジェネリックスは，Delphi 2009 以降で使用可能です．


図7
パネルを配置
図8
実行例
  • 上のサンプルで保存した内容を読み込み


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

interface

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

type

  //縦横兼用ラベル(画像表示可能)用のクラス(TplVertLabel)
  //選択矩形描画のためPaintをoverride
  //選択コントロールを意味するSelectedプロパティ追加
  TLabelListItem = class (TplVertLabel)
  protected
    procedure Paint ; override;
  private
    FSelected : Boolean;
    procedure SetSelected(const Value: Boolean);
  public
    constructor Create(AOwner: TComponent);override;
    property Selected : Boolean read FSelected write SetSelected default False;
  published
  end;

  TForm1 = class(TForm)
    PopupMenu1: TPopupMenu;
    MenuCreateNew: TMenuItem;
    MenuDelete: TMenuItem;
    MenuMoveTop: TMenuItem;
    MenuMoveLast: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    MenuCaption: TMenuItem;
    MenuFont: TMenuItem;
    FontDialog1: TFontDialog;
    MenuDeleteAll: TMenuItem;
    Button1: TButton;
    Button2: TButton;
    MenuHorz: TMenuItem;
    MenuVert: TMenuItem;
    MenuCreatePict: TMenuItem;
    MenuChangePict: TMenuItem;
    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 MenuCaptionClick(Sender: TObject);
    procedure MenuFontClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure MenuHorzClick(Sender: TObject);
    procedure MenuVertClick(Sender: TObject);
    procedure MenuCreatePictClick(Sender: TObject);
    procedure MenuChangePictClick(Sender: TObject);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
    FLabelDataList : TList<TLabelListItem>;
    //TLabelのParentはTWinControlでなければならない
    FParentControl : TWinControl;
    FFilePath      : TFileName;
    //生成するTLabelListItemオブジェクト
    FSelectLabel : TLabelListItem;
    //マウス座標値(描画開始の左上座標値として使用)
    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}

{ TLabelListItem }

//-----------------------------------------------------------------------------
//  コンストラクタ
//-----------------------------------------------------------------------------
constructor TLabelListItem.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

//-----------------------------------------------------------------------------
//  TplVertLabelのPaintメソッド
//  ここでは選択中であることを示すために点線矩形の描画コードを追加
//-----------------------------------------------------------------------------
procedure TLabelListItem.Paint;
begin
  inherited;

  //Itemが選択されているならば常に点線矩形を描画
  if FSelected then begin
    Canvas.Pen.Mode    := pmCOPY;
    Canvas.Pen.Color   := clBlack;
    Canvas.Pen.Style   := psDot;
    Canvas.Brush.Style := bsClear;
    Canvas.Rectangle(Rect(0, 0, Width, Height));
  end;
end;

//-----------------------------------------------------------------------------
//  TplVertLabelのSelectedプロパティの設定用メソッド
//  選択中を意味する点線を描画しているので，選択状態が変化したら再描画
//-----------------------------------------------------------------------------
procedure TLabelListItem.SetSelected(const Value: Boolean);
begin
  FSelected := Value;
  Invalidate;
end;

{ TForm1 }

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  //親コントロールの指定
  Panel1.Caption := '';
  FParentControl :=  Panel1;
  if FParentControl <> Self then PopupMenu := nil;

  //生成オブジェクトの自動破棄するには引数をTureにする
  FLabelDataList := TList<TLabelListItem>.Create;
  //保存ファイル名
  FFilePath := ExpandFileName('..\ATest.dat');
  //コントロールのドラッグフラグ
  FDragFlag :=False;

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

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FLabelDataList);
end;

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

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

//=============================================================================
//  現在のコントロール等のデータを保存
//  保存可能なのはTLabelDataListItemのpublished値
//=============================================================================
procedure TForm1.SaveComponentList(FFilePath: String);
var
  i       : Integer;
  AStream : TFileStream;
begin
  AStream := TFileStream.Create(FFilePath, fmCreate or fmOpenReadWrite);
  try
    for i := 0 to FLabelDataList.Count - 1 do begin
      AStream.WriteComponent(FLabelDataList[i]);
      Application.ProcessMessages;
    end;
  finally
    AStream.Free;
  end;
end;

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

  //選択コントロールがあれば選択点線矩形を消去し選択コントロールなしに
  if FSelectLabel <> nil then begin
    FSelectLabel.Selected := False;
    FSelectLabel := nil;
  end;

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

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

  //WriteComponentで書込まれていない値等を設定
  //Parentプロパティとイベントの設定
  for i := 0 to FLabelDataList.Count - 1 do begin
    FLabelDataList[i].Parent      := FParentControl;
    FLabelDataList[i].OnMouseMove := Panel1MouseMove;
    FLabelDataList[i].OnMouseDown := Panel1MouseDown;
    FLabelDataList[i].OnMouseUp   := Panel1MouseUp;
  end;
end;

//=============================================================================
//  Panel1のOnMouseDownイベント
//  マウス左ボタンをコントロール上でクリックしたらコントロールを選択状態にする
//  ドラッグ中のフラグDragFlagをTrueにする
//  マウス移動範囲をClipCursorを使用してこのForm1の上だけにする
//=============================================================================
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  PointLT : TPoint;
  PointRB : TPoint;
  ARect   : TRect;
begin
  if Button = mbLeft then begin
    //現在選択コントロールがあれば選択解除
    if FSelectLabel <> nil then FSelectLabel.Selected := False;

    if Sender is TLabelListItem then begin
      //選択したTVertLabelの選択プロパティをTrueに
      FSelectLabel          := TLabelListItem(Sender);
      FSelectLabel.Selected := True;

      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
      //TplVertLabel以外をクリックしたら選択コントロールなしにする
      FSelectLabel := nil;
    end;
  end;
end;

//=============================================================================
//  Panel1のOnMouseMoveイベント
//  コントロールのドラッグ中はマウスの移動に伴ってコントロールの位置を変更
//  FSelectLabelは選択中のTLabelListItem(TplVertLabel)
//=============================================================================
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if FDragFlag then begin
    FSelectLabel.Left := FSelectLabel.Left - (FBeginMouseX - X);
    FSelectLabel.Top  := FSelectLabel.Top  - (FBeginMouseY - Y);
  end;
end;

//=============================================================================
//  Panel1のOnMouseUpイベント
//  マウスボタンを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;

//=============================================================================
//  ポップアップメニューのOnPopupイベント
//  ポップアップメニューの表示位置をFMouseX,FMouseYに保持
//  この値は新規作成TVertLabelの位置(左上)
//  実用的には，マウスカーソルが選択コントロール内かでも処理を分岐すべき
//=============================================================================
procedure TForm1.PopupMenu1Popup(Sender: TObject);
var
  CurPos   : TPoint;
  APoint   : TPoint;
  AItems   : TMenuItem;
  IsOnItem : Boolean;
begin
  //このTPanel上のマウス座標値(スクリーン座標値)を取得
  GetCursorPos(CurPos);
  //この親コントロール(TWinControl)上の座標値に変換
  APoint  := FParentControl.ScreenToClient(CurPos);
  FMouseX := APoint.X;
  FMouseY := APoint.Y;

  AItems := TPopupMenu(Sender).Items;
  if FSelectLabel = nil then begin
    //選択コントロールがない場合
    AItems[AItems.IndexOf(MenuCreateNew)].Visible  := True;
    AItems[AItems.IndexOf(MenuCreatePict)].Visible := True;
    AItems[AItems.IndexOf(MenuDelete)].Enabled     := False;
    AItems[AItems.IndexOf(MenuDeleteAll)].Enabled  := (FLabelDataList.Count > 0);
    AItems[AItems.IndexOf(MenuMoveTop)].Enabled    := False;
    AItems[AItems.IndexOf(MenuMoveLast)].Enabled   := False;
    AItems[AItems.IndexOf(MenuCaption)].Enabled    := False;
    AItems[AItems.IndexOf(MenuFont)].Enabled       := False;
    AItems[AItems.IndexOf(MenuChangePict)].Enabled := False;
    AItems[AItems.IndexOf(MenuHorz)].Visible       := False;
    AItems[AItems.IndexOf(MenuVert)].Visible       := False;
    AItems[AItems.IndexOf(MenuChangePict)].Visible := False;
  end else begin
    //選択コントロールがある場合
    AItems[AItems.IndexOf(MenuCreateNew)].Visible  := True;

    //マウスカーソルがコントロール上にあるかの判定
    IsOnItem := FindDragTarget(CurPos, True).ClassName = 'TLabelListItem';

    AItems[AItems.IndexOf(MenuDelete)].Enabled     := IsOnItem;
    AItems[AItems.IndexOf(MenuDeleteAll)].Enabled  := (FLabelDataList.Count > 0);
    AItems[AItems.IndexOf(MenuMoveTop)].Enabled    := IsOnItem;
    AItems[AItems.IndexOf(MenuMoveLast)].Enabled   := IsOnItem;

    if Assigned(FSelectLabel.Picture.Graphic) then begin
      AItems[AItems.IndexOf(MenuCaption)].Enabled    := False;
      AItems[AItems.IndexOf(MenuFont)].Enabled       := False;
      AItems[AItems.IndexOf(MenuChangePict)].Enabled := IsOnItem;
      AItems[AItems.IndexOf(MenuChangePict)].Visible := IsOnItem;
      AItems[AItems.IndexOf(MenuHorz)].Visible       := False;
      AItems[AItems.IndexOf(MenuVert)].Visible       := False;
    end else begin
      AItems[AItems.IndexOf(MenuCaption)].Enabled    := IsOnItem;
      AItems[AItems.IndexOf(MenuFont)].Enabled       := IsOnItem;
      AItems[AItems.IndexOf(MenuChangePict)].Visible := False;

      if FSelectLabel.Vertical then begin
        AItems[AItems.IndexOf(MenuHorz)].Visible := IsOnItem;
        AItems[AItems.IndexOf(MenuVert)].Visible := False;
      end else begin
        AItems[AItems.IndexOf(MenuHorz)].Visible := False;
        AItems[AItems.IndexOf(MenuVert)].Visible := IsOnItem;
      end;
    end;
  end;
end;

//=============================================================================
//  ポップアップメニュー[新規作成]
//  保持しておいたFMouseX,FMouseYを左上としたラベルを作成
//  新規作成時は横書き
//=============================================================================
procedure TForm1.MenuCreateNewClick(Sender: TObject);
var
  DI: TLabelListItem;
begin
  //Itemを追加
  DI := TLabelListItem.Create(nil);
  DI.Left        := FMouseX;
  DI.Top         := FMouseY;
  DI.Parent      := FParentControl;
  DI.Caption     := '新規ラベル';
  DI.AutoSize    := True;
  DI.Transparent := True;
  DI.Font.Size   := 16;
  DI.Vertical    := False;
  DI.OnMouseMove := Panel1MouseMove;
  DI.OnMouseDown := Panel1MouseDown;
  DI.OnMouseUp   := Panel1MouseUp;
  FLabelDataList.Add(DI);

  //現在の選択は解除
  if FSelectLabel <> nil then FSelectLabel.Selected := False;
  //新規作成したTplVertLabelを選択
  FSelectLabel := DI;
  FSelectLabel.Selected := True;
end;

//=============================================================================
//  ポップアップメニュー[新規画像]
//  新規に画像表示用としてラベル(TplVertLabel)を生成
//  文字列の場合と共通部分があるが，独立して記述
//  TplVertLabelのAutoSizeをTrueとしているので画像サイズと同じサイズとなる
//=============================================================================
procedure TForm1.MenuCreatePictClick(Sender: TObject);
var
  DI    : TLabelListItem;
  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);

    //Itemを追加
    DI := TLabelListItem.Create(nil);
    DI.Left        := FMouseX;
    DI.Top         := FMouseY;
    DI.Parent      := FParentControl;
    DI.AutoSize    := True;
    DI.Transparent := True;
    DI.OnMouseMove := Panel1MouseMove;
    DI.OnMouseDown := Panel1MouseDown;
    DI.OnMouseUp   := Panel1MouseUp;

    APict := TPicture.Create;
    try
      APict.LoadFromFile(OpenPictureDialog1.FileName);
      DI.Picture.Assign(APict);
    finally
      FreeAndNil(APict);
    end;
    FLabelDataList.Add(DI);

    //現在の選択は解除
    if FSelectLabel <> nil then FSelectLabel.Selected := False;
    //新規作成したTplVertLabelを選択
    FSelectLabel := DI;
    FSelectLabel.Selected := True;
  end;
end;

//=============================================================================
//  ポップアップメニュー[削除]
//  現在選択内のTplVertLabelを削除
//=============================================================================
procedure TForm1.MenuDeleteClick(Sender: TObject);
begin
  if FSelectLabel = nil then exit;

  FLabelDataList.Remove(FSelectLabel);
  FreeAndNil(FSelectLabel);
end;

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

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

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

  i := FLabelDataList.IndexOf(FSelectLabel);
  FLabelDataList.Move(i, FLabelDataList.Count - 1);
  FSelectLabel.BringToFront;
end;

//=============================================================================
//  ポップアップメニュー[最背面に移動]
//  FLabelDataListのItemを変更してSendToBackで最背面に移動　
//  ParentControlより下位には移動しない
//=============================================================================
procedure TForm1.MenuMoveLastClick(Sender: TObject);
var
  i : Integer;
begin
  if FSelectLabel = nil then exit;

  i := FLabelDataList.IndexOf(FSelectLabel);
  FLabelDataList.Move(i, 0);
  FSelectLabel.SendToBack;
end;

//=============================================================================
//  ポップアップメニュー[キャプション]
//=============================================================================
procedure TForm1.MenuCaptionClick(Sender: TObject);
begin
  if FSelectLabel = nil then exit;

  FSelectLabel.Caption := InputBox('ラベル文字列', '', FSelectLabel.Caption);
end;

//=============================================================================
//  ポップアップメニュー[フォント]
//=============================================================================
procedure TForm1.MenuFontClick(Sender: TObject);
begin
  if FSelectLabel = nil then exit;

  FontDialog1.Font := FSelectLabel.Font;
  if FontDialog1.Execute then begin
    FSelectLabel.Font.Assign(FontDialog1.Font);
  end;
end;

//=============================================================================
//  ポップアップメニュー[横書き]
//=============================================================================
procedure TForm1.MenuHorzClick(Sender: TObject);
begin
  if FSelectLabel <> nil then FSelectLabel.Vertical := False;
end;

//=============================================================================
//  ポップアップメニュー[縦書き]
//=============================================================================
procedure TForm1.MenuVertClick(Sender: TObject);
begin
  if FSelectLabel <> nil then FSelectLabel.Vertical := True;
end;

//=============================================================================
//  ポップアップメニュー[画像変更]
//  ラベル(TplVertLabel)が画像表示している時に画像を変更
//=============================================================================
procedure TForm1.MenuChangePictClick(Sender: TObject);
var
  APict : TPicture;
begin
  if FSelectLabel = nil then exit;

  //初期ディレクトリ
  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);
      FSelectLabel.Picture.Assign(APict);
      //再描画(必要)
      FParentControl.Invalidate;
    finally
      FreeAndNil(APict);
    end;
  end;
end;

end.



04_画像表示機能付き縦横両用ラベルコンポーネント


本ページで使用した TplVertLabel は，縦書きラベルコンポーネントとして利用できます．
plVertLabel.dcr と plVertLabel.pas をパスの通ったフォルダに移動してインストールして下さい．継承元の TLabel から追加したプロパティは，Vertical と Pictureのみです．

欧文フォントの縦書きで，フォントのスタイル (太字等) が反映されない場合があるようです．また，Enabled を False にしても画像は変化しません．斜体フォントの幅にも対応していません．


リスト4
画像表示機能付き縦横両用ラベルコンポーネント 
unit plVertLabel;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, StdCtrls;

type
  TplVertLabel = class(TLabel)
  private
    { Private 宣言 }
    FVertical : Boolean;
    FPicture  : TPicture;
    procedure SetVertical(const Value: Boolean);
    procedure SetPicture(const Value: TPicture);
  protected
    { Protected 宣言 }
    procedure Paint; override;
  public
    { Public 宣言 }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published 宣言 }
    property Vertical : Boolean  read FVertical write SetVertical;
    property Picture  : TPicture read FPicture  write SetPicture;
  end;

procedure Register;

implementation

{ TplVertLabel }

//=============================================================================
//  Create処理
//  クラス(コンポーネント)のコンストラクタ
//  Pictureプロパティのインスタンス(TPictureオブジェクト)を生成
//=============================================================================
constructor TplVertLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPicture := TPicture.Create;
end;

//=============================================================================
//  Destroy処理
//  TPictureオブジェクトの解放処理
//=============================================================================
destructor TplVertLabel.Destroy;
begin
  FreeAndNil(FPicture);
  inherited;
end;

//=============================================================================
//  Verticalプロパティの設定用メソッド
//  横書きか縦書きの設定
//
//  コンポーネントのプロパティを，コンポーネント内部で使用する場合は
//  グローバル変数のFVerticalを使用する
//  外部で使用するVerticalを内部で使用すると，再度のこのメソッドが実行され，
//  場合によっては循環参照となってしまうことがある
//
//  本コードはそれを防止する意味でも同じ値の時は設定を実行しないようにしている
//=============================================================================
procedure TplVertLabel.SetVertical(const Value: Boolean);
begin
  if Value <> FVertical then begin
    FVertical := Value;
    //当然再描画が必要(Paintメソッドが実行される)
    Invalidate;
  end;
end;

//=============================================================================
//  Pictureプロパティの設定用メソッド
//  オブジェクト型のプロパティの設定はAssignを使用する
//=============================================================================
procedure TplVertLabel.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

//=============================================================================
//  TLabel.Paintメソッドのオーバライド
//  TplVertLabel.Canvasへの描画処理
//
//  TextOutを使用して描画しているための制限はあるが，通常の用途には十分と考える
//  更に細かい処理が必要であれば，DrawText, DrawTextExを使用した方がいいだろう
//=============================================================================
procedure TplVertLabel.Paint;
var
  LfMode   : Integer;
  LLogFont : TLogFont;
  LPosX    : Integer;
  LPosY    : Integer;
begin
  //Pictureプロパティが有効な場合
  if Assigned(FPicture.Graphic) then begin
    //AutoSizeがTrueの場合
    if AutoSize then begin
      SetBounds(Self.Left, Self.Top, FPicture.Width, FPicture.Height);
      Canvas.Draw(0, 0, FPicture.Graphic);
    end else begin
      Canvas.StretchDraw(Rect(0, 0, Width, Height), FPicture.Graphic);
    end;
    //画像を表示した場合はテキストは描画しないので終了
    exit;
  end;

  //縦書きの時の処理
  if FVertical then begin
    //背景色
    if not Transparent then begin
      Canvas.Brush.Color := Self.Color;
      Canvas.Brush.Style := bsSolid;
      Canvas.FillRect(ClientRect);
    end;
    Canvas.Brush.Style := bsClear;

    //縦書きフォント作成して，時計方向に90度回転したフォントとする
    Canvas.Font.Assign(Self.Font);
    Canvas.Font.Name := '@' + Self.Font.Name;
    GetObject(Canvas.Font.Handle, SizeOf(LLogFont), @LLogFont);
    LLogFont.lfEscapement := -900;
    Canvas.Font.Handle := CreateFontIndirect(LLogFont);

    //AutoSizeがTrueの場合
    if AutoSize then begin
      SetBounds(Self.Left,
                Self.Top,
                Canvas.TextHeight(Caption),
                Canvas.TextWidth(Caption));
    end;

    LfMode := 0;
    LPosX  := 0;
    LPosY  := 0;

    //横方向の位置揃え
    if Alignment = taLeftJustify then begin
      LfMode := LfMode or VTA_LEFT;
    end else
    if Alignment = taCenter then begin
      LPosX  := (Width + Canvas.TextHeight(Caption)) div 2;
    end else
    if Alignment = taRightJustify then begin
      LPosX  := Width;
      LfMode := LfMode or VTA_RIGHT;
    end;

    //縦方向の位置揃え
    if Layout = tlCenter then begin
      LPosY  := (Height - Canvas.TextWidth(Caption)) div 2;
    end else
    if Layout = tlTop then begin
      LfMode := LfMode or VTA_TOP;
    end else
    if Layout = tlBottom then begin
      LPosY  := Height;
      LfMode := LfMode or VTA_BOTTOM;
    end;

    //アライメントの設定
    SetTextAlign(Canvas.Handle, LfMode);

    if not Enabled then begin
      Canvas.Font.Color := clBtnHighlight;
      Canvas.TextOut(LPosX + 1, LPosY + 1, Caption);
      Canvas.Font.Color := clBtnShadow;
    end;
    Canvas.TextOut(LPosX, LPosY, Caption);

  //横書きの時は継承元の処理を実行
  end else begin
    {AutoSizeがTrueの場合}
    if AutoSize then begin
      SetBounds(Self.Left,
                Self.Top,
                Canvas.TextWidth(Caption),
                Canvas.TextHeight(Caption));
    end;
    inherited;
  end;
end;

//=============================================================================
//  コンポーネント登録情報
//  コンポーネントパレットの[plXRAY]というタブにTplVertLableで登録
//  指定したタブがない場合は，自動的に作成される
//=============================================================================
procedure Register;
begin
  RegisterComponents('plXRAY', [TplVertLabel]);
end;

end.



05_マウスカーソル下のコントロールの取得


本ページのサンプルでは，ポップアップメニューを表示する際，どのコントロール上でポップアップメニューを表示したかを識別するために，FindDragTarget という関数を使用しています．
それによって，生成したコンポーネント上から表示した場合と，そうでない場合とでメニューの非表示や Enabled の値を変更しています．
Delphi には FindDragTarget 関数以外にも，参考リンクの記事のように，コントロールを検索する関数がいくつかあります． 


    //マウスカーソルがコントロール上にあるかの判定
    //IsOnItem := FindDragTarget(CurPos, True) is TLabelListItem;でも同じ
    GetCursorPos(CurPos);
    IsOnItem := FindDragTarget(CurPos, True).ClassName = 'TLabelListItem';



06_フォームに配置したコンポーネントの列挙


フォームに配置したコンポーネントは以下のコードで列挙できます．
ClassName でクラス名が取得でき，ClassNameIs でクラス名の確認もできますから，型キャストして，各々のコンポーネントの情報が取得できます．



リスト5
フォーム (Self) 上に配置しているコンポーネントを列挙		 
//=============================================================================
//  Form1(Self)上に配置しているコンポーネントの列挙
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LCompo : TComponent;
  i      : Integer;
begin
  Memo1.Lines.Clear;

  for i := 0 to Self.ComponentCount - 1 do begin
    LCompo := Self.Components[i];
    Memo1.Lines.Add(LCompo.Name);
  end;
end;



07_TList<T> を使用したクラス型のリストの保存の基本例


TList<T> に格納したコンポーネントの保存と読み出しの基本的な処理のコードです．
本ページのサンプルは，画像の表示やコンポーネントの移動，メニューの表示等も実装しています．以下のコードはそのような機能を実装していない，実数型と String 型のプロパティだけのクラス型の保存と読み出しのサンプルです．

クラス型のデータをファイルに保存するには，保存対象のクラスを TComponent を継承したクラス型にします．クラス型のメンバで保存できるのは published 部のプロパティだけです．


図9
保存したデータを読み出して表示

リスト6
TList<T> に格納したコンポーネントの保存と読み出しの基本的な処理コード
uses に System.StrUtils, Generics.Collections が必要		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Generics.Collections;

type
  TMyClass = class (TComponent)
  private
    FValue: Double;
    FText : string;
  published
    property Value : Double read FValue write FValue;
    property Text  : string read FText  write FText;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FClassList : TList<TMyClass>;
    FSavePathr : string;
    procedure SaveComponentList(AFilePath: string);
    procedure LoadComponentList(AFilePath: string);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  System.StrUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  本サンプルでは uses に System.StrUtils, Generics.Collections が必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // 保存ファイル名
  FSavePathr := ExtractFilePath(Application.ExeName) + 'ATest.dat';

  // コンポーネント (クラス) を格納するリストを生成
  FClassList := TList<TMyClass>.Create;
end;

//=============================================================================
//  フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
var
  LIndex : Integer;
begin
  // 生成したクラス型オブジェクトの解放処理
  for LIndex := FClassList.Count - 1 downto 0 do begin
     FClassList[LIndex].Free;
     FClassList[LIndex] := nil;
  end;
  FClassList.Clear;
  if Sender = nil then Exit;

  FreeAndNil(FClassList);
end;

//=============================================================================
//  保存ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LClass : TMyClass;
  LCount : Integer;
begin
  // テストなのでこれまでのオブジェクトは破棄
  FormDestroy(nil);

  Memo1.Lines.Clear;

  // テスト用のデータをコンポーネントのリスト (クラスのリスト) にセット
  for LCount := 0 to 2 do begin
   LClass := TMyClass.Create(Self);
   LClass.Value := (LCount + 1.0) * 100.0;
   LClass.Text  := DupeString('文字列', LCount + 1);
   FClassList.Add(LClass);
  end;
  // コンポーネントのリストを保存
  SaveComponentList(FSavePathr);
end;

//=============================================================================
//  読込ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LIndex : Integer;
begin
  // これまでのオブジェクトは破棄
  FormDestroy(nil);

  // ファイルからデータを読み込んでコンポーネントのリスト (クラスのリスト) に追加
  LoadComponentList(FSavePathr);

  Memo1.Lines.Clear;

  // 読み込んだデータを表示
  for LIndex := 0 to FClassList.Count - 1 do begin
    Memo1.Lines.Add(FloatToStr(FClassList[LIndex].Value));
    Memo1.Lines.Add(FClassList[LIndex].Text);
  end;
end;

//-----------------------------------------------------------------------------
//  クラス型のデータをコンポーネントのリストとして保存
//-----------------------------------------------------------------------------
procedure TForm1.SaveComponentList(AFilePath: string);
var
  LStream : TFileStream;
  LIndex  : Integer;
begin
  LStream := TFileStream.Create(AFilePath, fmCreate or fmOpenReadWrite);
  try
    for LIndex := 0 to FClassList.Count - 1 do begin
      LStream.WriteComponent(FClassList[LIndex]);
      Application.ProcessMessages;
    end;
  finally
    LStream.Free;
  end;
end;

//-----------------------------------------------------------------------------
//  保存してあるデータを読み出してコンポーネントのリストに格納
//-----------------------------------------------------------------------------
procedure TForm1.LoadComponentList(AFilePath: string);
var
  LClass  : TMyClass;
  LStream : TMemoryStream;
begin
  if not FileExists(FSavePathr) then exit;

  LStream := TMemoryStream.Create;
  try
    LStream.LoadFromFile(FSavePathr);

    if LStream.Size > 0 then begin
      LStream.Position := 0;
      while True do begin
        LClass := TMyClass.Create(nil);
        LStream.ReadComponent(LClass);
        FClassList.Add(LClass);

        if LStream.Position >= LStream.Size then break;
        Application.ProcessMessages;
      end;
    end;
  finally
    LStream.Free;
  end;
end;

end.


リスト操作関係のクラスにはソート関数が実装されています．TList<T> にも実装されています．それを使用したソートの例です．ファイルからデータを読み込んだ後にソートしています．
リストの並び順を逆にするだけであれば Reverse メソッドで可能です．



図10
クラスの数値型のプロパティの値でソート

リスト7
クラス型のソート		 
//-----------------------------------------------------------------------------
//  ジェネリックス TList のソート関数
//  uses に System.Math が必要
//-----------------------------------------------------------------------------
function CompareFunc(const Left, Right: TMyClass): Integer;
begin
  // これは降順の場合
  // 昇順の場合は引数を逆にする
  Result := Sign(Right.Value - Left.Value);
end;

//=============================================================================
//  読込ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LIndex : Integer;
begin
  // これまでのオブジェクトは破棄
  FormDestroy(nil);

  // ファイルからデータを読み込んでコンポーネントのリスト (クラスのリスト) に追加
  LoadComponentList(FSavePathr);

  Memo1.Lines.Clear;

  // ソート
  // TComparer関係の使用には uses に Generics.Defaults が必要
  FClassList.Sort(TComparer<TMyClass>.Construct(CompareFunc));

  // 読み込んだデータを表示
  for LIndex := 0 to FClassList.Count - 1 do begin
    Memo1.Lines.Add(FloatToStr(FClassList[LIndex].Value));
    Memo1.Lines.Add(FClassList[LIndex].Text);
  end;
end;



08_TObjectList<T> を使用したクラス型のリストの保存の基本例


TObjectList<T> に格納したコンポーネントの保存と読み出しの基本的な処理のコードです．
TObjectList を使用すると，要素のオブジェクトの解放，破棄の処理を自動で行ってくれます．それ以外の機能は TList<T> とほとんど同じです．



リスト8
TObjectList<T> に格納したコンポーネントの保存と読み出しの基本的な処理コード
uses に System.StrUtils, Generics.Collections が必要		 
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  Generics.Collections;

type
  TMyClass = class (TComponent)
  private
    FValue: Double;
    FText : string;
  published
    property Value : Double read FValue write FValue;
    property Text  : string read FText  write FText;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    FClassList : TObjectList<TMyClass>;
    FSavePathr : string;
    procedure SaveComponentList(AFilePath: string);
    procedure LoadComponentList(AFilePath: string);
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  System.StrUtils;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  本サンプルでは uses に System.StrUtils, Generics.Collections が必要
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  // 保存ファイル名
  FSavePathr := ExtractFilePath(Application.ExeName) + 'ATest.dat';

  // コンポーネント (クラス) を格納するリストを生成
  FClassList := TObjectList<TMyClass>.Create(True);
end;

//=============================================================================
//  フォーム破棄時の処理
//  TObjectList は要素のオブジェクトを自動解放する
//  Clear, Delete メソッドでも要素のオブジェクトを自動解放する
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FClassList);
end;

//=============================================================================
//  保存ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LClass : TMyClass;
  LCount : Integer;
begin
  // テストなのでこれまでのオブジェクトクリア
  FClassList.Clear;

  Memo1.Lines.Clear;

  // テスト用のデータをコンポーネントのリスト (クラスのリスト) にセット
  for LCount := 0 to 2 do begin
   LClass := TMyClass.Create(Self);
   LClass.Value := (LCount + 1.0) * 100.0;
   LClass.Text  := DupeString('文字列', LCount + 1);
   FClassList.Add(LClass);
  end;
  // コンポーネントのリストを保存
  SaveComponentList(FSavePathr);
end;

//=============================================================================
//  読込ボタン
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LIndex : Integer;
begin
  // これまでのオブジェクトはクリア
  FClassList.Clear;

  // ファイルからデータを読み込んでコンポーネントのリスト (クラスのリスト) に追加
  LoadComponentList(FSavePathr);

  Memo1.Lines.Clear;

  // 読み込んだデータを表示
  for LIndex := 0 to FClassList.Count - 1 do begin
    Memo1.Lines.Add(FloatToStr(FClassList[LIndex].Value));
    Memo1.Lines.Add(FClassList[LIndex].Text);
  end;
end;

//-----------------------------------------------------------------------------
//  クラス型のデータをコンポーネントのリストとして保存
//-----------------------------------------------------------------------------
procedure TForm1.SaveComponentList(AFilePath: string);
var
  LStream : TFileStream;
  LIndex  : Integer;
begin
  LStream := TFileStream.Create(AFilePath, fmCreate or fmOpenReadWrite);
  try
    for LIndex := 0 to FClassList.Count - 1 do begin
      LStream.WriteComponent(FClassList[LIndex]);
      Application.ProcessMessages;
    end;
  finally
    LStream.Free;
  end;
end;

//-----------------------------------------------------------------------------
//  保存してあるデータを読み出してコンポーネントのリストに格納
//-----------------------------------------------------------------------------
procedure TForm1.LoadComponentList(AFilePath: string);
var
  LClass  : TMyClass;
  LStream : TMemoryStream;
begin
  if not FileExists(FSavePathr) then exit;

  LStream := TMemoryStream.Create;
  try
    LStream.LoadFromFile(FSavePathr);

    if LStream.Size > 0 then begin
      LStream.Position := 0;
      while True do begin
        LClass := TMyClass.Create(nil);
        LStream.ReadComponent(LClass);
        FClassList.Add(LClass);

        if LStream.Position >= LStream.Size then break;
        Application.ProcessMessages;
      end;
    end;
  finally
    LStream.Free;
  end;
end;

end.