組み合わせ採点を行うプログラムを書いた際、StringGridの列に連番を自動入力したり、セルの値が同じ範囲を自動的に色分け（背景色を変更）するプログラムを書いた。これは、その備忘録。

※ Grid の列への連番自動入力他、前回の記事と重複する部分があります。ご容赦ください。

【もくじ】

１．StringGridの基本設定（VCL）
２．列に連番を自動入力
３．連番であるかチェック
４．セルの値が同じ範囲を自動判別して背景色を変更
５．同じ値のセル範囲を自動取得してフラグ化
６．お願いとお断り

１．StringGridの基本設定（VCL）

Form に StringGrid をひとつだけ用意して、次のコードを準備する。

コードは、次の通り。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    CheckBox1: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: LongInt;
      var CanSelect: Boolean);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: LongInt;
      Rect: TRect; State: TGridDrawState);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: LongInt;
      const Value: string);
  private
    { Private 宣言 }
    //StringGridの列数を設定 -> FormCreate時に設定する
    StrGrid1ColCount: Integer;
    //Formの表示終了イベントを取得
    procedure CMShowingChanged(var Msg:TMessage); message CM_SHOWINGCHANGED;

  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CMShowingChanged(var Msg: TMessage);
begin
  inherited; {通常の CMShowingChagenedをまず実行}
  if Visible then
  begin
    Update; {完全に描画}
    //セットフォーカス
    StringGrid1.Col:=1;
    StringGrid1.Row:=1;
    StringGrid1.SetFocus;
    //セルの編集を開始（ユーザーのクリックを待つ場合はコメント化する）
    StringGrid1.Options := StringGrid1.Options + [goEditing];
    //カーソルが見えるようにする
    StringGrid1.EditorMode:=True;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
begin

  //列数
  StrGrid1ColCount:=3;
  StringGrid1.ColCount:=StrGrid1ColCount;

  //FixedCols & FixedRows（固定列と固定行）を設定
  StringGrid1.FixedCols:=1;
  StringGrid1.FixedRows:=1;

  StringGrid1.Rows[0].CommaText:='番号,連番,TF';

  //FixedRows（固定行）に値をセット
  for i:= 1 to StringGrid1.RowCount do
  begin
    StringGrid1.Rows[i].Append(IntToStr(i));
  end;

end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: LongInt;
  Rect: TRect; State: TGridDrawState);
begin
  if StringGrid1.Cells[ACol,ARow]<>'' then
  begin
    //背景色を白に設定
    StringGrid1.Canvas.Brush.Color:=clWhite;
    //セルを塗りつぶす
    StringGrid1.Canvas.FillRect(Rect);
    //テキストを表示（中央寄せ）
    DrawText(StringGrid1.Canvas.Handle,
      PChar(StringGrid1.Cells[ACol,ARow]),
      //[+1]は数値描画位置の調整のため
      Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
      DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  end;
end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  //[Enter]キーでコントロールを移動
  if Ord(Key)=VK_RETURN then
  begin
    if ActiveControl is TStringGrid then
    begin
      if TStringGrid(ActiveControl).EditorMode then
      begin
        //VK_TABではカーソルがレコードの項目を右へ移動。
        //ActiveControl.Perform(WM_KEYDOWN,VK_TAB,0);
        //VK_DOWNにすると同じ項目の次のレコードへ移動。
        ActiveControl.Perform(WM_KEYDOWN,VK_DOWN,0);
        Key:=#0;
      end;
    end else begin
      SelectNext(ActiveControl,True,True);
      Key:=#0;
    end;
  end;
end;

列の編集の可否を制御したい場合は、以下のコードで実現可能。

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: LongInt;
  var CanSelect: Boolean);
begin
  //列の編集の可否
  if (ACol=StrGrid1ColCount-1) then
  begin
    //セルの編集は不可
    TStringGrid(Sender).Options:=TStringGrid(Sender).Options-[goEditing];
  end else begin
    //セルは編集可能
    TStringGrid(Sender).Options:=TStringGrid(Sender).Options+[goEditing];
  end;
end;

２．列に連番を自動入力

「常に自動入力する」設定だと、同じ値の連続入力を許可して、それを何かのフラグ（例えば組み合わせ採点の組み合わせ設問設定フラグ）として利用するような場合、後で入力値の修正が必要になったとき大変なことになるので、より実用的にするなら CheckBox などを用意して、「チェックあり」の場合のみ動作するように設定する等の工夫が必須（だと思う）。

次は、チェックボックスのチェックの有無で動作をON・OFFする場合の例。

コードは、次の通り。

procedure TForm1.StringGrid1SetEditText(Sender: TObject; ACol, ARow: LongInt;
  const Value: string);
var
  NewValue: Integer;

  procedure UpdateColumnData(StartRow, NewValue: Integer);
  var
  i: Integer;
  begin
    for i := StartRow + 1 to StringGrid1.RowCount - 1 do
      StringGrid1.Cells[StrGrid1ColCount-2, i] := IntToStr(NewValue + 1);
  end;

begin
  //チェックボックスがチェックされていたら
  if CheckBox1.Checked then
  begin
    //行を自動入力
    if ACol = StrGrid1ColCount-2 then
    begin
      if TryStrToInt(Value, NewValue) then
      begin
        UpdateColumnData(ARow, NewValue);
      end;
    end;
  end;
end;

チェックボックスにチェックした際、Grid コントロールにセットフォーカスさせたければ、次のコードも追加する。

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
  begin
    //セットフォーカス
    StringGrid1.Col:=1;
    StringGrid1.Row:=1;
    StringGrid1.SetFocus;
    //セルの編集を開始（ユーザーのクリックを待つ場合はコメント化する）
    StringGrid1.Options := StringGrid1.Options + [goEditing];
    //カーソルが見えるようにする
    StringGrid1.EditorMode:=True;
  end;
end;

実行（F9）時の動作は、次の通り（Enter キーを数回、押し下げ後の状態）。

CheckBox にチェックを入れて、１行１列目のセルをクリックしてEnterキーを押し下げる度にフォーカスが下へ移動し、連番が自動入力される。

同じ番号を入力したい場合は、手動で入力してEnterキーを押し下げ。
※ 入力値を組み合わせ採点を実行するフラグとして利用したかったため、このような仕様とした。

３．連番であるかチェック

同じ値の繰り返しを許可した上で、入力された値が連番になっているかをチェックする。
FormにButtonを１つ追加して、ボタンをクリックした際にチェックを実行。

コードは次の通り。

procedure TForm1.Button1Click(Sender: TObject);
var
  ColumnValues: TStringList;
  i: Integer;
  ErrorRows: TStringList;
  ErrorMessage: string;

  function IsSequential(Column: TStrings; out ErrorRows: TStringList): Boolean;
  var
    k, CurrentValue, ExpectedValue: Integer;
  begin
    Result := True; //初期状態で連番と仮定
    ErrorRows.Clear;

    if Column.Count = 0 then
      Exit; //空の場合は連番とみなす

    CurrentValue := StrToInt(Column[0]);
    for k := 1 to Column.Count - 1 do
    begin
      //現在の値が同じであれば次の行へ
      if StrToInt(Column[k]) = CurrentValue then
      begin
        Continue;
      end else begin
        //現在の値が変わった場合、期待される次の値は1増加
        ExpectedValue := CurrentValue + 1;
        //期待される次の値と一致しなければ連番ではない（同じ値のくり返しは許可する）
        //if StrToInt(Column[k]) <> ExpectedValue then
        if (StrToInt(Column[k]) = CurrentValue) or
          (StrToInt(Column[k]) <> ExpectedValue) then
        begin
          Result := False;
          //エラーの行番号を追加（1から始まるインデックスのため +1）
          ErrorRows.Add(IntToStr(k + 1));
          Exit;
        end else begin
          CurrentValue := ExpectedValue;
        end;
      end;
    end;
  end;

begin
  //連番になっていることを確認
  ColumnValues := TStringList.Create;
  ErrorRows := TStringList.Create;
  try
    //StringGridの第1列（インデックス0）を取得
    for i := 1 to StringGrid1.RowCount - 1 do
    begin
      ColumnValues.Add(StringGrid1.Cells[1, i]);
    end;
    if IsSequential(ColumnValues, ErrorRows) then
    begin
      ShowMessage('連番です');  //確認用
    end else begin
      //連番でない行がある場合のメッセージ
      ErrorMessage := ErrorRows.CommaText + ' 行目が連番ではありません！';
      Application.MessageBox(PChar(ErrorMessage), PChar('エラー'), MB_ICONSTOP);
      StringGrid1.Col:=1;
      StringGrid1.Row:=StrToInt(ErrorRows.CommaText);
      StringGrid1.SetFocus;
      Exit;
    end;
  finally
    ColumnValues.Free;
    ErrorRows.Free;
  end;
end;

実行（F9）して、動作テスト。

同じ値の繰り返しは許可するようにコーディングしたので、次のような場合は連番と判断する。

        //期待される次の値と一致しなければ連番ではない（同じ値のくり返しは許可する）
        //if StrToInt(Column[k]) <> ExpectedValue then
        if (StrToInt(Column[k]) = CurrentValue) or
          (StrToInt(Column[k]) <> ExpectedValue) then
        begin

４．セルの値が同じ範囲を自動判別して背景色を変更

業務用のプログラムでは、上の図のように同じ値が繰り返し入力されているセルがたやすく見分けられるように工夫した方が好ましいと考え、セルの値が同じ範囲を自動判別して背景色を変更するコードを追加する。

まず、uses に System.Generics.Collections を動的配列要素のSortのために追加。

implementation

uses
  System.Generics.Collections;

{$R *.dfm}

次に、Gridコントロールの OnDrawCell 手続きに以下のコードを記述。

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: LongInt;
  Rect: TRect; State: TGridDrawState);
var
  Value: String;
  CellColor: TColor;
  ColorMap: TDictionary<String, TColor>;

  function GetLightColor(BaseColor: TColor): TColor;
  var
    R, G, B: Byte;
    pct: Double;  //パーセントを指定する変数
  begin
    // RGB値を取得
    R := GetRValue(ColorToRGB(BaseColor));
    G := GetGValue(ColorToRGB(BaseColor));
    B := GetBValue(ColorToRGB(BaseColor));

    //薄い色に調整（50%白に近づける場合）
    //R := (R + 255) div 2;
    //G := (G + 255) div 2;
    //B := (B + 255) div 2;

    //80%白に近づける場合
    //元のRGB値を20%だけ残し、残りの80%を白（255, 255, 255）に近づける
    //R := Round(R * 0.2 + 255 * 0.8);
    //G := Round(G * 0.2 + 255 * 0.8);
    //B := Round(B * 0.2 + 255 * 0.8);

    //薄い色に調整
    pct:=StrToFloat('0.' + ComboBox1.Text);
    R := Round(R * (1-pct) + 255 * pct);
    G := Round(G * (1-pct) + 255 * pct);
    B := Round(B * (1-pct) + 255 * pct);

    Result := RGB(R, G, B);
  end;

  procedure AssignColorsToValues(ACol: Integer);
  var
    i: Integer;
    Value: String;
    BaseColors: TArray<TColor>;  //動的配列として宣言（解放はDelphiにまかせる）
    ColorIndex: Integer;
  begin
    ColorMap.Clear;
    ColorIndex := 0;

    BaseColors:=[clRed, clGreen, clBlue, clYellow, clAqua, clFuchsia];

    for i := 1 to StringGrid1.RowCount - 1 do
    begin
      Value := StringGrid1.Cells[ACol, i];
      if not ColorMap.ContainsKey(Value) then
      begin
        //色を薄く調整したものを登録
        ColorMap.Add(Value, GetLightColor(BaseColors[ColorIndex mod Length(BaseColors)]));
        Inc(ColorIndex);
      end;
    end;
  end;

