組み合わせ採点を行うプログラムを書いた際、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のデータを用紙と向きを指定して罫線付きで印刷するコードを掲載
（２）（１）のコードを流用して、印刷プレビューを表示するコードを掲載
（３）変数名を付ける時は既存の関数名等との衝突に十分に注意する。

８．お願いとお断り

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