Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2000年12月12日] [更新 2016年04月19日]　印刷プレビュー制御コンポーネント
印刷プレビュー制御コンポーネント
テストプログラム　QueryPrint
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro






クエリーの結果を印刷 ( 先読み方式・逐次表示方式 )


エリーの結果を表形式で印刷する例です．プログラムは，表の罫線を引くルーチンと実際のデータを印刷するルーチンに分けて，1 行の行高さから印刷行数を計算し，そこから必要な頁数も計算する方法を使用しています．また，BLOB 型データの印刷例も示しました．プログラムは 3 つですが，プレビューフォーム，印刷プレビューコンポーネントとも 1 つを兼用しています．
実行には，Delphi に付属の DBDEMOS というデータベースが必要です．


[備考]
このテストプログラムは，BDE 経由で Paradox のデータを扱っています．DBDEMOS は Paradox データベースのエイリアス名です．


図1
設計時の画面
図2
表形式の実行結果
図3
画像とメモ項目の実行結果

リスト1
メインフォームのコード．作成した描画用のメソッドを呼出す方式 
unit QueryPrintUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons, plPrev;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    StaticText1: TStaticText;
    plPrev1: TplPrev;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  Unit1,
  Unit2,
  Unit3;

{$R *.DFM}

//=============================================================================
//  先読み方式で表の印刷
//  Unit1のQPrint1というクラスのPrintContメソッドを実行
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
   QPrint1.PrintCont;
end;

//=============================================================================
//  逐次表示方式で表の印刷
//  Unit2のQPrint2というクラスのPrintStatメソッドを実行
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  QPrint2.PrintStat;
end;

//=============================================================================
//  BLOB型データの印刷
//  Unit3のQPrint2というクラスのPrintBlobメソッドを実行
//  描画開始まで少し時間がかかる
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  QPrint3.PrintBlob;
end;

end.


リスト2
Unit1 のコード．表形式でデータ表示 (先読み方式) 
unit Unit1;

interface

type
  TQPrint1 = class
  private
    procedure PageKeisen(Yt, Yb, RowCnt: Integer);
    function GetRowCnt(Yt, Yb: Integer): Integer;
    procedure PrintOnePage(Yt, Yb, RowCnt: Integer);
  public
    procedure PrintCont;
  end;

var
  QPrint1: TQPrint1;

implementation

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Math, DM1Unit, plPrev, QueryPrintUnit;

//  共通変数
//  見やすいようにここに書いているが実際にはprivate,public部がいいだろう
var
  FStartPosY1 : Integer;                //1頁目の表上端
  FStartPosY2 : Integer;                //2頁目以降の表上端
  FEndPosY    : Integer;                //表下端の下限値
  FRowHeight  : Integer;                //行高
  FRowCount1  : Integer;                //1頁目の行数
  FRowCount2  : Integer;                //2頁以降の行数
  FVKeisenPos : array[0..5] of Integer; //縦罫線の位置
  FplPrev     : TplPrev;                //印刷プレビュー制御コンポ

//-----------------------------------------------------------------------------
//  先読み方式による描画ルーチン
//
//  行の高さを決めれば１頁に印刷可能な行数が決まる(行数を決定してから行高さを
//  決定する場合も考えられる．あるいは指定の形式の場合は行高さも行数も決められ
//  ていることもある)．
//  ここではA4縦(210.0mm,297.0mmと仮定)で行高さを10.0mmとし，１頁目はタイトル
//  の印刷分を空けるものとする．
//
//  (用紙の下に印刷余裕が無くなったら改頁する方法もある)
//-----------------------------------------------------------------------------
procedure TQPrint1.PrintCont;
begin
  //plPrevはForm1のplPrev1を使用
  FplPrev := Form1.plPrev1;

  FVKeisenPos[0] := 150;
  FVKeisenPos[1] := 320;
  FVkeisenPos[2] := 920;
  FVkeisenPos[3] := 1090;
  FVkeisenPos[4] := 1670;
  FVkeisenPos[5] := 1970;

  FStartPosY1 := 500;
  FStartPosY2 := 300;
  FEndPosY    := 2700;
  FRowHeight  := 100;

  with DM1.Query1 do begin
    Close;
    SQL.Clear;
    SQL.Add('select CustNo, Company, Zip, Addr1, Phone from customer');
    Open;
  end;

  //1頁目の印刷可能行数
  FRowCount1 := GetRowCnt(FStartPosY1, FEndPosY);
  //2頁目以降の印刷可能行数
  FRowCount2 := GetRowCnt(FStartPosY2, FEndPosY);

  FplPrev.Title := '表の印刷例';
  FplPrev.BeginDoc;
  try
    while True do begin
      //1頁目と2頁目以降では罫線描画開始位置と行数が異なるので別々
      if FplPrev.PageNumber = 1 then begin
        FplPrev.FontName('ＭＳ Ｐゴシック');
        FplPrev.FontHeight(80);
        FplPrev.TextRectJust(FVKeisenPos[0] + 500,
                             FVKeisenPos[5] - 500,
                             250,
                             400,
                             '表の印刷例');
        //1頁分のデータを描画
        PrintOnePage(FStartPosY1, FEndPosY, FRowCount1);
        //罫線を描画
        PageKeisen(FStartPosY1, FEndPosY, FRowCount1);
      end else begin
        //1頁分のデータを描画
        PrintOnePage(FStartPosY2, FEndPosY, FRowCount2);
        //罫線を描画
        PageKeisen(FStartPosY2, FEndPosY, FRowCount2);
      end;
      //データが無ければ終了
      if DM1.Query1.Eof then break;
      FplPrev.NewPage;
    end;
  finally
    FplPrev.EndDoc;
  end;
  //Showで表示してしまうと次行でクエリーが閉じてしまう
  FplPrev.ShowModal;

  DM1.Query1.Close;