begin

  //前掲のコードは、Gridの初期化も兼ねる
  if StringGrid1.Cells[ACol,ARow]<>'' then
  begin
    //背景色を白に設定
    StringGrid1.Canvas.Brush.Color:=clWhite;
    //セルを塗りつぶす
    StringGrid1.Canvas.FillRect(Rect);
    //テキストを表示（中央寄せ）
    DrawText(StringGrid1.Canvas.Handle,
      PChar(StringGrid1.Cells[ACol,ARow]),
      //[+1]は数値描画位置の調整のため
      Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
      DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  end;

  if ARow = 0 then Exit; //ヘッダー行はスキップ

  ColorMap := TDictionary<String, TColor>.Create;

  //色分け対象列を指定
  AssignColorsToValues(1); //ColorMapをCreateしてから呼び出すこと！

  try
    if ACol = 1 then //対象列をチェック
    begin
      Value := StringGrid1.Cells[ACol, ARow];
      if ColorMap.TryGetValue(Value, CellColor) then
      begin
        StringGrid1.Canvas.Brush.Color := CellColor;
        StringGrid1.Canvas.FillRect(Rect);
        //テキストを表示（中央寄せ）_[+1]は数値描画位置の調整のため
        DrawText(StringGrid1.Canvas.Handle,
          PChar(StringGrid1.Cells[ACol,ARow]),
          Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
          DT_CENTER or DT_VCENTER or DT_SINGLELINE);
      end;
    end else begin
      StringGrid1.Canvas.FillRect(Rect);
      //テキストを表示（中央寄せ）_[+1]は数値描画位置の調整のため
      DrawText(StringGrid1.Canvas.Handle,
        PChar(StringGrid1.Cells[ACol,ARow]),
        Length(StringGrid1.Cells[ACol,ARow])+1,Rect,
        DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    end;
  finally
    ColorMap.Free;
  end;

end;

さらに、FormCreate 手続きで ComboBox の選択肢の準備と初期化を行うように設定。

procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
begin

  //前掲の通りなので略

  //色の濃さを調節
  for i := 1 to 99 do
  begin
    ComboBox1.Items.Add(IntToStr(i));
  end;

  //初期値を設定
  ComboBox1.Text:='50';

end;

連番で実行（F9）した場合、

同じ値を適当に入力してみた場合、

５．同じ値のセル範囲を自動取得してフラグ化

１．基本設定の最後で「列の編集の可否を制御したい場合は、以下のコードで実現可能」としたのは、実はTFフィールドをフラグとして利用したかったため。

具体的に何がしたかったかと言うと、TF列の任意のセルをクリックしたとき、その左の連番列の同じ値が入力されているセルを自動判別して、TF列の同じセル範囲にクリックで「１」を、スペース押し下げで「０」を自動（切り替え）入力するトグル的操作の実現。

実用上の目的は、連番列で同じ番号が入力されている（＝同じ背景色）セルを処理上はセットにして扱うが、TF列に設定されている値が「１」であるセルと、「０」であるセルとで行う処理の内容を分けたいというもの。

つまり、連番列で同じ番号が入力されているセルは「組み合わせ」て採点し、さらにTF列の値が「１」であれば「順不同」で採点を行いたい場合のフラグとして利用できるようにしたかった。

そのための布石として、TF列の自由な編集を不可に設定。

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: LongInt;
  var CanSelect: Boolean);
begin
  //列の編集の可否
  if (ACol=StrGrid1ColCount-1) then
  begin
    //セルの編集は不可
    TStringGrid(Sender).Options:=TStringGrid(Sender).Options-[goEditing];
  end else begin
    //セルは編集可能
    TStringGrid(Sender).Options:=TStringGrid(Sender).Options+[goEditing];
  end;
end;

共通利用する手続きとして、次の手続きを追加（Shift＋Ctrl＋C で TForm1 のメンバとして作成）。

  private
    { Private 宣言 }

    //状態の切り替え
    procedure ToggleSGCell(ACol, ARow: Integer);
    procedure UpdateColumnData(Value: Integer; IsChecked: Boolean);

ToggleSGCell 手続きのコードは、次の通り。

procedure TForm1.ToggleSGCell(ACol, ARow: Integer);
begin
  //現在の値を切り替え
  if StringGrid1.Cells[ACol, ARow] = '1' then
    StringGrid1.Cells[ACol, ARow] := '0'
  else
    StringGrid1.Cells[ACol, ARow] := '1';

  //再描画をトリガ（即座に変更を表示）
  StringGrid1.Invalidate;
end;

UpdateColumnData のコードは、次の通り。

procedure TForm1.UpdateColumnData(Value: Integer; IsChecked: Boolean);
var
  i: Integer;
  NewValue: string;
begin

  if IsChecked then
  begin
    NewValue := '1';
  end else begin
    NewValue := '0';
  end;

  for i := 1 to StringGrid1.RowCount - 1 do
  begin
    if StrToInt(StringGrid1.Cells[StrGrid1ColCount-2, i]) = Value then
    begin
      StringGrid1.Cells[StrGrid1ColCount-1, i] := NewValue;
    end;
  end;

  //再描画をトリガ（即座に変更を表示）
  StringGrid1.Invalidate;
end;

プログラムの仕様として、TF列の任意のセルをクリックしたら、連番列の値を調査して同じ値が連続して入力されているセル全てに「１」を入力したいので、OnMouseDown 手続きに次のコードを記述。

procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Col, Row: Integer;
begin
  //マウスクリックでセルの０と１を切り替え
  StringGrid1.MouseToCell(X, Y, Col, Row);
  if (Col = StrGrid1ColCount-1) and (Row > 0) then
    ToggleSGCell(Col, Row);
end;

で、OnMouseUp イベントで連番列の値を判定。同じ値の入力されているセル範囲を取得して、TF列の同じ行に「１」を自動入力する。

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ACol, ARow: Integer;
begin
  //マウスでクリックして、指を離したときのイベント
  StringGrid1.MouseToCell(X, Y, ACol, ARow);

  //if (ACol = StrGrid1ColCount-1) and (ARow >= 0) then
  //0行目（FixedRow）では動作しないように設定
  if (ACol = StrGrid1ColCount-1) and (ARow > 0) then
    //UpdateColumnData(ARow);
    //引数にはCMS設定値が入る
    UpdateColumnData(StrToInt(StringGrid1.Cells[StrGrid1ColCount-2, ARow]), True);
end;

TF列の任意のセルをクリックして、スペースキー押し下げで入力値を「０」に切り替える。

procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  //スペースキーで０と１を切り替え
  if (StringGrid1.Col = StrGrid1ColCount-1) and (StringGrid1.Row > 0) and (Key = VK_SPACE) then
  begin
    ToggleSGCell(StringGrid1.Col, StringGrid1.Row);
    UpdateColumnData(StrToInt(StringGrid1.Cells[StrGrid1ColCount-2, StringGrid1.Row]), False);
    Key := 0;
  end;
end;

TF列をゼロで初期化するため、FormCreate 手続きの既存のコードに次のコードを追加。

  //FixedRows（固定行）に値をセット
  for i:= 1 to StringGrid1.RowCount do
  begin
    StringGrid1.Rows[i].Append(IntToStr(i));
    //TF列をゼロで初期化
    StringGrid1.Cells[2,i] := '0';
  end;

実行（F9）の動作は、次の通り。

TF列の任意のセル（５行目）をクリックした場合。

同じセルをクリックして選択後、スペースキー押し下げでゼロに切り替え。

６．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容（プログラムを含む）利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

Delphiで、どうしても書きたいプログラムがあった。
そのために絶対に越えなければならないハードルが、データの印刷プレビューと印刷だ。

正直、これは、ごく簡単に思えてならないことなんだけれど･･･
今まで何度もチャレンジして、そのたびに失敗してきた。。。

今回、ようやく、自分自身、納得の行くものが書けた。
これはその備忘録。

【もくじ】

１．印刷したいデータを準備
２．罫線も印刷する
３．CSVファイルをStringGridに表示する
４．印刷のコード
５．rect:TRectとしてはいけません！
６．印刷プレビューのコード
７．まとめ
８．お願いとお断り

１．印刷したいデータを準備

表計算ソフトを使って、印刷したいデータを作成し、CSV形式で保存する。
例えば、こんな感じ。

書きたい印刷プログラムは、A4版・縦の用紙に収まる範囲の列数で、行数は１ページに最高50行を予定。ただし、データとして50行なので、フィールド名を入れれば１ページあたり51行となる。

CSVファイルの先頭には「フィールド名も保存」する。ただし、フィールド名があるのはファイルの先頭のみ。50行ごとに入れたりはしない。

自分の場合、印刷データが50行を超えることは、まず「ない」･･･のだが、冒頭で述べた「どうしても書きたいプログラム」の使用予定者の中にはそうでない方もいる。

なので、書きたいプログラムでは、データ数（＝行数）がどんなに増えても、各ページの先頭行にはフィールド名を入れる仕様とする。これは譲れない自分との約束。

２．罫線も印刷する

これも、どうしても越えたいハードルのひとつ。フォントの大きさに関係なく、１行毎に罫線（＝下線）を印刷する。もちろん、「罫線無し」の印刷も可能とするが、「罫線有り」の場合は１ページについて必ず51行分の罫線が引かれるのではなく、印刷する行数に合わせて罫線（＝下線）を引くようにしたい。

今まで、これがどうしても「できなかった」。

だから、この壁は必ず乗り越える。これも譲れない自分との約束。

追記（20240901）

フォントの大きさは９ポイントに固定しました。

３．CSVファイルをStringGridに表示する

Delphiを起動。次の構造ペインに示すような形でVCLコントロールをForm上に配置。

Formは常に最大化して表示されるように設定。FormCreate手続きに次のコードを記述。

procedure TForm1.FormCreate(Sender: TObject);
begin
  //Formを最大化して表示(幅も最大化される)
  Form1.WindowState:=wsMaximized;
end;

この場合は、Form1が親だからこれでOKだが、子の場合は注意が必要。

どこに記述するか？
・自分自身が親Formの場合：FormCreateでOK!
・自分自身が子Formの場合：FormShowに書くこと（FormCreateに書くと一般保護違反のエラーが発生する）
・自分自身が子Formの場合にFormのWindowStateプロパティで直接指定しておいたらMy環境では何の問題もなく動作した。

また、Form1のScaledプロパティをFalseに設定することも忘れない。

これをTrue にすると OS の DPI （ユーザが指定した DPI）によってフォームサイズやコントロールサイズが勝手に変更されてしまう。デフォルトでTrueなので注意が必要。Formを作成したら毎回忘れずに設定する。

で、exeがあるフォルダ以下の構成は次の通り。この階層構造をもとにしてPathを設定する。

StringGridに読み込むCSVファイルの置き場所は、「\sNameフォルダ」とする。

これを読み込んでStringGridに表示する。OpenDialogをFormに追加する。

読み込むCSVファイルのデータは次の通り。
（フィールド名が「ない」場合や、データに通し番号がなく、行番号を表示したい場合にも対応できるコードを含めて記述した。必要ない部分はコメントアウトしている）

次のコードを記述。

procedure TForm1.Button1Click(Sender: TObject);
var
  //CSVファイルの読み込み
  CSVFileName: string;
  CsvFile:TextFile;
  CsvRowStr: string;
  i: Integer;
  strMsg: string;
  //列幅の調整
  iCOL: Integer;
  MaxColWidth: Integer;
  iROW: Integer;
  TmpColWidth: Integer;
begin

  //表示設定
  StringGrid1.Visible:=False;

  //列数
  StringGrid1.ColCount:=7;

  //OpenDialogのプロパティはExecuteする前に設定しておくこと
  With OpenDialog1 do begin
    //表示するファイルの種類をcsvに設定
    Filter:='CSVファイル(*.csv)|*.csv';
    //データの読込先フォルダを指定
    InitialDir:=ExtractFilePath(Application.ExeName)+'sName';
  end;

  //ダイアログ呼び出し
  if OpenDialog1.Execute then
  begin
    CsvFileName:=OpenDialog1.FileName;
    AssignFile(CsvFile, CsvFileName);
    Reset(CsvFile);
  end else begin
    strMsg:='ユーザーによる処理のキャンセル';
    Application.MessageBox(PChar(strMsg), PChar('情報'), MB_ICONINFORMATION);
    Exit;
  end;

  //フィールド名が必要なCSVファイルなら記述する
  //StringGrid1.Rows[0].CommaText:=
  //  '通し番号,氏名,よみがな,年齢,生年月日,性別,血液型';
  //Fixed Colが１列あって、そこに行番号を設定する場合
  //  ',通し番号,氏名,よみがな,年齢,生年月日,性別,血液型';

  //読込み開始行を指定（FixedRowがある場合 -> ない場合は[0]にする）
  i:=0;
  try
    while not EOF(CsvFile) do
    begin
      //CSVファイルを1行読み込み、その1行分を文字列として代入する。
      Readln(CsvFile, CsvRowStr);
      //グリッドの行数が読み込み行数より少なければ、グリッドの行数を追加する。
      if StringGrid1.RowCount <= i then StringGrid1.RowCount := i + 1;
      //グリッドの指定行目に読み込み行を代入
      //[0]列はFixedCol-> 行番号を設定したい場合
      //StringGrid1.Rows[i].CommaText:=IntToStr(i)+','+CsvRowStr;
      StringGrid1.Rows[i].CommaText:=CsvRowStr;
      i := i + 1;
    end;
  finally
    //行番号を設定した場合
    //StringGrid1.Cells[0,0]:='行番号';
    CloseFile(CsvFile);
  end;

  //列幅の自動調整
  for iCOL := 0 to StringGrid1.ColCount-1 do
  begin
    MaxColWidth := 0;
    for iROW := 0 to StringGrid1.RowCount-1 do
    begin
      TmpColWidth := Canvas.TextWidth(StringGrid1.Cells[iCOL,iROW]) + 10;
      if MaxColWidth < TmpColWidth then
        MaxColWidth := TmpColWidth;
    end;
    StringGrid1.ColWidths[iCOL] := MaxColWidth;
  end;

  //表示設定
  StringGrid1.Visible:=True;

end;

実行結果は次の通り。

以下、データを読み込む上での注意のあれこれ。

まず、CSVファイルの文字コードがUTF-8だと･･･

また、氏名やよみがなの「姓と名の間にあるスペースが全角でなく、半角」だと･･･

CSVファイルのデータ形式には、文字コードも含めて十分、注意する必要がある。

４．印刷のコード

正直に言うと、今回のチャレンジでは「印刷プレビュー」のプログラムの方を先に書いた。
自分自身の感覚に自信などあるわけないが、通常（？）の感覚からすれば「印刷プレビュー」⇨「印刷」という流れが自然であるような気がして、そうなったのだ。

そこで問題になったのがデータ数が多く、印刷（出力）が「複数ページ」となる場合、プレビューの２枚目、３枚目をどう表示するか？ という部分。

先に述べた通り、２枚目以降の先頭行にも「フィールド名を表示」するという自分との約束もあったし･･･。この「ページ毎、先頭行にはフィールド名を表示する」処理の方法をいろいろ考え、試してみたが、どうにも上手く行かない。

これだ！ と思える処理手順が思いつかないまま、１ページ目だけの表示であれば問題なくできるプログラムを作成。とりあえず、印刷プレビューは１ページ目だけ表示することで妥協して、（仮）印刷プレビュープログラムとしておき、複数ページの印刷に対応した印刷プログラムが完成したら、もう一度、夢見た通りの印刷プレビューとなるよう、ここに戻ってくることにする。

そうして様々な問題をひとつひとつ自分なりに丁寧にクリアして最終的に書き上げたのが、下に掲載した「印刷」のプログラムコード（データ全体の行数や列数は限定せず、汎用的に使える＝再利用できるコードを目指したつもりだが、どうだろうか？）。

FormにPrinterSetupDialog、その他のVCLコントロールを追加。

if PrinterSetupDialog1.Execute then ～で、呼び出したDialogの画面。

Button2は「印刷プレビュー」機能を、Button3は「印刷」機能を、それぞれ割り当てる予定。
なので、Button3をダブルクリックして手続きを作成し、「印刷」プログラムのコードを入力。

implementation

uses
  System.Math,
  Vcl.Printers;

procedure TForm1.Button3Click(Sender: TObject);
var
  //用紙サイズ、縦置き・横置きの設定を知る(Charだと推奨されない警告が表示される->Stringに変更)
  //Device, Driver, Port: array[0..255] of Char;
  Device, Driver, Port: string;
  DeviceMode: THandle;
  DevMode: PDeviceMode;

  //StringGrid->CSVファイル名とそこまでのPathを入れる
  csvFN:string;

  StringList: TStringList;
  i, j, k, MaxWidth: Integer;
  Fields: TStringList;
  FieldWidths: array of Integer;
  ColMargin: Integer;
  MarginX, MarginY: Integer;
  intLoop: Integer;
  FontHeight: Integer;
  eNum: Integer;
  iPlus: Integer;
  myFieldElement: string;
  LowNum: Integer;
  HighNum: Integer;
  MyRect:TRect;
  //平均値・最高値・最低値 -> 汎用性を考えExtended ではなく、Double とした
  DSum: Double;
  DAvg: Double;
  MinValue, MaxValue: Double;
  intDenomin: Double;

  //StringGrid -> CSV File
  procedure SaveStringGridToCSV(StringGrid: TStringGrid; const FileName: string);
  var
    CSVFile: TextFile;
    Row, Col: Integer;
    Line: string;
  begin
    AssignFile(CSVFile, FileName);
    Rewrite(CSVFile);
    try
      for Row := 0 to StringGrid.RowCount - 1 do
      begin
        Line := '';
        for Col := 0 to StringGrid.ColCount - 1 do
        begin
          Line := Line + StringGrid.Cells[Col, Row];
          if Col < StringGrid.ColCount - 1 then
            Line := Line + ',';
        end;
        WriteLn(CSVFile, Line);
      end;
    finally
      CloseFile(CSVFile);
    end;
  end;

  // ビットマップ用印刷ルーチン
  procedure StretchDrawBitmap(Canvas:TCanvas;  // 描画先キャンバス
                              r : TRect;       // 描画先範囲
                              Bitmap:TBitmap); // ビットマップ
  const
    InfoSize = SizeOf(TBitmapInfoHeader) + 4 * 256;
  var
    OldMode   : integer;      // StretchModeの保存用
    pInfo     : PBitmapInfo;  // DIBヘッダ＋カラーテーブルへのポインタ

    InfoData  : array[0..InfoSize-1] of Byte; // DIBヘッダ＋カラーテーブル
    Image     : array of Byte;// DIBのピクセルデータ
    DC        : HDC;          // GetDIBits 用 Device Context
    OldPal    : HPALETTE;     // パレット保存用
  begin
    pInfo :=@InfoData;

    // 24 Bit DIB の領域を確保
    SetLength(Image, ((Bitmap.Width * 24 + 31) div 32) * 4 * Bitmap.Height);

    // DIB のBitmapInfoHeader を初期化
    with pInfo^.bmiHeader do begin
      biSize := SizeOf(TBitmapInfoHeader);
      biWidth := Bitmap.Width;     biHeight := Bitmap.Height;
      biPlanes := 1;               biBitCount := 24;
      biCompression := BI_RGB;
    end;

    // 24bpp DIB イメージを取得
    DC := GetDC(0);
    try
      OldPal := 0;
      if Bitmap.Palette <> 0 then
        OldPal := SelectPalette(DC, Bitmap.Palette, True);

      GetDIBits(DC, Bitmap.Handle, 0, Bitmap.Height,
                Image, pInfo^, DIB_RGB_COLORS);
      if OldPal <> 0 then SelectPalette(DC, OldPal, True);
    finally
      ReleaseDC(0, DC);
    end;

    // 拡大モードを カラー用に変更
    OldMode:=SetStretchBltMode(Canvas.Handle,COLORONCOLOR);

    // 描画！！
    StretchDIBits(Canvas.Handle,
                  r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top,
                  0,0,pInfo^.bmiHeader.biWidth,pInfo^.bmiHeader.biHeight,
                  Image,pInfo^,DIB_RGB_COLORS,SRCCOPY);
    // 拡大モードを元に戻す
    SetStretchBltMode(Canvas.Handle,OldMode);
  end;

  procedure GetMinMaxValues(StringGrid: TStringGrid; ColIndex: Integer; out MinValue, MaxValue: Double);
  var
    Row: Integer;
    Value: Double;
  begin
    if StringGrid.RowCount = 0 then
      raise Exception.Create('StringGridにデータがありません。');

    MinValue := MaxDouble;
    MaxValue := -MaxDouble;

    for Row := 1 to StringGrid.RowCount - 1 do
    begin
      if TryStrToFloat(StringGrid.Cells[ColIndex, Row], Value) then
      begin
        if Value < MinValue then
          MinValue := Value;
        if Value > MaxValue then
          MaxValue := Value;
      end;
    end;

    if MinValue = MaxDouble then
      raise Exception.Create('指定された列に数値データがありません。');
  end;

begin

  //複数回クリックを防止する
  Button3.Enabled:=False;

  //初期化
  Image1.Picture:=nil;
  Image2.Picture:=nil;
  Image1.Visible:=False;
  Image2.Visible:=False;

  //印刷設定（用紙・向き）後に印刷
  if PrinterSetupDialog1.Execute then
  begin

    //プリンタの設定を取得
    Printer.GetPrinter(Device, Driver, Port, DeviceMode);
    DevMode := GlobalLock(DeviceMode);
    try
      //用紙サイズをA4に設定
      DevMode^.dmPaperSize := DMPAPER_A4;
      //用紙方向を縦に設定
      DevMode^.dmOrientation := DMORIENT_PORTRAIT;
      //設定をプリンタに反映
      Printer.SetPrinter(Device, Driver, Port, DeviceMode);
    finally
      GlobalUnlock(DeviceMode);
    end;

    //プリンタの解像度を取得
    //DPI := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
    //家庭用のEPSONのプリンタは360DPI
    //業務用のEPSONの複合機は、600DPI
    //FinePrintは、600DPI

    //A4サイズの用紙の寸法は210mm x 297mm。インチに換算:約8.27インチ x 11.69インチ
    //プリンタの解像度（DPI: Dots Per Inch）

    //100DPIの場合
    //幅: 8.27インチ × 100 DPI = 827ピクセル
    //高さ: 11.69インチ × 100 DPI = 1169ピクセル

    //200DPIの場合
    //幅: 8.27インチ × 200 DPI = 1654ピクセル
    //高さ: 11.69インチ × 200 DPI = 2338ピクセル

    //100DPIとして描画したものをStretchDrawする

    //TImageの初期設定
    Image1.Width := 827;
    Image1.Height := 1169;
    Image1.Picture.Bitmap.Width := 827;
    Image1.Picture.Bitmap.Height := 1169;

    //背景を塗りつぶす
    Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
    MyRect:=Rect(0, 0, 827, 1169);
    Image1.Picture.Bitmap.Canvas.FillRect(MyRect);

    //使用するフォント（必ず等幅フォントを指定する）
    //数値の右揃え用に追加（20240820）
    Image1.Picture.Bitmap.Canvas.Font.Name:='Consolas';

    //フォントサイズ -> 実際にはComboBoxで指定・選択できるようにする
    Image1.Picture.Bitmap.Canvas.Font.Size:=11;

    //平均値を計算 -> 実際のプログラムではこのような計算も行っている
    {
    DSum:=0;
    for i := 1 to StringGrid1.RowCount do
    begin
      if StringGrid1.Cells[5,i] <> '' then
      begin
        DSum:= DSum + StrToInt(StringGrid1.Cells[5,i]);
      end;
    end;
    DAvg:= SimpleRoundTo(DSum / intDenomin, -2);

    //最高値及び最低値を計算
    GetMinMaxValues(StringGrid1, 5, MinValue, MaxValue);
    }

    //StringGrid -> CSV
    //実際のプログラムでは、sNameフォルダ内のCSVファイルを読み込み、
    //さらに幾つかフィールドを追加して新しいデータを追加している。
    //追加したデータを含めて印刷する仕様

    //実際のプログラムでは、LabelSaveFolderName.Captionは別手続きで取得・表示済み
    LabelSaveFolderName.Caption:='SampleData';

    //保存するフォルダへのPath
    csvFN:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+
      'ProcData\'+LabelSaveFolderName.Caption+'\';

    //フォルダの存在を確認、なければ作成
    if not System.SysUtils.DirectoryExists(ExtractFileDir(csvFN)) then
    begin
      //フォルダ階層を作成
      System.SysUtils.ForceDirectories(ExtractFileDir(csvFN));
    end;

    csvFN:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+
      'ProcData\'+LabelSaveFolderName.Caption+'\'+LabelSaveFolderName.Caption+'.csv';
    SaveStringGridToCSV(StringGrid1, csvFN);

    StringList:=TStringList.Create;
    Fields:=TStringList.Create;

    try

      //Create
      StringList.LoadFromFile(csvFN);
      //Create
      SetLength(FieldWidths, 0);

      //各フィールドの最大幅を計算
      for i := 0 to StringList.Count - 1 do
      begin
        Fields.CommaText := StringList[i];
        if Length(FieldWidths) < Fields.Count then
          SetLength(FieldWidths, Fields.Count);

        for j := 0 to Fields.Count - 1 do
        begin
          //MaxWidth := Printer.Canvas.TextWidth(Fields[j]);
          MaxWidth := Image1.Picture.Bitmap.Canvas.TextWidth(Fields[j]);
          if FieldWidths[j] < MaxWidth then
            FieldWidths[j] := MaxWidth;
        end;
      end;

      eNum:=StringList.Count div 50;

      //51,101,151,201,251,301,･･･,XX1番目にフィールド名を挿入しておく

      //0番目の要素をコピー
      myFieldElement:=StringList[0];
      //要素を挿入（追加）
      if eNum<>0 then
      begin
        for i := 1 to eNum do
        begin
          StringList.Insert((50*i)+1, myFieldElement);
        end;
      end;

      //ここから印刷Loop
      try

        for intLoop := 0 to eNum do
        begin

          //初期化（白紙にする）
          Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
          MyRect:=Rect(0, 0, 827, 1169);
          Image1.Picture.Bitmap.Canvas.FillRect(MyRect);

          if intLoop=0 then
          begin
            Printer.BeginDoc;
          end else begin
            Printer.NewPage;
          end;

          //タイトルを描画
          Image1.Picture.Bitmap.Canvas.Font.Color:=clBlue;
          Image1.Picture.Bitmap.Canvas.TextOut(
            StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30,
            LabelSaveFolderName.Caption);

          //タイトルを描画
          {
          Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
          Image1.Picture.Bitmap.Canvas.TextOut(
            StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30,
            LabelSaveFolderName.Caption + '　【平均値：'+FloatToStr(DAvg)+
            '、最高値：'+ FloatToStr(MaxValue)+
            '、最低値：'+ FloatToStr(MinValue)+'】');
          }

          Image1.Picture.Bitmap.Canvas.Font.Color:=clBlack;

          k:=0;
          MarginX:=StrToInt(EditMarginX.Text);
          MarginY:=StrToInt(EditMarginY.Text);
          ColMargin:=StrToInt(EditColMargin.Text);

          iPlus:=0;
          //次のcase文でelseを使って何らかの値が必ず代入されるようにしたので不要
          //LowNum:=0;
          //HighNum:=0;

          case intLoop of
            0:begin
              LowNum:=0;
              if StringList.Count > 50 then
              begin
                HighNum:=50;
              end else begin
                HighNum:=StringList.Count-1;
              end;
            end;
            {
            1:begin
              LowNum:=51;
              if StringList.Count > 100 then
              begin
                HighNum:=100;
              end else begin
                HighNum:=StringList.Count-1;
              end;
            end;
            2:begin
              LowNum:=101;
              if StringList.Count > 150 then
              begin
                HighNum:=150;
              end else begin
                HighNum:=StringList.Count-1;
              end;
            end;
            }
          else
            //一般化
            LowNum:=(intLoop*50)+1;
            if StringList.Count > (intLoop*50)+50 then
            begin
              HighNum:=(intLoop*50)+50;
            end else begin
              HighNum:=StringList.Count-1;
            end;
          end;

          for i := LowNum to HighNum do
          begin
            Fields.CommaText := StringList[i];
            for j := 0 to Fields.Count - 1 do
            begin
              //処理できる列数を無制限にする
              case j of
                0:k:=0;
              else
                k:=k+FieldWidths[j-1]+ColMargin;
              end;
              //フィールド名に「備考」を追加する
              if i=0 then
              begin
                if j=Fields.Count-1 then
                begin
                  Fields[j]:=Fields[j]+'　備考';
                end;
              end;

              //データを出力（数値の右揃え：なし）
              //Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);

              //データを出力（数値の右揃え：あり））
              //数値の右揃え用に追加（20240820
              if TryStrToInt(Fields[j], intValue) then
              begin
                //数値である -> 右揃えで出力する
                Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),
                  Format('%3d', [strToInt(Fields[j])]));
              end else begin
                //数値でない -> 左揃えで出力する
                Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
              end;

              //罫線を描画
              if cbLine.Checked then
              begin
                Image1.Picture.Bitmap.Canvas.Pen.Color:= clBlack;
                FontHeight:= -1 * Image1.Picture.Bitmap.Canvas.Font.Height;
                Image1.Picture.Bitmap.Canvas.MoveTo(MarginX+k, MarginY+(iPlus*20)+FontHeight+4);
                Image1.Picture.Bitmap.Canvas.LineTo(Image1.Picture.Bitmap.Width-50, MarginY+(iPlus*20)+FontHeight+4);
              end;
            end;
            inc(iPlus);
          end;

          //大きさを指定
          MyRect.Top:=0;
          MyRect.Left:=0;
          MyRect.Bottom:= Trunc((Printer.PageWidth / Image1.Picture.Width) * Image1.Picture.Height);
          MyRect.Right:= Printer.PageWidth;
          //ファイルを描画
          StretchDrawBitmap(Printer.Canvas, MyRect, Image1.Picture.Bitmap);
          Application.ProcessMessages;

        end;  //intLoop

      finally
        Printer.EndDoc;
      end;

    finally
      StringList.Free;
      Fields.Free;
      //複数回クリックを防止する
      Button3.Enabled:=True;
    end;

    //ファイルの完全削除
    DeleteFile(PChar(csvFN));

    //TImageの表示位置を指定
    ScrollBox1.VertScrollBar.Position:=0;
    ScrollBox1.HorzScrollBar.Position:=0;
    Image1.Top:=ScrollBox1.VertScrollBar.Position+14;
    Image1.Left:=ScrollBox1.HorzScrollBar.Position+14;

    //TImageの表示
    Image1.Visible:=True;  //印刷プレビューを実行しなければ不要

    Button2Click(Sender);  //印刷プレビューを表示する

  end else begin
    //キャンセルに対応
    Button2Click(Sender);  //印刷プレビューを表示する
  end;

end;

上のコードには、このサンプルでの処理には不要な部分や、（コードを一般化する前に場合分けして処理手順を考えた）冗長な部分も含まれている。自分のバカさを全世界にPRするようなものだが、計算処理を追加したり、コードを一般化する際の考え方の参考となるよう、敢えてそのまま残した。

そもそも、この記事を書こうと思ったきっかけは、DelphiのStringGridの内容を定型用紙に印刷するサンプルコードが（Web上に）あまりにも少ない気がしたこと。ただ、この例では、いったんCSVファイルにして保存したり、PrinterのCanvasではなくTImageのCanvasに描画したり、普通とは言い難い方法を行って印刷している気がするので、普通（？）の印刷方法を学びたい方にはまるで参考にならないかもですが、万一にでも、どなたかのお役に立てれば何よりの幸いです。

【実行結果】

まず、PrinterSetupDialogが表示されるので、A4・縦を選択する。

これで数値データを右寄せ表示できれば、大満足なんだけど･･･ 。

追記（20240819）

Format関数を使えば、数値データの右揃えが簡単に実現できることを忘れてた！

（最近は「データを保存する」プログラムばかり書いていて、「データを印刷する」プログラムはほとんど書いたことがないことにあらためて気づいた。

　例１：csv形式で保存 -> 表計算ソフトで読み込んで活用。
　例２：表計算ソフトのファイルにADO接続して、直接書き込み。
　例３：データベースにADO接続して、データを保存、必要な部分をクエリで抽出。みたいな･･･

遠い昔、VBでデータを縦・横罫線付きの一覧表形式で印刷するプログラムをさんざん書いていたのが夢のよう･･･。

てか、今回も最終的に印刷しているのは、プリンターのCanvasに描画した「絵」なんですが。）

「印刷プレビュー」及び「印刷」の手続きを次のように追加・修正。

１．手続きの冒頭で、「等幅フォントを忘れずに指定」する（追加）。

  //使用するフォント（必ず等幅フォントを指定する）
  Image1.Picture.Bitmap.Canvas.Font.Name:='Consolas';

  //フォントサイズ -> 実際にはComboBoxで指定・選択できるようにする
  Image1.Picture.Bitmap.Canvas.Font.Size:=11;

２．データ出力部分を次のように修正する。

  //データを出力
  //Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);

  //数値データは右揃えで出力する
  if TryStrToInt(Fields[j], intValue) then
  begin
    //数値である -> 右揃えで出力する
    Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),
      Format('%3d', [strToInt(Fields[j])]));
  end else begin
    //数値でない -> 左揃えで出力する
    Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
  end;

【実行結果】

追記（20240819）ここまで

２ページ目以降も先頭行にフィールド名を表示

先頭行にフィールド名を表示する部分は、いちばん悩んだところ。
最終的に変数eNum（LoopのEndNumber）から印刷に必要なページ数を取得し、StringListに格納した印刷データの０番目の要素をコピーして、これをStringListの51、101、151のように、eNumの現在の値( i * 50)+1番目に挿入して行く方法が計算的にも、処理的にも、いちばんラクなのではないか？･･･と考え、このアルゴリズムでプログラムを作成。