end;

//-----------------------------------------------------------------------------
//  表の罫線部分と印刷日時を印刷
//
//  共通部分と考えられる表の罫線と印刷日時を印刷するルーチン．
//  つまり書類の背景と言える部分のコード．
//  Yt      表の上端Y座標
//  Yb      表の下端Y座標．
//  RowCnt  行数.1頁と2頁以降では異なる
//-----------------------------------------------------------------------------
procedure TQPrint1.PageKeisen(Yt, Yb, RowCnt: Integer);
var
  LPosY    : Integer;
  LBottom  : Integer;
  LLeft    : Integer;
  LRight   : Integer;
  LDateStr : String;
  LRowNo : Integer;
  LColNo : Integer;
begin
  FplPrev.LineWidth(1);
  FplPrev.LineStyle(psDot);

  LLeft  := FVKeisenPos[0];
  LRight := FVKeisenPos[Length(FVKeisenPos) - 1];
  FplPrev.LineWidth(1);

  //横罫線はタイトル行も含めるので+1
  for LRowNo := 1 to RowCnt + 1 do begin
    LPosY := Yt + (LRowNo - 1) * FRowHeight;
    FplPrev.Line(LLeft, LRight, LPosY, LPosY);
  end;

  //縦罫線の一番下のY座標値
  LBottom := Yt + RowCnt * FRowHeight;

  //縦罫線の描画
  for LColNo := 0 to Length(FVKeisenPos) - 1 do begin
    FplPrev.Line(FVKeisenPos[LColNo], FVKeisenPos[LColNo], Yt, LBottom);
  end;

  //印刷日時を描画．書類は何時誰がが基本
  LDateStr := '印刷日時 ' + FormatDateTime('yyyy/mm/dd  hh:nn', Now);
  FplPrev.FontName('ＭＳ 明朝');
  FplPrev.FontSize(8);
  FplPrev.TextOutRC(LRight, Yb + 50, LDateStr);
end;

//-----------------------------------------------------------------------------
//  Y座標の上端，下端と行高さから描画可能な行数を算出
//  逐次表示方式と同じコード
//  Yt      表の上端Y座標
//  Yb      表の下端Y座標．
//-----------------------------------------------------------------------------
function TQPrint1.GetRowCnt(Yt, Yb: Integer): Integer;
begin
  Result := Trunc((Yb - Yt) / FRowHeight);
end;

//-----------------------------------------------------------------------------
//  1頁分の印刷ルーチン 逐次表示方式と同じコード
//  RowHの行高でRowCnt行分だけ描画する
//  Yt      表の上端Y座標
//  Yb      表の下端Y座標．
//-----------------------------------------------------------------------------
procedure TQPrint1.PrintOnePage(Yt, Yb, RowCnt: Integer);
var
  LX1    : Integer;
  LX2    : Integer;
  LY1    : Integer;
  LY2    : Integer;
  LText  : String;
  LRowNo : Integer;
  LColNo : Integer;