こうすれば１ページ目には要素０から50、２ページ目には要素51から100、３ページ目には101から150･･･のように印刷データの割り当てが決まり、プログラムも心もすっきり。０番目の要素（フィールド名）のコピーと所定の位置への挿入さえ行ってしまえば、あとは単純にLoopを廻すだけだ。

      eNum:=StringList.Count div 50;

      //51,101,151,201,251,301・・・番目にフィールド名を挿入

      //0番目の要素をコピー
      myFieldElement:=StringList[0];
      //要素を追加
      if eNum<>0 then
      begin
        for i := 1 to eNum do
        begin
          StringList.Insert((50*i)+1, myFieldElement);
        end;
      end;

最も重要なデータ出力部分は、生成AIに教えてもらった！
次のデータを出力するコードの（iPlus * 20)の部分は、自分では絶対に書けなかったと思う･･･。
ついに、と言うか、とうとう、わからない部分は生成AIに聞きながらプログラムが書ける、夢のような時代がやってきた！！

でも、頼りすぎは禁物。実際、今回もかなり痛い目にあった･･･。
その内容は、後述。

//データを出力
Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);

印刷枚数が１ページだけなら、変数はLoop変数の i がそのまま使えるのだが、複数枚印刷を実行する必要があるので、Loop用の変数 i とは別に iPlus という名前の変数（特に意味はない）を用意し、ページが切り替わる毎にゼロで初期化するように生成AIが教えてくれたプログラムを改良。

それから、これはあった方が親切かな？ と考え、先頭行のフィールド名の最後に「備考」も追加。

Loopの様子をわかりやすくしたのが次のコード。
ページ内のデータ印刷作業で、i , j , k を使ってしまったので、いちばん大きな（外側の）ページを切り替えるLoopの変数名をどうするかで悩み l（エルの小文字）はちょっと･･･って感じがしたので、最終的に変数名はintLoopとした。

最終的に、TImageのBitmapに出力したものをPrinterのCanvasにコピーして印刷している。

for intLoop := 0 to eNum do
begin
  k:=0;
  iPlus:=0;
  for i := LowNum to HighNum do
  begin
    for j := 0 to Fields.Count - 1 do
    begin    
      //フィールド名に「備考」を追加する
      if i=0 then
      begin
        if j=Fields.Count-1 then
        begin
          Fields[j]:=Fields[j]+'　備考';
        end;
      end;
      //データを出力
      Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
    end;
    inc(iPlus);
  end; 

  //大きさを指定
  MyRect.Top:=0;
  MyRect.Left:=0;
  MyRect.Bottom:= Trunc((Printer.PageWidth / Image1.Picture.Width) * Image1.Picture.Height);
  MyRect.Right:= Printer.PageWidth;
  //ファイルを描画
  StretchDrawBitmap(Printer.Canvas, MyRect, Image1.Picture.Bitmap);
  Application.ProcessMessages;

end;  //intLoopの終わり

実は、ここでひと悶着あって･･･

５．rect:TRectとしてはいけません！

実際には、最初に１ページ目だけを表示できる「印刷プレビュー」のプログラムを書き、それを元にして「印刷」プログラムを書いたのだが、いつもの通り、というか、お決まりの「解決策がまったくわからずにトホーに暮れる」･･･ 後から考えれば（理由がわかってみれば）実に「なぁーんだ。そんなコトか」みたいな、でも、それがわかるまでは七転八倒の苦しみとなるイベントに今回も遭遇。

毎回、これが楽しみでプログラムを書いている、そんな気がしないでもないが。

今回のそれは･･･ナニかというと、

「印刷プレビュー」の手続き内では「何の問題もなかった」次のコードだが、

procedure TForm1.Button2Click(Sender: TObject);
begin

  ・・・じんせい、イロイロ・・・

  //背景を塗りつぶす
  Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
  Image1.Picture.Bitmap.Canvas.FillRect(rect(0, 0, 827, 1169)); 

  ・・・タコは、イボイボ・・・

end;

これを「印刷」手続き内に複写して、「印刷プレビュー」手続きにはないPrinterのCanvasへの描画コードを追加するなど、あちこちいじっていたら、いつの間にか･･･

構造ペインには･･･

『はぁ？』

だって行末にちゃんとセミコロンあるし･･･みたいな感じ。
･･･てか、なんで、こっちの手続きだけ、エラーになるの？？？

この時点で、早朝２時頃から連続15時間くらいPCと向かい合っていたため、精神的にはもうフラフラの状態。もちろん、エラーの原因は、まったくわからない。

まったく同じプログラムコードが、あっちの手続きではOK！　こっちの手続きではダメな理由は、いったい何なんだろう？？？

この後も、しばらく、がんばって考えたんだけど、原因はさっぱりわからず、

Delphiを再起動したら直るかなー？

もちろん、直るわけもなく･･･。

もしかして、PCを再起動したら直るかなー？？

もちろん、再起動してもエラーは消えない。

万策尽きた感じで、とりあえず、いけない水に手を伸ばし･･･ 心は折れたまま、遥かなる夢の国へ。

翌朝、ってか、午前０時前に目覚めたから、日付はまだ今日だけど･･･
とりあえず、すっきりした頭で問題に再挑戦。ようやくエラーの原因が判明。

ほんとに偶然発見したのだけれど、エラーにならない「印刷プレビュー」の手続きでは･･･

これに対し、エラーになる「印刷」の手続きでは･･･

あー！！
わかったー☆☆☆ みたいな

１ページ目だけ表示可能な最初に書いた「印刷プレビュー」の手続きをそっくり「印刷」手続きに複写して、「印刷プレビュー」の手続きには「存在しなかった」プリンタのCanvasへの描画コードを追加したのだが･･･ その時、var宣言部でTRect型の変数rectを宣言していたのだ。

これが追加したPrinterのCanvasへ描画するプログラムの主要部分。

procedure TForm1.btnPrintASheetClick(Sender: TObject);
var
  i, j: Integer;
  strMsg: string;
  PrintALL: Boolean;
  intLoopNum: Integer;
  rect:TRect;
  StrCaption:String;
  StrPrompt:String;
  StrValue1, StrValue2:String;
  Chr : array [0..255]  of  char;

  // ビットマップ用印刷ルーチン
  procedure StretchDrawBitmap(Canvas:TCanvas;  // 描画先キャンバス
                              r : TRect;       // 描画先範囲
                              Bitmap:TBitmap); // ビットマップ
  ・・・省略・・・

begin
  if PrinterSetupDialog1.Execute then
  begin

    //背景を塗りつぶす
    Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
    Image1.Picture.Bitmap.Canvas.FillRect(rect(0, 0, 827, 1169));  //エラーになる部分

    //Info
    strMsg:='全員分印刷しますか？'+#13#10+'（個別印刷は「いいえ」）';
    if Application.MessageBox(PChar(strMsg), PChar('情報'), MB_YESNO or MB_ICONINFORMATION) = mrYes then
    begin
      PrintALL:=True;
    end else begin
      PrintALL:=False;
    end;

    //全部印刷
    if PrintAll then
    begin
      //先頭のデータを表示
      btnFirstClick(Sender);
      for i := 1 to ListBox1.Items.Count do
      begin
        //まず現在のImageを印刷
        with Printer do
        begin
          if i=1 then
          begin
            BeginDoc;
          end else begin
            NewPage;
          end;
          //大きさを指定
          rect.Top:=0;
          rect.Left:= 0;
          rect.Bottom:= Trunc(( PageWidth / Image1.Picture.Width) * Image1.Picture.Height);
          rect.Right:= PageWidth;
          //TImageのBitmapをPrinterのCanvasに描画
          StretchDrawBitmap(Printer.Canvas, rect, Image1.Picture.Bitmap);
          
          if i=ListBox1.Items.Count then
          begin
            EndDoc;
          end;
        end;

        //次を表示
        btnNextClick(Sender);
      end;

      ・・・

だから、結果的に（当然だが）「印刷」手続き内ではコードで意図したSystem.TypesのRect関数は呼ばれずに、「rect」と記述するとそれはvar宣言したrect変数の方を意味（参照）することになって･･･

これはエラーになって当然。Delphiさん、あなたはやっぱり正しかった。

ちなみに、Delphiは大文字・小文字を区別しないから、R でも r でも問題は起きない。問題の根源であるvar宣言部のrect変数の名前を変え、次のようにコードを書き直せば･･･

☆エラーは消えました☆

（試してみたい方は、次のコードをコピペしてください。）

procedure TForm1.Button4Click(Sender: TObject);
var
  MyRect:TRect;
begin

  //背景を塗りつぶす
  Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;

  //解決方法その１
  MyRect:=rect(0, 0, 827, 1169);
  Image1.Picture.Bitmap.Canvas.FillRect(MyRect);

  //解決方法その２
  Image1.Picture.Bitmap.Canvas.FillRect(System.Types.Rect(0, 0, 827, 1169));

end;

【まとめ】

関数名として使われているような語句をそのまんま変数名として利用するのはNo Good! であります。

６．印刷プレビューのコード

そういう訳で、「印刷」手続きのコードが完成し、問題も解決したので、この完成したコードを「印刷プレビュー」に流用することにした。

基本的に、「印刷」手続きのコードからBeginDocとNewPage、それからEndDocを消し、PrinterのCanvasに描画してる部分をコメントアウトして、１ページ目以降を表示する方法を追加すればOKのはずだ･･･。そう考えて書いたのが次のコード。

procedure TForm1.Button2Click(Sender: TObject);
var
  //用紙サイズ、縦置き・横置きの設定を知る(Charだと推奨されない警告が表示される->Stringに変更)
  //Device, Driver, Port: array[0..255] of Char;
  Device, Driver, Port: string;
  DeviceMode: THandle;
  DevMode: PDeviceMode;

  //StringGrid->CSVファイル名とそこまでのPathを入れる
  csvFN:string;

  StringList: TStringList;
  i, j, k, MaxWidth: Integer;
  Fields: TStringList;
  FieldWidths: array of Integer;
  ColMargin: Integer;
  MarginX, MarginY: Integer;
  intLoop: Integer;
  FontHeight: Integer;
  eNum: Integer;
  iPlus: Integer;
  myFieldElement: string;
  LowNum: Integer;
  HighNum: Integer;
  MyRect:TRect;
  //平均値・最高値・最低値
  //DSum: Double;
  //DAvg: Double;
  //MinValue, MaxValue: Double;

  //StringGrid -> CSV File
  procedure SaveStringGridToCSV(StringGrid: TStringGrid; const FileName: string);
  var
    CSVFile: TextFile;
    Row, Col: Integer;
    Line: string;
  begin
    AssignFile(CSVFile, FileName);
    Rewrite(CSVFile);
    try
      for Row := 0 to StringGrid.RowCount - 1 do
      begin
        Line := '';
        for Col := 0 to StringGrid.ColCount - 1 do
        begin
          Line := Line + StringGrid.Cells[Col, Row];
          if Col < StringGrid.ColCount - 1 then
            Line := Line + ',';
        end;
        WriteLn(CSVFile, Line);
      end;
    finally
      CloseFile(CSVFile);
    end;
  end;

  procedure GetMinMaxValues(StringGrid: TStringGrid; ColIndex: Integer; out MinValue, MaxValue: Double);
  var
    Row: Integer;
    Value: Double;
  begin
    if StringGrid.RowCount = 0 then
      raise Exception.Create('StringGridにデータがありません。');

    MinValue := MaxDouble;
    MaxValue := -MaxDouble;

    for Row := 1 to StringGrid.RowCount - 1 do
    begin
      if TryStrToFloat(StringGrid.Cells[ColIndex, Row], Value) then
      begin
        if Value < MinValue then
          MinValue := Value;
        if Value > MaxValue then
          MaxValue := Value;
      end;
    end;

    if MinValue = MaxDouble then
      raise Exception.Create('指定された列に数値データがありません。');
  end;

  //Image1のBitmapをImage2の指定位置へ複写する
  procedure CopyBitmapToImage(Image1, Image2: TImage; DestX, DestY: Integer);
  var
    SrcRect, DestRect: TRect;
  begin
    // ソースの矩形を設定
    SrcRect := Rect(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);
    // 目的地の矩形を設定
    DestRect := Rect(DestX, DestY, 
      DestX + Image1.Picture.Bitmap.Width, DestY + Image1.Picture.Bitmap.Height);
    // Image2のCanvasにImage1のBitmapを複写
    Image2.Picture.Bitmap.Canvas.CopyRect(DestRect, Image1.Picture.Bitmap.Canvas, SrcRect);

    //追加（20240820）
    //ページ区切り線を表示するコードを追加
    //ペンの色を青に設定
    Image2.Picture.Bitmap.Canvas.Pen.Color := clGray;
    //ページ区切り線の太さ
    Image2.Picture.Bitmap.Canvas.Pen.Width:=3;
    //ペンのスタイルを点線に設定
    //Image1.Canvas.Pen.Style := psDot;
    Image1.Canvas.Pen.Style := psSolid;
    //線を引く
    Image2.Canvas.MoveTo(0, DestY + Image1.Picture.Bitmap.Height); // 線の開始位置
    Image2.Canvas.LineTo(Image2.Picture.Bitmap.Width, 
      DestY + Image1.Picture.Bitmap.Height); // 線の終了位置
    //ページ区切り線の太さを元に戻す
    Image2.Picture.Bitmap.Canvas.Pen.Width:=1;
    //ペンの色を黒に設定
    Image2.Picture.Bitmap.Canvas.Pen.Color := clBlack;
    //ペンのスタイルを直線に戻す
    //Image1.Canvas.Pen.Style := psSolid;
  end;