begin
  //タイトル行である１行目は色付きセルとする
  FplPrev.BrushColor($00D9FFD9);
  FplPrev.FontName('ＭＳ Ｐゴシック');
  FplPrev.FontHeight(45);
  FplPrev.FillRect(FVKeisenPos[0], FVKeisenPos[5], Yt, Yt + FRowHeight);

  for LRowNo := 1 to RowCnt do begin
    for LColNo := 0 to Length(FVKeisenPos) - 2 do begin
      LX1 := FVKeisenPos[LColNo];
      LX2 := FVKeisenPos[LColNo + 1];
      LY1 := Yt + (LRowNo - 1) * FRowHeight;
      LY2 := Yt + LRowNo * FRowHeight;

      //タイトル行
      if LRowNo = 1 then begin
        FplPrev.TextRectCC(LX1, LX2, LY1, LY2, DM1.Query1.Fields[LColNo].FieldName);
      end else begin
        //データの描画
        LText := '';
        //データ項目値に応じて描画
        case LColNo of
          0:
          begin //CustNo
            LText := IntToStr(DM1.Query1.FieldByName('CustNo').AsInteger);
            FplPrev.TextRectRC(LX1, LX2 - 15, LY1, LY2, LText);
          end;
          1: //Company
          begin
            LText := DM1.Query1.FieldByName('Company').AsString;
            FplPrev.TextRectLC(LX1 + 15, LX2, LY1, LY2, LText);
          end;
          2: //Zip
          begin
            LText := DM1.Query1.FieldByName('Zip').AsString;
            FplPrev.TextRectRC(LX1, LX2 - 12, LY1, LY2, LText);
          end;
          3: //Addr1
          begin
            LText := DM1.Query1.FieldByName('Addr1').AsString;
            FplPrev.TextRectLC(LX1 + 15, LX2, LY1, LY2, LText);
          end;
          4: //Phone
          begin
            LText := DM1.Query1.FieldByName('Phone').AsString;
            FplPrev.TextRectLC(LX1 + 15, LX2, LY1, LY2, LText);
          end;
        end;
      end;
    end;
    //タイトル行でなければ次のデータ
    if LRowNo > 1 then DM1.Query1.Next;

    //データがなければ終了
    if DM1.Query1.Eof then Break;
  end;
end;

end.


リスト3
Unit2 のコード．表形式でデータ表示 (逐次表示方式) 
unit Unit2;

interface

type
  TQPrint2 = class
  private
    procedure PrintRoutine;
    procedure PageKeisen(Yt, Yb, RowCnt: Integer);
    function GetRowCnt(Yt, Yb: Integer): Integer;
    procedure PrintOnePage(Yt, Yb, RowCnt: Integer);
  public
    procedure PrintStat;
  end;

var
  QPrint2: TQPrint2;

implementation

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Math,DM1Unit, plPrev, QueryPrintUnit;

//  共通変数
//  見やすいようにここに書いているが実際にはprivate,public部がいいだろう
var
  FStartPosY1  : Integer;                //1頁目の表上端
  FStartPosY2  : Integer;                //2頁目以降の表上端
  FEndPosY     : Integer;                //表下端の下限値
  FRowHeight   : Integer;                //行高
  FRowCount1   : Integer;                //1頁目の行数
  FRowCount2   : Integer;                //2頁以降の行数
  FRecordCount : Integer;                //レコード数
  FPageCount   : Integer;                //総頁数
  FVKeisenPos  : array[0..5] of Integer; //縦罫線の位置
  FplPrev      : TplPrev;                //印刷プレビュー制御コンポ