begin

  //複数回クリックを防止する
  Button2.Enabled:=False;

  //初期化
  Image1.Picture:=nil;

  //印刷設定（用紙・向き）後に印刷

  //プリンタの設定を取得
  Printer.GetPrinter(Device, Driver, Port, DeviceMode);
  DevMode := GlobalLock(DeviceMode);
  try
    //用紙サイズをA4に設定
    DevMode^.dmPaperSize := DMPAPER_A4;
    //用紙方向を縦に設定
    DevMode^.dmOrientation := DMORIENT_PORTRAIT;
    //設定をプリンタに反映
    Printer.SetPrinter(Device, Driver, Port, DeviceMode);
  finally
    GlobalUnlock(DeviceMode);
  end;

  //TImageの初期設定
  Image1.Width := 827;
  Image1.Height := 1169;
  Image1.Picture.Bitmap.Width := 827;
  Image1.Picture.Bitmap.Height := 1169;

  //背景を塗りつぶす
  Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
  MyRect:=Rect(0, 0, 827, 1169);
  Image1.Picture.Bitmap.Canvas.FillRect(MyRect);

  //使用するフォント（必ず等幅フォントを指定する）
  //数値の右揃え用に追加（20240820）
  Image1.Picture.Bitmap.Canvas.Font.Name:='Consolas';

  //フォントサイズ
  Image1.Picture.Bitmap.Canvas.Font.Size:=11;
  //フォントサイズ <- 要らなかった！
  //Image2.Picture.Bitmap.Canvas.Font.Size:=11;

  //平均値を計算  intDenominはグローバル変数として宣言
  {
  DSum:=0;
  for i := 1 to StringGrid1.RowCount do
  begin
    if StringGrid1.Cells[5,i] <> '' then
    begin
      DSum:= DSum + StrToInt(StringGrid1.Cells[5,i]);
    end;
  end;
  DAvg:= SimpleRoundTo(DSum / intDenomin, -2);

  //最高値及び最低値を計算
  GetMinMaxValues(StringGrid1, 5, MinValue, MaxValue);

  //タイトルを描画
  Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
  Image1.Picture.Bitmap.Canvas.TextOut(
    StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30, LabelKoza.Caption);

  //フォント色を変更
  Image1.Picture.Bitmap.Canvas.Font.Color := clBlack;
  }

  //Grid -> CSV
    //実際のプログラムでは、sNameフォルダ内のCSVファイルを読み込み、
    //さらに幾つかフィールドを追加して新しいデータを入力している。
    //印刷では、この新しく入力されたデータを含めて印刷している

    //実際のプログラムでは、LabelSaveFolderName.Captionは別手続きで取得・表示済み
    LabelSaveFolderName.Caption:='SampleData';

    //保存するフォルダへのPath
    csvFN:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+
      'ProcData\'+LabelSaveFolderName.Caption+'\';

    //フォルダの存在を確認、なければ作成
    if not System.SysUtils.DirectoryExists(ExtractFileDir(csvFN)) then
    begin
      //フォルダ階層を作成
      System.SysUtils.ForceDirectories(ExtractFileDir(csvFN));
    end;

    csvFN:=IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+
      'ProcData\'+LabelSaveFolderName.Caption+'\'+LabelSaveFolderName.Caption+'.csv';
    SaveStringGridToCSV(StringGrid1, csvFN);

  StringList:=TStringList.Create;
  Fields:=TStringList.Create;

  try

    //Create
    StringList.LoadFromFile(csvFN);
    //Create
    SetLength(FieldWidths, 0);

    //各フィールドの最大幅を計算
    for i := 0 to StringList.Count - 1 do
    begin
      Fields.CommaText := StringList[i];
      if Length(FieldWidths) < Fields.Count then
        SetLength(FieldWidths, Fields.Count);

      for j := 0 to Fields.Count - 1 do
      begin
        //MaxWidth := Printer.Canvas.TextWidth(Fields[j]);
        MaxWidth := Image1.Picture.Bitmap.Canvas.TextWidth(Fields[j]);
        if FieldWidths[j] < MaxWidth then
          FieldWidths[j] := MaxWidth;
      end;
    end;

    eNum:=StringList.Count div 50;

    //PreView用TImageの初期設定
    Image2.Width := 827;
    case eNum of
      0:Image2.Height := 1169;
    else
      Image2.Height := 1169 * (eNum + 1);
    end;
    Image2.Picture.Bitmap.Width := 827;
    case eNum of
      0:Image2.Picture.Bitmap.Height := 1169;
    else
      Image2.Picture.Bitmap.Height := 1169 * (eNum + 1);
    end;    

    //背景を塗りつぶす
    Image2.Picture.Bitmap.Canvas.Brush.Color := clWhite;
    case eNum of
      0:MyRect:=Rect(0, 0, 827, 1169);
    else
      MyRect:=Rect(0, 0, 827, 1169 * (eNum + 1));
    end;
    Image2.Picture.Bitmap.Canvas.FillRect(MyRect);

    //51,101,151,201,251,301,･･･,XX1番目にフィールド名を挿入しておく

    //0番目の要素をコピー
    myFieldElement:=StringList[0];
    //要素を挿入（追加）
    if eNum<>0 then
    begin
      for i := 1 to eNum do
      begin
        StringList.Insert((50*i)+1, myFieldElement);
      end;
    end;

    //ここから印刷Loop
    try

      for intLoop := 0 to eNum do
      begin

        //初期化（白紙にする）
        Image1.Picture.Bitmap.Canvas.Brush.Color := clWhite;
        MyRect:=Rect(0, 0, 827, 1169);
        Image1.Picture.Bitmap.Canvas.FillRect(MyRect);
        {
        //印刷プレビューだから不要
        if intLoop=0 then
        begin
          Printer.BeginDoc;
        end else begin
          Printer.NewPage;
        end;
        }

        //タイトルを描画
        Image1.Picture.Bitmap.Canvas.Font.Color:=clBlue;
        Image1.Picture.Bitmap.Canvas.TextOut(
          StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30,
          LabelSaveFolderName.Caption);

        //タイトルを描画（計算が必要な場合の例）
        {
        Image1.Picture.Bitmap.Canvas.Font.Color := clBlue;
        Image1.Picture.Bitmap.Canvas.TextOut(
          StrToInt(EditMarginX.Text), StrToInt(EditMarginY.Text)-30,
          LabelKoza.Caption + '　【平均値：'+FloatToStr(DAvg)+
          '、最高値：'+ FloatToStr(MaxValue)+
          '、最低値：'+ FloatToStr(MinValue)+'】');
        }

        Image1.Picture.Bitmap.Canvas.Font.Color:=clBlack;

        //水平方向の各フィールドの印字開始位置決定用変数を初期化
        k:=0;

        //水平方向の印字開始位置
        MarginX:=StrToInt(EditMarginX.Text);
        //垂直方向の印字開始位置
        MarginY:=StrToInt(EditMarginY.Text);
        //列（フィールド）と列の（余白的な）間隔
        ColMargin:=StrToInt(EditColMargin.Text);

        //ページが変わったら初期化する
        iPlus:=0;

        case intLoop of
          0:begin
            LowNum:=0;
            if StringList.Count > 50 then
            begin
              HighNum:=50;
            end else begin
              HighNum:=StringList.Count-1;
            end;
          end;
          {
          1:begin
            LowNum:=51;
            if StringList.Count > 100 then
            begin
              HighNum:=100;
            end else begin
              HighNum:=StringList.Count-1;
            end;
          end;
          2:begin
            LowNum:=101;
            if StringList.Count > 150 then
            begin
              HighNum:=150;
            end else begin
              HighNum:=StringList.Count-1;
            end;
          end;
          }
        else
          //一般化
          LowNum:=(intLoop*50)+1;
          if StringList.Count > (intLoop*50)+50 then
          begin
            HighNum:=(intLoop*50)+50;
          end else begin
            HighNum:=StringList.Count-1;
          end;
        end;

        for i := LowNum to HighNum do
        begin
          Fields.CommaText := StringList[i];
          for j := 0 to Fields.Count - 1 do
          begin
            //処理できる列数を無制限にする
            case j of
              0:k:=0;
            else
              k:=k+FieldWidths[j-1]+ColMargin;
            end;
            //フィールド名に「備考」を追加する
            if i=0 then
            begin
              if j=Fields.Count-1 then
              begin
                Fields[j]:=Fields[j]+'　備考';
              end;
            end;

            //データを出力（数値の右揃え：なし）
            //Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);

            //データを出力（数値の右揃え：あり）
            //数値の右揃え用に追加（20240820）
            if TryStrToInt(Fields[j], intValue) then
            begin
              //数値である -> 右揃えで出力する
              Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),
                Format('%3d', [strToInt(Fields[j])]));
            end else begin
              //数値でない -> 左揃えで出力する
              Image1.Picture.Bitmap.Canvas.TextOut(MarginX+k,MarginY+(iPlus*20),Fields[j]);
            end;

            //罫線を描画
            if cbLine.Checked then
            begin
              Image1.Picture.Bitmap.Canvas.Pen.Color:= clBlack;
              FontHeight:= -1 * Image1.Picture.Bitmap.Canvas.Font.Height;
              Image1.Picture.Bitmap.Canvas.MoveTo(MarginX+k, MarginY+(iPlus*20)+FontHeight+4);
              Image1.Picture.Bitmap.Canvas.LineTo(Image1.Picture.Bitmap.Width-50, MarginY+(iPlus*20)+FontHeight+4);
            end;
          end;

          inc(iPlus);

        end;

        //Image1のBitmapをImage2の(XX, YY)の位置に複写
        case intLoop of
          0:CopyBitmapToImage(Image1, Image2, 0, 0);
        else
          CopyBitmapToImage(Image1, Image2, 0, 1169 * intLoop);
        end;

      end;

    finally
      //Printer.EndDoc;
    end;

  finally
    StringList.Free;
    Fields.Free;
    //複数回クリックを防止する
    Button2.Enabled:=True;
  end;

  //ファイルの完全削除
  DeleteFile(PChar(csvFN));

  //Imageの高さをScrollBoxのスクロール範囲に反映
  ScrollBox1.VertScrollBar.Range := Image2.Picture.Bitmap.Height;

  //TImageの表示位置を指定
  ScrollBox1.VertScrollBar.Position:=0;
  ScrollBox1.HorzScrollBar.Position:=0;
  Image1.Top:=ScrollBox1.VertScrollBar.Position+14;
  Image1.Left:=ScrollBox1.HorzScrollBar.Position+14;
  Image2.Top:=ScrollBox1.VertScrollBar.Position+14;
  Image2.Left:=ScrollBox1.HorzScrollBar.Position+14;

  //TImageの表示
  Image1.Visible:=False;
  Image2.Visible:=True;

end;

【実行結果】

実行結果は、次の通り。用意したデータ件数は320件。

スクロールして下へ。表示されているのは、最終ページ。
※ マウスのホイールを廻してスクロールさせるには別途コードの記述が必要（後述）。

マウスのホイールを廻して、TImageをスクロールさせるには、FormのOnMouseWheelイベントの手続きを次のように作成する。

procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  LDelta:Integer;
  //追加
  LWinCtrl:TWinControl;
  LCurPos:TPoint;
begin

  {
  //TScrollBox のマウスホイールによるスクロール
  //マウスがTScrollBoxの外にあってもスクロールする・・・ならこちら☆
  LDelta:=WheelDelta div 5;
  if ssCtrl in Shift then
  begin
    ScrollBox1.HorzScrollBar.Position:=ScrollBox1.HorzScrollBar.Position-LDelta;
  end else begin
    ScrollBox1.VertScrollBar.Position:=ScrollBox1.VertScrollBar.Position-LDelta;
  end;
  Handled:=True;
  }

  //マウスカーソルが TScrollBox の領域内にある時だけスクロールを可能にする
  LCurPos := ScrollBox1.Parent.ScreenToClient(MousePos);
  if PtInRect(ScrollBox1.BoundsRect, LCurPos) then
  begin
    LDelta := WheelDelta div 3;
    if ssCtrl in Shift then
    begin
      ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position - LDelta;
    end else begin
      ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - LDelta;
      //Memoも連動してスクロールさせる
      {
      if LDelta > 0 then
      begin
        Memo2.Perform(WM_VSCROLL, SB_LINEUP, 0);
      end else begin
        Memo2.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
      end;
      }
    end;
  end else begin
    //マウス直下のコントロールを取得
    LWinCtrl := FindVCLWindow(MousePos);
    //TStringGridの場合
    if LWinCtrl is TStringGrid then
    begin
      if WheelDelta > 0 then
      begin
        LWinCtrl.Perform(WM_VSCROLL, SB_LINEUP, 0);
      end else begin
        LWinCtrl.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
      end;
    end;
  end;

  //この１行を忘れないこと！
  Handled:=True;

end;

【印刷プレビューコードの工夫】

１．ページ毎に作成されるImage1のBitmapを、Image2のCanvasの指定位置に複写する。
２．最初にページ数を調べ、Image2の高さをページ数にあわせて高くしておく。
３．１の複写手続きの最後に、ページ区切り線を描画するコードを追加（20240820）。

１．に関して、Image1のBitmapをImage2のCanvasに複写する手続き

  //Image1のBitmapをImage2の指定位置へ複写する
  procedure CopyBitmapToImage(Image1, Image2: TImage; DestX, DestY: Integer);
  var
    SrcRect, DestRect: TRect;
  begin
    // ソースの矩形を設定
    SrcRect := Rect(0, 0, Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);

    // 目的地の矩形を設定
    DestRect := Rect(DestX, DestY, DestX + Image1.Picture.Bitmap.Width, DestY + Image1.Picture.Bitmap.Height);

    // Image2のCanvasにImage1のBitmapを複写
    Image2.Picture.Bitmap.Canvas.CopyRect(DestRect, Image1.Picture.Bitmap.Canvas, SrcRect);
  end;

    //追加（20240820）
    //ページ区切り線を表示するコードを追加
    //ペンの色を青に設定
    Image2.Picture.Bitmap.Canvas.Pen.Color := clGray;
    //ページ区切り線の太さ
    Image2.Picture.Bitmap.Canvas.Pen.Width:=3;
    //ペンのスタイルを点線に設定
    //Image1.Canvas.Pen.Style := psDot;
    //ペンのスタイルを直線に設定
    Image1.Canvas.Pen.Style := psSolid;
    //線を引く
    Image2.Canvas.MoveTo(0, DestY + Image1.Picture.Bitmap.Height); // 線の開始位置
    Image2.Canvas.LineTo(Image2.Picture.Bitmap.Width, 
      DestY + Image1.Picture.Bitmap.Height); // 線の終了位置
    //ページ区切り線の太さを元に戻す
    Image2.Picture.Bitmap.Canvas.Pen.Width:=1;
    //ペンの色を黒に設定
    Image2.Picture.Bitmap.Canvas.Pen.Color := clBlack;
    //ペンのスタイルを直線に戻す
    //Image1.Canvas.Pen.Style := psSolid;
  end;

ページ区切り線については、いろいろ試行した結果、やや太い灰色の直線が最も適している（ほどよく自己主張するが、データほどではない）と感じたので、そのように設定。上のコードにはその痕跡を残している。

１．に関して、複写する手続きを呼び出すコード。

        //Image1のBitmapをImage2の(XX, YY)の位置に複写
        case intLoop of
          0:CopyBitmapToImage(Image1, Image2, 0, 0);
        else
          CopyBitmapToImage(Image1, Image2, 0, 1169 * intLoop);
        end;

２．に関して、ページ数に応じてImage2の高さを高くするコード。

    eNum:=StringList.Count div 50;

    //PreView用TImageの初期設定
    Image2.Width := 827;
    case eNum of
      0:Image2.Height := 1169;
    else
      Image2.Height := 1169 * (eNum + 1);
    end;
    Image2.Picture.Bitmap.Width := 827;
    case eNum of
      0:Image2.Picture.Bitmap.Height := 1169;
    else
      Image2.Picture.Bitmap.Height := 1169 * (eNum + 1);
    end;

７．まとめ

（１）StringGridのデータを用紙と向きを指定して罫線付きで印刷するコードを掲載
（２）（１）のコードを流用して、印刷プレビューを表示するコードを掲載
（３）変数名を付ける時は既存の関数名等との衝突に十分に注意する。

８．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容（プログラムを含む）利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

PDF文書ファイルをページごとに画像化したくて様々な方法を探し（AND 試し）ましたが、なかなか「コレだ！」と思える方法が見つからず、ほぼ１日を費やして（ダメか･･･）とあきらめかけた、まさにその時、やっと出会えたのが Swanman (id:tales)さんの Blog の次の記事でした。

外部ライブラリ無しでPDFを描画する。

https://lyna.hateblo.jp/entry/20160625/1466783114

「それならWeb上の変換サービスを使えば･･･」というご意見はもっともですが、利用目的が「スキャナーでPDFファイル化した個人情報を含むデータの画像化処理」で、それなりに枚数もあるし･･･どこかのサーバーにアップして･･･というのは絶対に避けたいところです。

Swanman (id:tales)さんのBlogの記事を頼りに、何とか目的を実現することができました。これは、その際行ったことの備忘録です。

【もくじ】

１．FireMonkeyならPDFiumがある
２．WinRT
３．まとめ
４．お願いとお断り

１．FireMonkeyならPDFiumがある

最近、何かを調べる時はCopilotさんにお伺いをたてることが多いです。そこで、今回も早速きいてみました。

自分：
DelphiでPDFを画像化したいときはどうしたらいいですか

するとPDFiumというライブラリがあるとCopilotさんが教えてくれました。ただ、紹介されたのは「PDFium Component Suite for FireMonkey」だったので、どちらかというとWindows専用にVCLコンポーネントを使ってプログラムを書きたい自分的には（FireMonkeyはちょっと･･･）という感じだったのですが･･･、「溺れる者は藁をもつかむ」と、まさにそんな気持ちでありましたから･･･記事に目を通してみることに。

Copilot さんが教えてくれた FireMonkey 用の PDFium の紹介ページはこちら。

PDFium – Delphi/C++Builder FireMonkeyアプリケーション向けPDFエンジン

https://blogs.embarcadero.com/ja/pdfium-pdf-engine-for-your-delphi-c-builder-firemonkey-applications-ja/

そこで紹介されていたコードの一部（抜粋して引用）。

  Bitmap := FPdf.RenderPage(0, 0,
    Round(PointsToPixels(FPdf.PageWidth, PixelsPerInch)),
    Round(PointsToPixels(FPdf.PageHeight, PixelsPerInch)));
  try
    Bitmap.SaveToFile(FileName + '_Page' + IntToStr(I) + '.jpg');
  finally
    Bitmap.Free;
  end;

このRenderPageなる手続きが使えれば、目的はカンタンに実現できそう。
それに PDFium はライセンス的にも問題なさそうだし･･･

（VCL版があればなぁ･･･）

ダメ元で探してみるとPDFiumのVCL版を発見。早速、ダウンロード！

ahausladen/PdfiumLib: PDF VCL Control using PDFium

https://github.com/ahausladen/PdfiumLib

大喜びで、使ってみたんだけれど･･･

なんと、PDFiumのVCL版には RenderPageがありません でした！！

（間違えていたら、ほんとうに、ごめんなさい）

必要なものは全部 uses して、exeと同じフォルダに PDFium.dll も用意したのですが、何か足りないものでもあったのでしょうか？

なら、FireMonkey で書けばいいじゃん！って気持ちにそう簡単にはなれないのが人間です。実は、それなりに頑張ってFireMonkeyでいくつかのプログラムをこれまでに書いてみたのですが、エラーの原因解明に手間取ることが多くて、Windows PCしか使わない自分にとって、無理してまでクロスプラットフォームでプログラムを書くメリットはないように思えてきて･･･やはり、書きなれたVCLの方が自分にはあってる･･･と、どうしても、そう思ってしまい･･･

それに、ここでFireMonkeyにすると、この先もずっとFireMonkeyで書くことに。

現在、書き続けている一連の採点処理用途のプログラムは、すべてVCLで書いてきたこともあり、大変残念ですが PDFium の使用は、ここで断念することに決めました。

２．WinRT

Swanman (id:tales)さんのBlogの記事に紹介されていた Windows Runtime（略称がWinRT）なるものの存在を、これまで僕は知りませんでした。Win32 API なら名前だけは知ってましたが、どうやらそれより新しいAPI であるとのこと。難しいことはわかりませんが、このWinRTでPDFの画像化ができるのであれば、Windowsの機能を使ってそれが実現できるのですから、新規に何かライブラリを追加したりする必要がなく、それこそ理想的です。

ようやく発見したSwanman (id:tales)さんのBlogの記事を読んで、とりあえず、上記の内容だけは確実に理解できました。早速、アップロードされていたユニットとサンプルコードを有難くダウンロードさせていただき、Project2 のサンプルコードを実行（F9）してみました。すると･･･

これは困りました。解決方法がまったくわかりません！

（APIだから、もしかしてMicrosoftさんのほうで、ここ数年のうちに何か変更があったのかな･･･）

pas、すなわち必要なユニットはすべてPathの通ったところに置きましたから、これはライブラリ自体が「ない」ということなのかな･･･？

（ない袖は振れないから･･･、ダメもとで外してみようか･･･）

唯一、思いついた解決方法にならない強引な戦法で前進？することに決め、問題の行をコメントアウト。幸い、誰もこのライブラリを参照していなかったようで、「未定義の識別子」エラーは表示されません。これはラッキー！とばかりに、このまま再度、実行（F9）します。

すると･･･、別のユニットでもうひとつ同じエラーが発生。

もう、ムチャを承知で無理やり、前進！　前進!!
この行も // コメントアウト。こちらもラッキーなことに「未定義の識別子」エラーは表示されません。これ幸いと、再び、実行（F9）。

このプログラムが動かなくて困るのは僕だけです。他に誰一人、悲しい思いをする人はいません。それだけが唯一の救いです。

結果は･･･

何の問題もなく、
プログラムは無事に動作しました！

開いたPDF文書はページごとにJpeg画像として保存できました☆

ちなみに Types の他にはどんなメンバーがいるのかと思い、WinAPI.Foundation をコピペして、n の後ろに「 . 」を入力してみると、入力補完機能が表示した選択肢は･･･

もちろん、誰もこのユニットを参照していないことは明らかなので、次のようにしても動作しました。

（もしかして、必要なユニットがまだ他にあるのかな･･･）

（でも、どこからも参照されていなかったし･･･）

（何で uses されてたんだろー？）

結局、Winapi.Foundation.Types の謎は解けませんでしたが、PDF文書ファイルの各ページをJpeg画像として保存したいという目的は実現することができました。

今回、僕が探した範囲ではDelphiを使ってPDF文書の画像化を実現する方法は、FireMonkeyでPDFiumを使う方法と、このWinRTを使う方法の二つしか見つけられませんでした。したがって、FireMonkeyという選択肢を選ばないのであれば、WinRTを使うこの方法しか、選択肢はありません。

そのような意味で、Swanman (id:tales)さんのBlogの記事にあった情報は大変貴重な情報であると思いました。Swanman (id:tales)さんにこころから感謝しております。ありがとうございました。

３．まとめ

（１）Delphiで、PDF文書の各ページを画像化する方法はある。
（２）FireMonkeyでPDFiumを使用。
（３）WinRTのAPIを使う方法もある（VCLで動作確認／FireMonkeyでの動作は未確認）。

今回の記事を書くにあたって、プログラムの動作確認に使用したPCの環境は次の通りです。

【デバイスの仕様】
プロセッサ 11th Gen Intel(R) Core(TM) i7-1185G7 @ 3.00GHz 3.00 GHz
実装 RAM 32.0 GB (31.7 GB 使用可能)
システムの種類 64 ビット オペレーティング システム

【Windowsの仕様】
エディション Windows 11 Pro
バージョン 23H2
OS ビルド 22631.3296
エクスペリエンス Windows Feature Experience Pack 1000.22687.1000.0

【Delphiのバージョン】
Embarcadero® Delphi 12 バージョン 29.0.50491.5718

４．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

画像をほんの少しだけ回転させるプログラムを書いた。そこでの角度の指定は、最大でも１°未満を想定（整数値だと大きすぎ）。そこで、回転角度の値を指定するTEditへ、キーボードから直接入力する場合は、0.01刻みでのインプットを可能としたが、TEditとTUpDown等の数量を扱うVCLを組み合わせての入力、つまり、マウスで▲・▼マークをカチカチクリックして値を増減させて入力する場合には、TEditに設定する値は「0.01」刻みでは小さすぎるから、「0.1刻みで増減」させようと思った･･･んだけれど、これが難しかった。

【訂正】　これが難しかった　→　これが、（僕には）難しかった。

最初はTEditとTUpDownを組み合わせて、これを実現しようとしたが中々上手く行かず、仕方がないから、TEdit１個とTButton２個を組み合わせて、なんとか当初の目的を実現。その後、当初、気がつきませんでしたが、TEditとTUpDownの組み合わせで、Float値を増減させる方法も見つけました。これはその覚え書きです。

【もくじ】

１．TEditとTUpDownでチャレンジ
２．TEditとTButton２個でチャレンジ
３．増減値が０にならない理由
４．コードを修正
５．0.1ずつ増減
６．まとめ
７．お願いとお断り

１．TEditとTUpDown

とりあえず定番と思われるTEditとTUpDownの組み合わせ。

UpDown1のAssociateプロパティにEdit1を設定

Edit1にUpDown1がくっついた！

くっつく位置は左右いずれかを指定できるらしい。

画像の回転が目的だから、とりあえずUpDown1のMaxプロパティは90、Minプロパティは-90に設定。
（実際に使用する値は１°未満の予定）

で、Edit1の値を0.1ずつ増減させる「UpDown1Click手続き」を次のように作成。

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
var
  Value: Real;
begin
  //注意：このコードは、期待通りに動作しません
  Value := StrToFloatDef(Edit1.Text, 0);
  case Button of
    btNext: Value := Value + 0.1;
    btPrev: Value := Value - 0.1;
  end;
  Edit1.Text := FloatToStrF(Value, ffNumber, 1, 1);
end;

実行（F9）して、▲ボタンを３回クリックしたところ

１ずつ、増加してる･･･。

なんでかなーって、ちょっと思ったけど、UpDown1のincrementプロパティを見て納得。

足したり、引いたりしている 0.1 はどこに消えたのか･･･？

とりあえず、原因の一つはコレだ☆
やりたいのは「１」ずつじゃなくて「0.1」ずつ増減だから、そう！

Increment プロパティを 0.1 に変えてみた *(^_^)*♪

ひー（心の悲鳴）

Incrementプロパティには、整数しか設定できないようだ。

整数･･･　そぉか、０ならOK？
Value（＝Editに表示されている値） に 0.1足したり、引いたりしてるから、これでイケる？

実行（F9）すると･･･

Value + 0.1や、Value – 0.1はどこに消えた？

1.1 とかになってたから、完全に無視されてるわけでもなさそうだけど･･･？？？

Increment プロパティが整数値指定だとわかった時点で、なんか嫌な予感がしたんだよなー
他にも、Maxとか、Minとか、入力を制限する値（こちらも整数値で指定）もあるし･･･

ここで謎を追いかけて、無駄に時間を使うより、TUpDownは「整数値専用」と決めて、他の方法を試すことに決定。※ 実際、TEditとTUpDownの組み合わせで、小数値の増減も可能です（後述）

２．TEditとTButton２個でチャレンジ

Edit2の右に、Buttonを２つ置いて、こんなふうにしてみた。

で、コードは Copilotさん に教えてもらった☆　その質問内容と答えのコードがこちら。
（コード部分はコピー可能だったから著作権的な問題はないと判断）

Q：DelphiでTEditの値を0.1ずつ増減するにはどうしたらいいですか？

A：Copilotさんが教えてくれたコード。

procedure TForm1.Button1Click(Sender: TObject);
var
  Value: Double;
begin
  if TryStrToFloat(Edit2.Text, Value) then
  begin
    Value := Value + 0.1;
    Edit2.Text := FloatToStr(Value);
  end
  else
    ShowMessage('Invalid number');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Value: Double;
begin
  if TryStrToFloat(Edit2.Text, Value) then
  begin
    Value := Value - 0.1;
    Edit2.Text := FloatToStr(Value);
  end
  else
    ShowMessage('Invalid number');
end;

これなら間になんにも入らず、直接Editを編集してるから、絶対、大丈夫 だろ？
最初からコレでよかったんだ･･･ みたいな気持ちで、コピペして編集し、実行（F9）。

▲をカチカチ、２回クリックしました。イイ感じです！

で、減算（▼クリック）は、初期値が上の 0.2 のところから始めると･･･

次の▼クリックで、値は「０」になるはず。

ところが･･･

はぁ？ 0.1 – 0.1 = 0.0（ゼロ）になるはずなんだけど･･･
ナニ、コレ？

３．増減値が０にならない理由

そうでした。コンピュータは小数の演算が苦手でした。

僕自身、前にさんざん苦しみました。なんで上の計算が「０」にならないのか？

その理由は、次の記事をご参照ください。

Win11の23H2より前のバージョンなら、正しいと思える答えにたどり着くまでGoogle先生に質問を繰り返すのがこれまでの問題解決の定番と言える方法でしたが、今はとなりにCopilotさんがいてくれます。

期待を込めて、訊いてみました。

Q：Delphiで0ではなく、5.54975987041018E-18と表示されます

以下、Copilotさんの返答の概要です。

・浮動小数点数（DoubleやSingle型など）は完全な精度で表現されない。
・これは、すべてのプログラミング言語で共通の問題。
・解決策の一つは、ある閾値（epsilon）よりも結果が小さい場合は 0 と表示。

完全に納得。

Copilotさん、優秀！
ぼく、きみのファンになりました☆

で、以下、Copilotさんが教えてくれた閾値を設定したコードです（コメント文は短縮）。

var
  Value: Double;
  Epsilon: Double;
begin
  Epsilon := 1E-15;  //閾値を設定
  Value := SomeCalculation();  //計算を実行
  if Abs(Value) < Epsilon then
    Value := 0;
  Edit1.Text := FloatToStr(Value);
end;

４．コードを修正

Copilotさんが教えてくれたコードを読んで、「0.0」と表示されるように修正しました。

procedure TForm1.Button3Click(Sender: TObject);
var
  Value: Double;
  Epsilon: Double;
begin
  Epsilon := 1E-15;  //閾値を設定
  if TryStrToFloat(Edit3.Text, Value) then
  begin
    Value := Value + 0.1;
    if Abs(Value) < Epsilon then
    begin
      Value := 0;
      Edit3.Text := '0.0';
    end else begin
      Edit3.Text := FloatToStr(Value);
    end;
  end;

end;

procedure TForm1.Button4Click(Sender: TObject);
var
  Value: Double;
  Epsilon: Double;
begin
  Epsilon := 1E-15;  //閾値を設定
  if TryStrToFloat(Edit3.Text, Value) then
  begin
    Value := Value - 0.1;
    if Abs(Value) < Epsilon then
    begin
      Value := 0;
      Edit3.Text := '0.0';
    end else begin
      Edit3.Text := FloatToStr(Value);
    end;
  end;
end;

ゼロの時は、’0’ではなく、’0.0′ と文字列指定しているところに「こだわり」ました！

５．0.1ずつ増減

上記コードの実行結果です☆（初期値は 0.2）

閾値が効きました☆

逆（▲クリック）も正しく動作することを確認。

【TEditとTUpDownの組み合わせで実現】

TUpDownのMax及びMinプロパティの値（特にMin）を適切な値に設定し、適切なコードを記述することで、TEditとTUpDownというVCLコンポーネントの組み合わせでも 0.1 刻みの選択肢設定が可能であることを確認しました。その方法は以下の通りです。

※ オブジェクトインスペクタで Increment プロパティの値を予め設定しておくという前提で、

【重要】 負数の入力を想定する場合は、TUpDownのMinプロパティの値に適切な負数を設定します！

【重要】 Increment プロパティに 1 を設定 → ▲をクリック → 値が 0.1 ずつ増加

ちなみに Increment プロパティに 2 を設定した場合は、値が 0.2 ずつ増減します。

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
  Assert(Sender is TUpDown);
  with TUpDown(Sender) do
  begin
    Assert(Associate is TEdit);
    TEdit(Associate).Text := FloatToStrF(Position / 10, ffNumber, 1, 1);
  end;