//-----------------------------------------------------------------------------
//  各種の値を計算して実際の描画ルーチンを呼び出す
//
//  行の高さを決めれば１頁に印刷可能な行数が決まる(行数を決定してから行高さを
//  決定する場合も考えられる．あるいは指定の形式の場合は行高さも行数も決められ
//  ていることもある)．
//  ここではA4縦(210.0mm,297.0mmと仮定)で行高さを10.0mmとし，１頁目はタイトル
//  の印刷分を空けるものとする．
//-----------------------------------------------------------------------------
procedure TQPrint2.PrintStat;
begin
  //plPrevはForm1のplPrev1を使用
  FplPrev := Form1.plPrev1;

  FVKeisenPos[0] := 150;
  FVKeisenPos[1] := 320;
  FVKeisenPos[2] := 920;
  FVKeisenPos[3] := 1090;
  FVKeisenPos[4] := 1670;
  FVKeisenPos[5] := 1970;

  FStartPosY1 := 500;
  FStartPosY2 := 300;
  FEndPosY    := 2700;
  FRowHeight  := 100;

  with DM1.Query1 do begin
    SQL.Clear;
    SQL.Add('select Count(CustNo) as RecCnt from customer ');
    Open;
    FRecordCount := DM1.Query1.FieldByName('RecCnt').AsInteger;
    Close;
    SQL.Clear;
    SQL.Add('select CustNo, Company, Zip, Addr1, Phone from customer');
    Open;
  end;

  //1頁目の印刷可能行数
  FRowCount1 := GetRowCnt(FStartPosY1, FEndPosY);

  //2頁目以降の印刷可能行数
  FRowCount2 := GetRowCnt(FStartPosY2, FEndPosY);

  //PageCntが総頁数．-1はタイトル行分．切上げ計算しないと頁数不足
  FPageCount := Ceil(((FRecordCount) - (FRowCount1 - 1)) / (FRowCount2 - 1)) + 1;

  FplPrev.Title     := '表の印刷例';
  FplPrev.PageCount := FPageCount;
  FplPrev.ProcName  := PrintRoutine;

  //Showで表示してしまうと次行でクエリーが閉じてしまう
  FplPrev.ShowModal;
  DM1.Query1.Close;
end;

//-----------------------------------------------------------------------------
//  逐次表示方式の印刷ルーチン
//  PageNumberによって処理を分岐
//-----------------------------------------------------------------------------
procedure TQPrint2.PrintRoutine;
begin
  if FplPrev.PageNumber = 1 then begin
    //1頁目は表のタイトルを印刷
    DM1.Query1.First;
    FplPrev.FontName('ＭＳ Ｐゴシック');
    FplPrev.FontHeight(80);
    FplPrev.TextRectJust(FVKeisenPos[0] + 500,
                         FVKeisenPos[5] - 500,
                         250,
                         400,
                         '表の印刷例');

    //1頁分のデータを描画
    PrintOnePage(FStartPosY1, FEndPosY, FRowCount1);

    //罫線を描画
    PageKeisen(FStartPosY1, FEndPosY, FRowCount1);
  end else begin
    DM1.Query1.First;
    if FplPrev.PageNumber = 2 then begin
      DM1.Query1.MoveBy(FRowCount1 - 1); //-1はタイトル行の分
    end else begin
      DM1.Query1.MoveBy((FRowCount1 - 1) + (FplPrev.PageNumber - 2) * (FRowCount2 - 1));
    end;

    //1頁分のデータを描画
    PrintOnePage(FStartPosY2, FEndPosY, FRowCount2);

    //罫線を描画
    PageKeisen(FStartPosY2, FEndPosY, FRowCount2);
  end;
end;

//-----------------------------------------------------------------------------
//  表の罫線部分と頁番号と印刷日時を印刷　　　
//
//  共通部分と考えられる表の罫線と頁数と印刷日時を印刷するルーチン．
//  つまり書類の背景と言える部分のコード．
//  Yt      表の上端Y座標
//  Yb      表の下端Y座標．
//  RowCnt  行数.1頁と2頁以降では異なる
//-----------------------------------------------------------------------------
procedure TQPrint2.PageKeisen(Yt, Yb, RowCnt: Integer);
var
  LLeft    : Integer;
  LRight   : Integer;
  LTop     : Integer;
  LBottom  : Integer;
  LPageStr : String;
  LDateStr : String;
  LRowNo   : Integer;
  LColNo   : Integer;
begin
  LLeft  := FVKeisenPos[0];
  LRight := FVKeisenPos[Length(FVKeisenPos) - 1];
  FplPrev.LineWidth(1);

  //横罫線はタイトル行も含めるので+1
  for LRowNo := 1 to RowCnt + 1 do begin
    LTop := Yt + (LRowNo - 1) * FRowHeight;
    FplPrev.Line(LLeft, LRight, LTop, LTop);
  end;

  //縦罫線の一番下のY座標値
  LBottom := Yt + RowCnt * FRowHeight;

  //縦罫線の描画
  for LColNo := 0 to Length(FVKeisenPos) - 1 do begin
    FplPrev.Line(FVKeisenPos[LColNo], FVKeisenPos[LColNo], Yt, LBottom);
  end;

  //頁番号と頁数を描画
  LPageStr := '- ' + IntToStr(FplPrev.PageNumber) + '/' + IntToStr(FPageCount) + ' -';
  FplPrev.FontSize(12);
  FplPrev.TextOutCC(FplPrev.PaperWidth div 2, Yb + 50, LPageStr);

  //印刷日時を描画．書類は何時誰がが基本
  LDateStr := '印刷日時 ' + FormatDateTime('yyyy/mm/dd  hh:nn', Now);
  FplPrev.FontName('ＭＳ 明朝');
  FplPrev.FontSize(8);
  FplPrev.TextOutRC(LRight, Yb + 50, LDateStr);