end;

上記コードの出典は、こちら

Delphi-PRAXiS

https://www.delphipraxis.net/143779-tupdown-floats.html

貴重な情報をご教示くださいましたこと、投稿者様に対し、心より感謝申し上げます。

上のコードを参考に、使っているVCLの名前を指定して、もっと短くして書けば･･･

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
  Edit1.Text := FloatToStrF(UpDown1.Position / 10, ffNumber, 1, 1);
end;

増減値に 0.1 ではなく、0.2 以上の値を設定したい場合、Increment プロパティの値は予めオブジェクトインスペクタで指定しておいた方が良いようです。

ちなみにオブジェクトインスペクタのIncrement プロパティに設定してある値は「１」のまま、コードで「２」を指定した場合は･･･

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
  UpDown1.Increment := 2;
  Edit1.Text := FloatToStrF(UpDown1.Position / 10, ffNumber, 1, 1);
end;

実行（F9）してみるとエラーにはなりませんが、最初の▲押し下げ時に 0.2 ではなく、0.1 と表示されます。また、実行（F9）後、最初の▼押し下げ時には -0.2 ではなく、-0.1 と表示されます。それ以降（▲・▼２回目押し下げ以降）は正しく表示（意図した通り表示）されます。

オブジェクトインスペクタのIncrement プロパティに設定してある値が「１」のまま、コードで値を設定・変更する場合は（実行途中での変更はできませんが）FormCreate時に設定しておけば期待通りに動作するようです（もし、違っていたら、ごめんなさい）。

procedure TForm1.FormCreate(Sender: TObject);
begin
  UpDown1.Increment:=2;
end;

procedure TForm1.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
  //UpDown1.Increment:=2;
  Edit1.Text := FloatToStrF(UpDown1.Position / 10, ffNumber, 1, 1);
end;

PCの画面で確認すれば、設定状況がわかりやすいと思います。

以上が、TEditとTUpDownの組み合わせで小数値を増減させる方法のまとめです。

６．まとめ

（１）TEditとTUpDownの組み合わせで0.1刻みの数値の増減は可能。
（２）TUpDownで負の数を扱う場合は、Minプロパティの値も適切に設定する。
（３）TEditとTButtonの組み合わせで小数値の増減計算を行う場合は値「0」に注意する。

７．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

浮かんだままがいいときもあったりして！

【もくじ】

１．フローティングパネル
２．ドッキングさせたくない
３．メモリが解放できない
４．メモリが解放できた（その１）
５．メモリが解放できた（その２）
６．まとめ
７．お願いとお断り
８．【追記】

１．フローティングパネル

手書き答案の採点プログラムで、常にフォーム上に浮かべたまま、自由にその位置を変更可能な、作業補助用のGUI（フローティングパネル）が欲しくなった。

前回、縦書き答案の採点用に作成した横スクロールのフローティングGUIはControlBarの上にToolBarを置いて、その上にToolButtonやBevelを並べたけれど、今回はその名の通り、ベースとなるVCLはTPanelを選択。この上に効率よく採点作業を行うために最低限必要なButton他を置いて、ユーザーの視線やマウスの移動量を極めて限られた範囲に限定。操作に払う注意とストレスをできるだけ軽減して、より快適な作業環境を実現したい･･･。

そう考えて作成したGUIがコレ。

画面をタッチして操作することも考え、各Buttonの高さは44ピクセルに設定。
これを設問毎に、答案画像から切り抜いた画像を並べて表示したTImageのとなりに表示する。

フローティング状態だとTPanelの上に「閉じる」ボタンのあるタイトルバー？（キャプションバー？）が表示される。この部分をクリックして、そのままドラッグすれば、TPanelをForm上の任意の位置へ移動できる。ただし、Formにドッキング（FormのDockSiteプロパティをTrueに設定）した瞬間、タイトルバー？はかき消されたかのように消えてしまう･･･

以前作った（縦書き答案の採点を効率よく行うために左右方向のスクロールを行う）ドッキング・コントロールは、ドラッグ＆ドロップでFormにドッキングするように設計。必要であれば、Bevelをクリックしてそのままドラッグすることでドッキングを解除。任意の位置へ移動できる仕様とした。そんなに頻繁に位置を変更するようなモノでもなかったし。

ところが、今回はFormにドッキングさせると、いろいろ不都合が起きることが判明。

例えば、解答欄の大きさ（特に幅）に合わせて、この入力補助Toolの位置を頻繁に変えるような場合、クリックしてそのままドラッグできる「タイトルバー（キャプションバー）」がないと極めて不便。Formにドッキングした瞬間にこれが消えてしまうと、掴みどころがなくてほんとうに困るのだ。

それから、Formへドッキングしている状態から、引きはがしてフローティング状態になるときの挙動がとにかく急で！ うまく文字に表現できないのだけれど、感覚的には「うわっ」て感じ。GUIをクリックした瞬間に、「びっくりして飛び起きる」イメージでフローティングするのだ。

（数学風？に言えば、GUI上のクリックした位置が、GUIの左上の座標原点（0,0）の位置になるように、Button等のコントロールを載せているPanelの左上隅が瞬時にクリックした位置へ移動する）

また、最初の解答欄を表示している場合、１つ前に戻る「◀」ボタンはEnabledプロパティをFalseに設定し、クリックできないようにしてあるが、この Enabled:= False 状態のボタンをクリックすると上で述べたGUIが「びっくりして飛び起きる」ように瞬間移動する現象がおきてしまう。

さらに（原因はわからないけれど）、縦書き答案の採点時にFormにドッキングさせると、解答欄の表示が部分的にずれて二重に表示されてしまう（ドッキングさせなければ、この現象は起こらない）。

あれや、これやで、どぉーにもドッキング時の挙動が気に入らない。

じゃあ、
ドッキングさせなければいいじゃん！

･･･

そのとおり･･･

そのとおり、なんだけど･･･

そうすると･･･　コレが　･･･

コレが･･･　どぉーしても　消えなくて･･･

T_T

２．ドッキングさせたくない

メモリーリークの原因はわかってる。フローティングさせたTPanelをドラッグし始めた時に発生するStartDock手続きでCreateしているTToolDockObjectだ。

procedure TFormXXX.PanelXStartDock(Sender: TObject;
  var DragObject: TDragDockObject);
begin
  DragObject:= TToolDockObject.Create(Sender as TPanel);
end;

実は、これがなくても、フローティング動作は出来る。出来るんだけど、見た目に問題があって、高解像度画面で表示倍率を200％拡大のように設定している場合、ドラッグ（＝移動）中は灰色の枠だけのフローティングパネルのゴースト？が現れる。（画面のハードコピーがうまくとれなかったので）ゴースト？は、次の図のような感じ。

そして、このゴーストが目に痛い感じでちらつきながら移動する。さらに困ったことに、ドラッグ中はフローティングパネルの本体（ゴースト？でない方）は表示されない。ドラッグしてドロップした瞬間に、まるでテレポーテーションしたかのように（突如として）ドロップした位置にパネルが出現するのだ。

ただし、メモリーリークは起きない。
（なんにもCreateしていないから、起きるわけがない）

一方、メモリーリークを起こすとわかっていても、ドッキング可能なコントロールのドラッグ操作を専門的に管理するTToolDockObjectをCreateして動かすと、動きがたいへんスムーズ！ 気持ちイイ☆

だから、どうしてもドッキングさせたくない！
フローティングさせたまま、使いたい！！

  DragObject:= TToolDockObject.Create(Sender as TPanel);

そうなると、この１行はどうしても削れない･･･。

ただし、裏側では「メモリーリーク」がフローティングさせたパネルをドラッグする（＝位置を変える）度に、発生･･･

表面的には何事もなく、静かなんだけど。

３．メモリが解放できない

解決策はただひとつ。

ドラッグが終了した時点で、StartDock時に確保したメモリを解放すればいい。

ところが、FormのDockSiteプロパティがFalseのままだと
それが、どうにも、こうにも、難しい･･･

ちなみに次のように書いてみたんだけど、上の条件下では、これは、どうやら無効！！！のよう。

procedure TFormXXX.FormDockDrop(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer);
begin
  if IsDragObject(Source) then
  begin
    Source.Free;
  end;
end;

procedure TFormXXX.FormDockOver(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer; State: TDragState;
  var Accept: Boolean);
begin
  Accept:=IsDragObject(Source);
end;

OnDockDropは、「別のコントロールがコントロールにドッキングした際に発生」つまり「DockSite が True の際にのみ、発生する」ということで、そもそもFormのDockSiteプロパティは意図的にFalseに設定してあるんだから、OnDockDropイベントが起きるわけがない。

OnDockOverもおんなじで、「DockSite が True の際にのみ、発生する」とのこと。１００万回ドラッグしようとFormのDockSiteプロパティがFalseである限り、OnDockOverイベントも絶対に起きない。

ダメ元で、OnDragDrop手続きと、OnDragOver手続きを作成して上と同じコードを書いてみたんだけど、手続きの引数をよく見たら･･･

procedure TFormXXX.FormDragDrop(Sender, Source: TObject; X, Y: Integer);

Sourceが、TDragDockObjectじゃなくて、TObjectになってる･･･。ってコトは、こっちで受け取るためには、型キャストが必要ってコト？ なのかなーって思いつつ、FormのDockSiteプロパティをFalseに設定したまま、型キャストなしで次のコードを書いてみたが、Panelをドロップしても反応がない。どうやら、この２つのイベントは、FormのDockSiteプロパティがFalseだとTToolDockObjectのドロップに対しては発生しないようだ。⇦ 間違いだったら、ごめんなさい！

procedure TFormXXX.FormDragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if IsDragObject(Source) then
  begin
    Source.Free;
  end;
end;

procedure TFormXXX.FormDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := IsDragObject(Source);
end;

その他、FormのDockSiteプロパティをFalseに設定したまま、フローティングさせたPanelをドッキングさせずにドロップ時にメモリを解放する方法はないかとさんざん 悩んだが、解決策が見つからない。まさに七転八倒。終いには、ナニをどういじったらそうなったのか、自分でもわからないのだけれど、フローティング状態のパネルをクリックしただけで一般保護違反のエラーが出るようになり、元に戻せなくなってしまった･･･。

フローティング部品がない状態のバックアップをとっていて、ほんとうによかった。

【これが間違いであっても、前に進むために出した、自分なりの結論】

TToolDockObjectを使いたいならOnDockDropとOnDockOverイベント側で、ドラッグ＆ドロップを受け取るしかない。

４．メモリが解放できた（その１）

何かをCreateして使うプログラムを書くとき、FormCreate時に、次のようにメモリーリークがあれば検出する設定を僕は付け加えることに決めている。多数の画像を読み書きする答案処理のプログラムを書いた際に、Createしたオブジェクトの解放を書き忘れ、あとからCreateしている箇所を全部点検することになった「痛い経験」から学んだ予防的措置だ。

procedure TFormXXX.FormCreate(Sender: TObject);
begin
  //メモリーリークがあれば検出
  ReportMemoryLeaksOnShutdown:=True;
end;

メモリーリークがあった場合、実行（F9）したプログラムを終了させると（メインフォームを閉じると）、次の画面がリークを起こした回数付きで表示される。

丸１日がんばって、（この方法じゃダメなんだ）ということがはっきりわかったところで、少し休もうと思い、ベッドに倒れて･･･ そのまま、眠ってしまったようだ。

なんにも考えない時間が数時間あって･･･

目覚めたのは日付が変わる直前。眠って疲れがとれたからか？ その原因はわからないけど、目覚めた瞬間に、あることを思いついた。それは何かと言うと･･･

FormのDockSiteプロパティをTrueに設定すれば、OnDockDropとOnDockOverの２つのイベントが間違いなく？ Panelのドラッグ＆ドロップに反応してくれるから･･･

ドラッグしてるときだけ、FormのDockSiteプロパティをTrueに切り替えて、ドロップした瞬間の位置座標を取得し、そこへPanelをManualFloatさせて、最後にメモリを解放、DockSiteプロパティをFalseに戻せばいいんじゃない？ ってこと。

いろいろ実験的に書いていて（プロパティをあちこち変更）、設定忘れがあると困るので、ドラッグ開始時、コードの中でFormのDockSiteプロパティをTrueに設定。

procedure TFormXXX.PanelXStartDock(Sender: TObject;
  var DragObject: TDragDockObject);
begin
  //これでちらつかなくなった
  DragObject:= TToolDockObject.Create(Sender as TPanel);
  //設定し忘れないための予防的措置
  if not FormXXX.DockSite then
  begin
    FormXXX.DockSite:=True;
  end;
end;

ドロップ時のOnDockDropイベントは･･･

procedure TFormXXX.FormDockDrop(Sender: TObject;
  Source: TDragDockObject; X, Y: Integer);
var
  r:TRect;
begin
  if IsDragObject(Source) then
  begin
    r.Left:=X;
    r.Top:=Y;
    r.Right:=X+PanelX.Width;
    r.Bottom:=Y+PanelX.Height;
    PanelX.ManualFloat(r);
    //解放
    Source.Free;
    if FormXXX.DockSite then
    begin
      FormXXX.DockSite:=False;
    end;
  end;
end;

FormのDockSiteプロパティはFalseに設定。

実行（F9）して、フローティングパネルをドラッグ＆ドロップ。ちょっと気になったのはドロップ時のManualFloat(r)時の挙動。ドロップした場所でなく、ドロップ時にマウスポインタのカーソルがあった位置へ移動して表示されてしまう。次の画像の上がドロップ時、下がマウスの左ボタンを離した際にフローティングパネルが表示される位置。

ドロップ時、XにはPanelのLeftの値、YにはPanelのTopの値を取得するよう、プログラムを修正。

    r.Left:=PanelX.Left;
    r.Top:=PanelX.Top;
    r.Right:=r.Left+PanelX.Width;
    r.Bottom:=r.Top+PanelX.Height;
    PanelX.ManualFloat(r);
    //解放
    Source.Free;

これで表示位置に関する問題は解決できたが、今度は表示される際の挙動が気に入らない。ドロップ位置でPanelの画像が一瞬、最小化され（閉じるボタンだけになり）、それから全体が表示されるので、ドロップするたびにPanelが１回点滅するように見えるのだ。

それはそれで何とかするとして、いちばん何とかしなきゃいけないのはメモリーリーク。

恐る恐るプログラムを終了。

DelphiのIDE画面だけが表示され、リークの警告画面は出ない！
ようやく問題を解決できた･･･。

ただし、一難去ってまた一難。
表示方法を何とかしなきゃ･･･

５．メモリが解放できた（その２）

点滅の原因はわかっている。ドロップ時の ManualFloat(r) だ。

  DragObject:= TToolDockObject.Create(Sender as TPanel);

メモリーリークは起きるけど、上の一行だけでフローティングさせ、ドラッグ＆ドロップしている時は点滅なんてしなかった。要は ManualFloat させなければいいのだ。

（かならず、解決方法はある）

そう信じて、OnStartDockイベントの手続き部分でShift＋Ctrl＋1、OnDockDropイベントの手続き部分でShift＋Ctrl＋2を実行して、Ctrl＋1、Ctrl＋2でそれぞれの手続きへ移動できるように設定。

２つの手続き間を行きつ戻りつしながら解決方法を考える･･･