end;

//-----------------------------------------------------------------------------
//  Y座標の上端，下端と行高さから描画可能な行数を算出
//  先読み方式と同じコード
//  Yt      表の上端Y座標
//  Yb      表の下端Y座標．
//-----------------------------------------------------------------------------
function TQPrint2.GetRowCnt(Yt, Yb: Integer): Integer;
begin
  Result := Trunc((Yb - Yt) / FRowHeight);
end;

//-----------------------------------------------------------------------------
//  1頁分の印刷ルーチン 先読み方式と同じコード
//  RowHの行高でRowCnt行分だけ描画する
//  Yt      表の上端Y座標
//  Yb      表の下端Y座標．
//-----------------------------------------------------------------------------
procedure TQPrint2.PrintOnePage(Yt, Yb, RowCnt: Integer);
var
  LX1    : Integer;
  LX2    : Integer;
  LY1    : Integer;
  LY2    : Integer;
  LText  : String;
  LRowNo : Integer;
  LColNo : Integer;
begin
  //タイトル行である１行目は色付きセルとする
  FplPrev.BrushColor($00D9FFD9);
  FplPrev.FontName('ＭＳ Ｐゴシック');
  FplPrev.FontHeight(45);
  FplPrev.FillRect(FVKeisenPos[0], FVKeisenPos[5], Yt, Yt + FRowHeight);

  for LRowNo := 1 to RowCnt do begin
    for LColNo := 0 to Length(FVKeisenPos) - 2 do begin
      LX1 := FVKeisenPos[LColNo];
      LX2 := FVKeisenPos[LColNo + 1];
      LY1 := Yt + (LRowNo - 1) * FRowHeight;
      LY2 := Yt + LRowNo * FRowHeight;

      {タイトル行}
      if LRowNo = 1 then begin
        FplPrev.TextRectCC(LX1, LX2, LY1, LY2, DM1.Query1.Fields[LColNo].FieldName);
      end else begin
        //データの描画
        LText := '';
        //データ項目値に応じて描画
        case LColNo of
          0: //CustNo
          begin
            LText := IntToStr(DM1.Query1.FieldByName('CustNo').AsInteger);
            FplPrev.TextRectRC(LX1, LX2 - 15, LY1, LY2, LText);
          end;
          1: //Company
          begin
            LText := DM1.Query1.FieldByName('Company').AsString;
            FplPrev.TextRectLC(LX1 + 15, LX2, LY1, LY2, LText);
          end;
          2: //Zip
          begin
            LText := DM1.Query1.FieldByName('Zip').AsString;
            FplPrev.TextRectRC(LX1, LX2 - 12, LY1, LY2, LText);
          end;
          3: //Addr1
          begin
            LText := DM1.Query1.FieldByName('Addr1').AsString;
            FplPrev.TextRectLC(LX1 + 15, LX2, LY1, LY2, LText);
          end;
          4: //Phone
          begin
            LText := DM1.Query1.FieldByName('Phone').AsString;
            FplPrev.TextRectLC(LX1 + 15, LX2, LY1, LY2, LText);
          end;
        end;
      end;
    end;

    //タイトル行でなければ次のデータ
    if LRowNo > 1 then DM1.Query1.Next;
    //データがなければ終了
    if DM1.Query1.Eof then Break;
  end;
end;

end.


リスト4
Unit3 のコード．画像とメモ項目データの表示 (先読み方式) 
unit Unit3;

interface

uses Windows,Db,Graphics;

type
  TQPrint3 = class
  private
    procedure PageKeisen(Yt, Ytt, Yb, RowCnt: Integer);
    function GetRowCnt(Yt, Yb: Integer): Integer;
    procedure PrintOnePage(Yt, Ytt, Yb, RowCnt: Integer);
    procedure PrintOneGraphic(X1, X2, Y1, Y2: Integer; FldName: TField);
    procedure PrintOneNote(X1, X2, Y1, Y2: Integer; FldName: TField);
    procedure PrintOneNoteEx(X1, X2, Y1, Y2: Integer; FldName: TField);
  public
    procedure PrintBlob;
  end;

var
  QPrint3: TQPrint3;