どう考えてみても、OnDockDropイベント側でなんとかするのは無理そう･･･

TToolDockObjectをCreateして移動させてる時は、ドロップ時に点滅しなかった･･･

表示された位置も、ドロップした場所だった･･･ だから、ManualFloat は不要？

確保したメモリを最後に解放すれば、メモリーリークは起こらない･･･

『最後に解放』？

そうだ「 try　･･･　finally　･･･　end; 」があった。

プロシージャを思った通りに書き換える。

procedure TFormCollaboration.PanelXStartDock(Sender: TObject;
  var DragObject: TDragDockObject);
begin
  DragObject:= TToolDockObject.Create(Sender as TPanel);
  try
    if not FormXXX.DockSite then
    begin
      FormXXX.DockSite:=True;
      Application.ProcessMessages;  //おまじない
    end;
  finally
    DragObject.Free;  //メモリの解放
  end;
  FormXXX.DockSite:=False;
end;

実行（F9）

フローティングパネルは快適に移動し、ドロップ時の挙動もごく自然･･･

祈りながらFormをClose.

見慣れたIDEだけが現れる。

メモリーリークは 起きてない。

やっと、思っていたとおりの ･･･ プログラムになった？

･･･ってか、ちょっと待て。オレ、OnDockDrop手続きの ManualFloat 消してないぞ。

もしかして･･･ OnDockDrop手続き 呼ばれていないんじゃないか？

自分の書いたプログラムを、もう一度、よく読んで考える･･･

  DragObject:= TToolDockObject.Create(Sender as TPanel);
  try
    if not FormXXX.DockSite then
    begin
      FormXXX.DockSite:=True;
      Application.ProcessMessages;  //おまじない
    end;
  finally
    DragObject.Free;  //メモリの解放
  end;

DragObject を、最後に Free してるから、ドロップ時にはもう TToolDockObject は消えてる･･･。
消えてるんだから･･･　もう、『ない』んだから、呼ばれてないんじゃなくて･･･

OnDockDropイベントは起こらない！

･･･ってコトは、もしかして

DragObject:= TToolDockObject.Create(Sender as TPanel);
try
  //何もしない
Finally
  DragObject.Free;
end;  

Createして、Freeするだけで

よかったの？

６．まとめ

今回の状況を何かに例えるならそれはナニ？って、生成AIに訊ねたところ、

　“Still waters run deep”

そう答えてくれました。深く、静かに、感動。

７．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

８．【追記】

  finally
    //DragObject.Free;  //メモリの解放のみ->インスタンス（オブジェクトの実体）はあるので参照可能
    FreeAndNil(DragObject);  //インスタンスも消える！
  end;

.Freeでなく、FreeAndNilすると、何もしなかったコトと同じになってしまいます。
注意してください！！

高DPIに対応しました！

これまでずっとPC画面の解像度は1366×768に固定して、この解像度での使用のみを前提に、僕はプログラムを書いてきた･･･。僕のプログラムが走るマシンは全部、この解像度だったから、それで何も問題は起きなかったのだけれど。

【今回の記事】

１．2880×1920の世界を知る
２．Formの表示がたいへんなコトに･･･
３．問題点を続々と発見！
４．exeを高DPI対応に設定
５．VCLの幅や高さを自動調整
６．まとめ
７．お願いとお断り

１．2880×1920の世界を知る

新しく支給されたPCの画面解像度は2880×1920で、拡大縮小率は150％に設定されてた。持ち運ぶことを考えると、ノートPCの画面サイズはそうそう大きく出来ないから、画面サイズが変わらないまま、解像度だけ上がってしまうと、相対的にアプリや文字の見た目はどんどん小さくなって、目にとてもやさしくない画面になる。だから拡大150％や拡大200％って設定が必要なんだと思うけど･･･。

取り敢えず、この環境で僕のプログラムを動かすとどうなるか、実験してみた。

高解像度画面では、ボタンのCaptionが読めない･･･。

２．Formの表示がたいへんなコトに･･･

しかも、このプログラムから別のFormを呼び出すと･･･

自分的には、こう表示されてほしいのですが･･･
（今までは何の問題もなく、こう表示されていた）

やばい。何としても高DPIに対応させないと、職場のみんなにプログラムを使ってもらうどころか、自分ひとりですら使えない。画面が高解像度になっただけで、こんな問題が生まれるなんて･･･。これまで考えたこともなかった。

けっこうショックが大きくて、心がまた折れかけたけど、この問題をクリアすれば、プログラムも、僕も、もっとよくなれるんだって、必死で自分に言い聞かせる。

３．問題点を続々と発見！

高解像度画面で一通り、プログラムの動作検証を行ってみると、見つけられただけで次のような問題が発生することがわかった。

① Formが設計時とは異なる大きさで表示される。
② 画面表示の拡大設定を行わないと、字が読めないくらい小さくなる。
③ 拡大設定時には、VCLコントロール（Toolbar）の幅や高さが意図しないものになる。

まず、①の問題の解決にチャレンジ。

FormCreate手続きでFormの幅を指定しても無駄。
まるで言うことを聞いてくれない。
いったいナニがどうなると、この問題が発生するのか？
これまで、こんな問題に出会ったこと、ないぞ･･･。

そう思いつつ、いろいろ調べてみると、次の情報を発見。

フォームを新規作成したらまずやる事 (Delphi)

https://ht-deko.com/ft1004.html#100408_02

明らかな既視感があったので、以前、どこかで見た情報に間違いないと思うのだけれど、知識として使ったことがなかったので、情報の有用性に気づいてなかった･･･。

この中に、Scaledプロパティに関して、次の記述が･･･

Scaled
常に False。True にすると OS の DPI (ユーザが指定した DPI) によってフォームサイズやコントロールサイズが勝手に変更されてしまいます。

（たぶん、コレだ･･･）

早速、すべてのFormのScaledプロパティをFalseに変更。なんでこんな問題を起こすような設定がデフォルトでTrueなんだ？･･･何か、大切な理由でもあるんだろうか？

動かして確認。

これで①の問題は解決。思ったより簡単に解決できて、よかった！

４．exeを高DPI対応に設定

②の文字の大きさについて、Google先生にいろいろきいた結果、こちらもベストと思われる対応方法を発見。

Windows11でアプリやメニューが小さい時に行う高DPI設定

https://win11lab.info/win11-high-dpi/

設定方法は、次の通り。

で、OK → 適用 → OK と順にボタンを押して画面を閉じ、アプリを再起動すると、Formが適正な倍率で表示されてアプリやメニューが見やすくなった。ちなみに「システム」ではなく、「アプリケーション」では表示に変化がなく、「システム（拡張）」ではFontが高解像度化された感じに。

いちどexeにこの設定を実行しておけば、画面の解像度をいろいろ変更しても常にFormは適正な大きさで表示されるようになり、たいへん便利！

Windowsには、ほんとうにいろんな画面解像度の設定があるから、exeに対するこのおまじないは必須なのかもしれない･･･。これで②の問題も無事解決。

結局、②の問題は、プログラムではなく、OS側の設定の問題だった。

５．VCLの幅や高さを自動調整

最後に残った③の問題に取り組む。まず、これがどういう現象かと言うと･･･

手書き答案採点プログラムで、画面を横にスクロールさせるために作ったToolbarコントロールが、本来なら次のように表示されるはずなのに･･･

上の４の設定を行わず、かつ、画面の拡大縮小が100％でない場合には･･･

職場のマシンたちは全部！デフォルト設定が「高解像度」で、画面の拡大率150％だから、何にもしないで僕のプログラムを配布されたままの状態で動かしたら、間違いなく、この問題が発生してしまう･･･。

マジ、困った･･･。

すがるような思いでGoogle先生に援けを乞う。すると･･･

03_高 DPI における画像の描画サイズ調整

http://mrxray.on.coocan.jp/Delphi/Others/DisplayDPI_Image.htm#03

またしても、Mr.XRAYさんのサイトに救いとなる情報を発見！

職場では、僕のことを「困った時の〇〇さん･･･」と呼ぶ人がいるけど、
僕にとってMr.XRAYさんは、「本当に困った時のMr.XRAYさん」です。

これまでにいったい何度、僕の窮地を救ってくださったことか･･･。
あらためてMr.XRAYさんに、心から感謝のありがとうです。

Mr.XRAYさんのホームページにあった情報をもとにプログラムを次のように修正。

procedure TFormCollaboration.btnSelectClick(Sender: TObject);

  //--------------------------------------------------------------------------
  //  ディスプレイの拡大縮小の比率を取得
  //  100% の時は 1.0．150% の時は 1.5 を返す
  //--------------------------------------------------------------------------
  function GetDpiRatio: Extended;
  var
    LXDpi : Integer;
  begin
    LXDpi := GetDeviceCaps(GetDC(0), LOGPIXELSX);
    Result := LXDpi / USER_DEFAULT_SCREEN_DPI;
  end;

var
  ・・・
  //高DPIに対応する
  VCL_Width:Extended;
  VCL_Height:Extended;

begin

  ・・・

  //解像度が変わると不具合がでる
  //r.Right := r.Left+ToolBar1.Width;
  //r.Bottom := r.Top+ToolBar1.Height;

  //解像度の変更に対応
  //幅
  VCL_Width := (ToolButton1.Width + 
    ToolButton2.Width + ToolButton3.Width + Bevel1.Width) * GetDpiRatio;
  r.Right := r.Left + Trunc(VCL_Width);
  //高さ
  VCL_Height := ToolBar1.Height * GetDpiRatio;
  r.Bottom := r.Top + Trunc(VCL_Height);

  ・・・

end;

GetDpiRatio関数を使ってディスプレイの拡大・縮小の比率を計算し、これをVCLコントロールの幅と高さに掛けて、コントロールが適切に描画されるように設定。

こうしてプログラム側でも、VCLコントロールの幅や高さを画面の拡大縮小に合わせるように設定しておけば、exeそのものに「高 DPI 設定の変更」を設定しなくても･･･

これで③の問題も無事解決できた！

プログラムも、僕も、よくなれた☆

それは間違いない･･･から、いいんだけれど。
ひとりでも、戦えるかな･･･

Let me see you through.

空を見上げて･･･

I’m missing you.

そう思えてならない時が、あるんだ。

６．まとめ

（１）様々な画面解像度に対応するには、FormのScaledプロパティをFalseに設定。
（２）画面の拡大縮小に対応するにはプロパティの「高 DPI 設定の変更」を利用。
（３）画面の拡大縮小にプログラムコードでも対応可能。

７．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。ここに記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。

「画像のクリック位置とグリッドコントロールの連動」

画像を表示したTImageの任意の１点をクリックしたら、そのY座標に応じてStringGridコントロールの適切なセルを選択するようなプログラムが書けないかなー。･･･と思って、実際に書いてみたら、あまりにも簡単に実現できてしまったお話。

１．やりたかったこと
２．作成したプログラム
３．まとめ
４．お願いとお断り

１．やりたかったこと

次のようなGUIのある採点プログラムを作成した。プログラムはスキャナーで読み込んだ複数枚の答案画像から、設問ごとに解答欄をかき集めて表示するもの（答案画像への書き戻しも可能）。で、採点作業をより一層効率的に行うには、各々の解答欄画像をクリックした際、自動的に採点結果を入力するGridコントロールのセルが選択されたらイイなーと思ったことが、この連動プログラムを書こうとしたきっかけです。

２．作成したプログラム

まず、思ったことはTImageのOnMouseDownイベントを利用すればイイ（画像上でクリックした位置のX, Y座標が取得できる）ということです。早速、imgAnswerという名前をつけたTImageをクリックして選択し、OnMouseDownイベントの右側をダブルクリックして、imgAnswerMouseDown手続きを作成。

次のようなコードを書いてみました！

procedure TFormCollaboration.imgAnswerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  //imgAnswerの高さは、解答欄１つの高さ × 解答用紙数 だから
  //クリックした場所の(Y座標 div 解答欄１つの高さ) + 1 が解答用紙の番号になるはず
  OutPutDebugString(PChar(IntToStr((Y div 解答欄１つの高さ) + 1)));   
end;

実行（F9）して、確認。

必要と思われる変数 i, j を宣言して･･･
あとは Gridコントロールへ SetFocus するコードを書くだけ！

procedure TFormCollaboration.imgAnswerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i,j:integer;
begin
  //imgAnswerの高さは、解答欄１つの高さ × 解答用紙数 だから
  //クリックした場所の(Y座標 div 解答欄１つの高さ) + 1 が解答用紙の番号になるはず
  OutPutDebugString(PChar(IntToStr((Y div 解答欄１つの高さ) + 1)));
  i:= (Y div 解答欄１つの高さ) + 1;
  //SetFocus
  j:= StrToInt(現在選択している解答欄の番号);
  StringGrid1.Col:= j;
  StringGrid1.Row:= i;
  StringGrid1.SetFocus;   
end;

上のコードでは、わかりやすさのため変数（記号）ではなく、そのかわりに「解答欄１つの高さ」等のように説明の文字列で記述しています。また、採点ミスを防止する観点から、Gridコントロールに表示する入力可能な列は、現在選択（＝画像として表示）している解答欄に対応する１列のみとしています。

これで理想としていたカタチの採点プログラムに一歩近づけたように思います。ユーザーに案内したい採点方法は、サっと見て全員が良く出来ている設問であれば、最初に全員正解として得点を一括自動入力し、誤りの解答のみ、解答欄画像を見ながらチェックしてクリック、自動選択された採点欄のセルにゼロ（得点）を入力する方法です。

３．まとめ

案ずるよりナントカといいますが、ほんとうにその通りで、内心、ずっとできるかなー？　なんて思っていたことが、案外、基本的な知識だけで簡単に実現できてしまいました！

//Integer 型で、割り算をしたいときは、整数除算の演算を行う div を使う
A div B  //A ÷ B の商が取得できる

あとは、やりたいことを実現するアルゴリズムを考えるだけですね！
プログラミングしていて、いちばんしあわせで、楽しい時間を過ごせました☆

【注意！】
画像の表示倍率の変更が伴う場合には、表示倍率に合わせてプログラムの変更が必要です。完璧には動作しませんが、ある程度使える（と思われる）表示倍率の変更に対応するコードは次の通りです（クリック位置が画像の下へ行くほど、誤差が大きくなります）。

procedure TFormCollaboration.imgAnswerMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i,j,w:integer;
  k:double;
begin
  //imgAnswerの高さは、解答欄１つの高さ × 解答用紙数 だから
  //クリックした場所の(Y座標 div 解答欄１つの高さ) + 1 が解答用紙の番号になるはず
  OutPutDebugString(PChar(IntToStr((Y div 解答欄１つの高さ) + 1)));
  i:= (Y div 解答欄１つの高さ) + 1;
  //表示倍率が100％の時
  if Edit1.Text='100' then
  begin
    i:=(Y div 解答欄１つの高さ)+1;  //このアルゴリズムは記録として残したい
  end else begin
    //表示倍率が100％ではない時
    k:= 解答欄１つの高さ * (StrToFloat(Edit1.Text)/100);
    i:=Ceil(Float(Y)/k);  // <- とりあえずこれで使えるカモ？
  end;

４．お願いとお断り

このサイトの内容を利用される場合は、自己責任でお願いします。記載した内容を利用した結果、利用者および第三者に損害が発生したとしても、このサイトの管理者は一切責任を負えません。予め、ご了承ください。