implementation

uses
  Messages, SysUtils, Classes, Controls, Forms, Dialogs,
  Math, DM1Unit, plPrev, QueryPrintUnit, TextUtils;

{ TQPrint3 }

//  共通変数
//  見やすいようにここに書いているが実際にはprivate,public部がいいだろう
var
  FTitleHeight : Integer;                //タイトル行の高さ
  FStartPosY   : Integer;                //タイトル行を除いた表の上端値
  FEndPosY     : Integer;                //表下端の下限値
  FRowHeight   : Integer;                //行高
  FRowCount    : Integer;                //1頁目の行数
  FRecordCount : Integer;                //レコード数
  FPageCount   : Integer;                //総頁数
  FVKeisenPos  : array[0..3] of Integer; //縦罫線の位置
  FplPrev      : TplPrev;                //印刷プレビュー制御コンポ

//-----------------------------------------------------------------------------
//  各種の値を計算してから描画
//
//  行の高さを決めれば１頁に印刷可能な行数が決まる(行数を決定してから行高さを
//  決定する場合も考えられる．あるいは指定の形式の場合は行高さも行数も決められ
//  ていることもある)．
//  ここではA4縦(210.0mm,297.0mmと仮定)で行高さを10.0mmとし，１頁目はタイトル
//  の印刷分を空ける
//-----------------------------------------------------------------------------
procedure TQPrint3.PrintBlob;
var
  i : Integer;
begin
  //plPrevはForm1のplPrev1を使用
  FplPrev := Form1.plPrev1;

  FVKeisenPos[0] := 150;
  FVKeisenPos[1] := 350;
  FVKeisenPos[2] := 800;
  FVKeisenPos[3] := 1970;
  FTitleHeight   := 50;
  FStartPosY     := 300;
  FEndPosY       := 2700;
  FRowHeight     := 400;

  //QueryをOpenする．項目名に空白文字項目があるので""を付加
  with DM1.Query1 do begin
    Close;
    SQL.CLEAR;
    SQL.Add('SELECT Count(*) as RecCnt FROM "BIOLIFE.DB" BIOLIFE ');
    Open;
    FRecordCount := DM1.Query1.FieldByName('RecCnt').AsInteger;
    Close;
    SQL.CLEAR;
    SQL.Add('SELECT ');
    SQL.Add('BIOLIFE."Species No",');
    SQL.Add('BIOLIFE."Common_Name",');
    SQL.Add('BIOLIFE."Notes",');
    SQL.Add('BIOLIFE."Graphic"');
    SQL.Add('FROM "BIOLIFE.DB" BIOLIFE');
    Open;
  end;

  //1頁の印刷可能行数
  FRowCount := GetRowCnt(FStartPosY, FEndPosY);

  //FPageCntが総頁数．切上げ計算しないと頁数不足
  FPageCount := Ceil(FRecordCount / FRowCount);

  FplPrev.Title := '画像データの出力例';
  FplPrev.BeginDoc;

  try
    for i := 1 to FPageCount do begin
      PrintOnePage(FStartPosY, FTitleHeight, FEndPosY, FRowCount); //1頁分描画
      PageKeisen  (FStartPosY, FTitleHeight, FEndPosY, FRowCount); //罫線を描画
      if i < FPageCount then FplPrev.NewPage;
    end;
  finally
    FplPrev.EndDoc;
  end;

  //Showで表示してしまうと次行でクエリーが閉じてしまう
  FplPrev.ShowModal;
  DM1.Query1.Close;
end;

//-----------------------------------------------------------------------------
//  １頁分の印刷ルーチン
//
//  RowHの行高でRowCnt行分だけ描画する
//  Yt      表の上端Y座標
//  Ytt     タイトル行の高さ
//  Yb      表の下端Y座標．
//  RowCnt  行数
//-----------------------------------------------------------------------------
procedure TQPrint3.PrintOnePage(Yt, Ytt, Yb, RowCnt: Integer);
var
  LX1       : Integer;
  LX2       : Integer;
  LY1       : Integer;
  LY2       : Integer;
  LSNo      : Double;
  LSNs      : String;
  LGraphFld : TField;
  LMemoFld  : TField;
  LRowNo    : Integer;
  LColNo    : Integer;
begin
  //タイトル行は色付きセルとする
  FplPrev.BrushColor($00D9FFD9);
  FplPrev.FontName('ＭＳ Ｐゴシック');
  FplPrev.FontHeight(60);
  FplPrev.FillRect(FVKeisenPos[0], FVKeisenPos[Length(FVKeisenPos) - 1], Yt - Ytt, Yt);

  //頁タイトル
  LX1 := (FVkeisenPos[0] + FVKeisenPos[Length(FVKeisenPos) - 1]) div 2;
  FplPrev.TextOutCB(LX1, Yt - Ytt - 20, 'BIOLIFE.DB');

  //表のタイトル部の文字列
  FplPrev.FontHeight(35);
  for LColNo := 0 to Length(FVKeisenPos) - 2 do begin
    LX1 := FVKeisenPos[LColNo];
    LX2 := FVKeisenPos[LColNo + 1];
    FplPrev.TextRectCC(LX1, LX2, Yt - Ytt, Yt, DM1.Query1.Fields[LColNo].FieldName);
  end;

  //データ部の描画
  LGraphFld := DM1.Query1.FieldByName('Graphic');
  LMemoFld  := DM1.Query1.FieldByName('Notes');

  for LRowNo := 1 to RowCnt do begin
    LY1 := Yt + (LRowNo - 1) * FRowHeight;
    LY2 := Yt + LRowNo * FRowHeight;

    //Species No項目
    LSNo := DM1.Query1.FieldByName('Species No').AsFloat;
    FplPrev.TextRectCC(FVKeisenPos[0], FVKeisenPos[1], LY1, LY2, FloatToStr(LSNo));

    //Graphic項目
    PrintOneGraphic(FVkeisenPos[1] + 50,
                    FVKeisenPos[2] - 50,
                    LY1 + 50,
                    LY2 - 50,
                    LGraphFld);

    //Notes項目
    PrintOneNoteEx(FVkeisenPos[2] + 20,
                   FVKeisenPos[3] - 20,
                   LY1 + 20,
                   LY2 - 20,
                   LMemoFld);

    //Common_Name項目
    LSNs := DM1.Query1.FieldByName('Common_Name').AsString;
    FplPrev.TextRectCB(FVkeisenPos[1], FVKeisenPos[2], LY1, LY2 - 20, LSNs);
    DM1.Query1.Next;

    if DM1.Query1.Eof then Break;
  end;
end;

//-----------------------------------------------------------------------------
//  Y座標の上端，下端と行高さから描画可能な行数を算出
//  Yt      表の上端Y座標
//  Yb      表の下端Y座標．
//-----------------------------------------------------------------------------
function TQPrint3.GetRowCnt(Yt, Yb: Integer): Integer;
begin
  Result := Trunc((Yb - Yt) / FRowHeight);
end;

//-----------------------------------------------------------------------------
//  表の罫線部分の描画ルーチン
//
//  共通部分と考えられる表の罫線と頁数と印刷日時を印刷するルーチン．
//  つまり，書類の背景と言える部分のコード．
//  Yt      表の上端Y座標
//  Ytt     タイトル行の高さ
//  Yb      表の下端Y座標．
//  RowCnt  行数
//-----------------------------------------------------------------------------
procedure TQPrint3.PageKeisen(Yt, Ytt, Yb, RowCnt: Integer);
var
  LTop     : Integer;
  LBotton  : Integer;
  LLeft    : Integer;
  LRight   : Integer;
  LPageStr : String;
  LDateStr : String;
  LRowNo : Integer;
  LColNo : Integer;
begin
  LLeft  := FVKeisenPos[0];
  LRight := FVKeisenPos[Length(FVKeisenPos) - 1];
  FplPrev.LineWidth(1);

  //タイトル行の横罫線
  FplPrev.Line(LLeft, LRight, Yt - Ytt, Yt - Ytt);

  //横罫線
  for LRowNo := 1 to RowCnt + 1 do begin
    LTop := Yt + (LRowNo - 1) * FRowHeight;
    FplPrev.Line(LLeft, LRight, LTop, LTop);
  end;

  //縦罫線の一番下のY座標値
  LBotton := Yt + RowCnt * FRowHeight;

  //縦罫線の描画
  for LColNo := 0 to Length(FVKeisenPos) - 1 do begin
    FplPrev.Line(FVKeisenPos[LColNo], FVKeisenPos[LColNo], Yt - Ytt, LBotton);
  end;

  //頁番号と頁数を描画
  LPageStr := '- ' + IntToStr(FplPrev.PageNumber)
              + '/' + IntToStr(FPageCount) + ' -';
  FplPrev.FontSize(12);
  FplPrev.TextOutCC(FplPrev.PaperWidth div 2, Yb + 50, LPageStr);

  //印刷日時を描画．書類は何時誰がが基本
  LDateStr := '印刷日時 ' + FormatDateTime('yyyy/mm/dd  hh:nn', Now);
  FplPrev.FontName('ＭＳ 明朝');
  FplPrev.FontSize(8);
  FplPrev.TextOutRC(LRight, Yb + 50, LDateStr);
end;

//-----------------------------------------------------------------------------
//  BLOBの(ビットマップ)イメージデータを描画
//  指定枠の横または縦方向の寸法に合わせて縦横比を変更せずに描画
//
//  X1     : 枠の左端X座標値
//  X2     : 枠の右端X座標値
//  Y1     : 枠の上端Y座標値
//  Y2     : 枠の下端Y座標値
//  FldName: 項目
//-----------------------------------------------------------------------------
procedure TQPrint3.PrintOneGraphic(X1, X2, Y1, Y2: Integer; FldName: TField);
var
  LBitmap  : TBitMap;
  LBitmapH : Integer;
  LBitmapW : Integer;
  LRatio1  : Double;
  LRatio2  : Double;
begin
  LBitmap := TBitmap.Create;
  try
    //Graphicの内容をBitMapに読込む
    LBitmap.Assign(TGraphicField(FldName));

    //縦横比を変化させず枠の大きさに合わせるための簡易計算
    LBitmapH := LBitmap.Height;
    LBitmapW := LBitmap.Width;
    LRatio1  := (X2 - X1) / (Y2 - Y1);
    LRatio2  := LBitmapW / LBitmapH;

    if LRatio1 > LRatio2 then begin
      X2 := X1 + Trunc((Y2 - Y1) * LRatio2);
    end else begin
      Y2 := Y1+Trunc((X2 - X1) / LRatio2);
    end;
    FplPrev.StretchDrawBitmap(Rect(X1, Y1, X2, Y2), LBitmap);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//-----------------------------------------------------------------------------
//  BLOBのメモデータを描画
//  指定枠内に収めて描画．枠の中に収まらない部分は描画しない
//
//  X1     : 枠の左端X座標値
//  X2     : 枠の右端X座標値
//  Y1     : 枠の上端Y座標値
//  Y2     : 枠の下端Y座標値
//  FldName: 項目
//-----------------------------------------------------------------------------
procedure TQPrint3.PrintOneNote(X1, X2, Y1, Y2: Integer;
    FldName: TField);
var
  LStringList : TStringList;
  LRect       : TRect;
  LuFormat    : Integer;
begin
  FplPrev.FontName('ＭＳ Ｐゴシック');
  FplPrev.FontHeight(30);

  //クリップ(印刷枠)範囲の指定
  LRect := Rect(X1, Y1, X2, Y2);

  //印刷書式の設定
  LuFormat := DT_LEFT or DT_WORDBREAK or DT_EDITCONTROL;
  LStringList := TStringList.Create;
  try
    //Notes(Memo)の内容をStringListに読込む
    LStringList.Assign(TMemoField(FldName));

    //指定領域内に出力
    DrawText(FplPrev.Canvas.Handle,PChar(LStringList.Text), -1, LRect, LuFormat);
  finally
    FreeAndNil(LStringList);
  end;
end;

//-----------------------------------------------------------------------------
//  BLOBのメモデータを描画(StringListOutメソッドを使用)
//  指定枠内に収めて描画．枠の中に収まらない部分は描画しない
//
//  X1     : 枠の左端X座標値
//  X2     : 枠の右端X座標値
//  Y1     : 枠の上端Y座標値
//  Y2     : 枠の下端Y座標値
//  FldName: 項目名
//-----------------------------------------------------------------------------
procedure TQPrint3.PrintOneNoteEx(X1, X2, Y1, Y2: Integer;
  FldName: TField);
var
  LStringList : TStringList;
  LOptions    : TFormatOptions;
begin
  LOptions := [foJustify];
  FplPrev.FontName('ＭＳ Ｐゴシック');
  FplPrev.FontHeight(30);

  LStringList := TStringList.Create;
  try
    //Notes(Memo)の内容をStringListに読込む
    LStringList.Assign(TMemoField(FldName));

    //指定領域内に出力
    FplPrev.StringListOut(LStringList,
                      LOptions,
                      X1,
                      X2,
                      Y1,
                      Y2,
                      FplPrev.Canvas.Font.Height + 7);
  finally
    FreeAndNil(LStringList);
  end;
end;

end.