Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2004年12月31日] [更新 2013年11月04日]　Delphi サンプルプログラム集
拙作のコンポーネント類を使用したサンプル
T110_TFormPanel 利用の印刷プレビュー  (1)
動作確認等 Windows 7 U64(SP1 + Delphi XE Pro
以下のコンポーネント類が必要 (TplXXX は拙作のコンポーネント)
TplSetPrinter, TplPrev, TFormPane
T110_FormPanel1.zip　[1,036 KB]　2013年11月04日版 (EXE 同梱)



  • 2010年09月09日
  • 表示切り換え時のチラツキを軽減
    このサンプル，2001年10月25日から提供しているので 10 年目なんですね
  • 2013年11月04日
  • Windows 7 U64(SP1) + Delphi XE Proで動作確認



TFormPanel で印刷プレビュー ( 他フォーム上でプレビュー切換え )


印刷プレビュー制御フォームを単独ではなく，別の，ここではアプリケーションのメインフォームに表示するサンプルです．複数の印刷プレビュー制御フォームを，フォーム上に切り換えて表示します．

実際には，Osamu's Square にある武内修さん作の TFormPanel コンポーネントをフォーム上に配置し，その上に印刷プレビュー制御フォームを表示します．
このプログラムは，3 つの継承プレビューフォームを作成し，TFormPanel 上で切換えて表示します．先読み方式と逐次表示方式の両方を使用しています．


図1
設計時のメインフォーム
  • パネルを 2 つを配置
  • 左のパネルにボタン類
  • 右のパネルはプレビュー表示用
  • 起動時はどのプレビューを表示しない
  • プレビューの継承フォームを 3 つ用意
    plPrevForm2
    plPrevForm3
    plPrevForm4
  • このサンプルでは表示フォームは自動生成のまま
図2
継承フォーム
  • TplPrev コンポのみ追加配置
  • 他の 2 つの継承フォームも同じ
図3
1 番上のボタンをクリック
図4
2 番目のボタンをクリック
図5
3 番目のボタンをクリック

リスト1
印刷プレビュー制御フォームを，メインフォーム上に表示
複数の印刷プレビュー制御フォームを切り換えて表示		 
unit FormPanel1Unit;

interface

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

type
  TForm1 = class(TForm)
    SpeedButton10: TSpeedButton;
    Panel0: TPanel;
    SpeedButton01: TSpeedButton;
    SpeedButton02: TSpeedButton;
    SpeedButton03: TSpeedButton;
    FormPanel1: TFormPanel;
    Panel1: TPanel;
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton01Click(Sender: TObject);
    procedure SpeedButton02Click(Sender: TObject);
    procedure SpeedButton03Click(Sender: TObject);
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Unit1, Unit2, Unit3, plPrevfrm;

{$R *.DFM}

//=============================================================================
//  描画位置指定の文字列描画例
//  (先読み方式)
//=============================================================================
procedure TForm1.SpeedButton01Click(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  FormPanel1.Form := plPrevForm1;
  LockWindowUpdate(0);
end;

//=============================================================================
//  矩形領域内への文字列描画例
//  (先読み方式)
//=============================================================================
procedure TForm1.SpeedButton02Click(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  FormPanel1.Form := plPrevForm2;
  LockWindowUpdate(0);
end;

//=============================================================================
//  ビットマップの描画例
//  (逐次表示方式)
//=============================================================================
procedure TForm1.SpeedButton03Click(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  FormPanel1.Form := plPrevForm3;
  LockWindowUpdate(0);
end;

//=============================================================================
//  [終了]ボタン押下時の処理
//=============================================================================
procedure TForm1.SpeedButton10Click(Sender: TObject);
begin
  Close;
end;

//=============================================================================
//  マウスホイールは親のイベントを使用する
//  usseにplPrevfrmが必要
//=============================================================================
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
  SB : TScrollingWinControl;
begin
  if FormPanel1.Form <> nil then begin
    SB := (FormPanel1.Form as TplPrevForm).ScrollBox1;
    if FindVCLWindow(MousePos) = SB then begin
      Handled := True;
      SB.VertScrollBar.Position := SB.VertScrollBar.Position - WheelDelta div 5;
    end;
  end;
end;

end.


リスト2
1 番目の継承フォームのコード 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PLPREVFRM, Menus, ExtCtrls, ComCtrls, Buttons, ToolWin, plPrev;

type
  TplPrevForm1 = class(TplPrevForm)
    plPrev1: TplPrev;
    procedure plPrev1FormShow(Sender: TObject);
  private
    { Private 宣言 }
    PV : TplPrev;
  public
    { Public 宣言 }
  end;

var
  plPrevForm1: TplPrevForm1;

implementation

uses Printers;

{$R *.DFM}

//=============================================================================
//  指定座標値を中心とした十字を描き，そこを基準にしてルーチン名と同じ文字列を
//  描画していく
//  TplPrevのOnShowイベントにフォーム表示の時の処理を記述する場合はinheritedは
//  不要．
//=============================================================================
procedure TplPrevForm1.plPrev1FormShow(Sender: TObject);
var
  X1 : Integer;
  X2 : Integer;
  Y1 : Integer;
  Y2 : Integer;
  Xc : Integer;
  Yc : Integer;
begin
  PV := plPrev1;
  //印刷方向を縦する
  PV.plSetPrinter.Orientation := poPortrait;

  PV.BeginDoc;

  PV.FontSize(20);
  PV.FontName('Courier New');
  PV.PenWidth(1);
  PV.PenColor(clBlue);

  //指定座標の右下に文字列を描画
  X1  := 150;
  X2  := 700;
  Y1  := 300;
  Y2  := 550;
  Xc := X1 + 150;
  Yc := (Y1 + Y2) div 2;
  PV.Line  (X1, X2, Yc, Yc);
  PV.Line  (Xc, Xc, Y1, Y2);
  PV.TextOutLT(Xc, Yc, 'TextOutLT');

  //指定座標の右側に文字列を描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  Yc := (Y1 + Y2) div 2;
  PV.Line  (X1, X2, Yc, Yc);
  PV.Line  (Xc, Xc, Y1, Y2);
  PV.TextOutLC(Xc, Yc, 'TextOutLC');

  //指定座標の右上に文字列を描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  Yc := (Y1 + Y2) div 2;
  PV.Line  (X1, X2, Yc, Yc);
  PV.Line  (Xc, Xc, Y1, Y2);
  PV.TextOutLB(Xc, Yc, 'TextOutLB');

  //指定座標の下側に文字列を描画
  X1 := X1 + 600;
  X2 := X2 + 600;
  Y1 := 300;
  Y2 := 550;
  Xc := (X1 + X2) div 2;
  Yc := (Y1 + Y2) div 2;
  PV.Line  (X1, X2, Yc, Yc);
  PV.Line  (Xc, Xc, Y1, Y2);
  PV.TextOutCT(Xc, Yc, 'TextOutCT');

  //指定座標の上下左右に文字列を描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  Yc := (Y1 + Y2) div 2;
  PV.Line  (X1, X2, Yc, Yc);
  PV.Line  (Xc, Xc, Y1, Y2);
  PV.TextOutCC(Xc, Yc, 'TextOutCC');

  //指定座標の上側に文字列を描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  Yc := (Y1 + Y2) div 2;
  PV.Line  (X1, X2, Yc, Yc);
  PV.Line  (Xc, Xc, Y1, Y2);
  PV.TextOutCB(Xc, Yc, 'TextOutCB');

  //指定座標の左下に文字列を描画
  X1 := X1 + 600;
  X2 := X2 + 600;
  Y1 := 300;
  Y2 := 550;
  Xc := X2 - 150;
  Yc := (Y1 + Y2) div 2;
  PV.Line  (X1, X2, Yc, Yc);
  PV.Line  (Xc, Xc, Y1, Y2);
  PV.TextOutRT(Xc, Yc, 'TextOutRT');

  //指定座標の左側に文字列を描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  Yc := (Y1 + Y2) div 2;
  PV.Line  (X1, X2, Yc, Yc);
  PV.Line  (Xc, Xc, Y1, Y2);
  PV.TextOutRC(Xc, Yc, 'TextOutRC');

  //指定座標の左上に文字列を描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  Yc := (Y1 + Y2) div 2;
  PV.Line  (X1, X2, Yc, Yc);
  PV.Line  (Xc, Xc, Y1, Y2);
  PV.TextOutRB(Xc, Yc, 'TextOutRB');

  PV.EndDoc;
end;

end.


リスト3
2 番目の継承フォームのコード 
unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PLPREVFRM, Menus, ExtCtrls, ComCtrls, Buttons, ToolWin, plPrev;

type
  TplPrevForm2 = class(TplPrevForm)
    plPrev1: TplPrev;
    procedure plPrev1FormShow(Sender: TObject);
  private
    { Private 宣言 }
    PV : TplPrev;
  public
    { Public 宣言 }
  end;

var
  plPrevForm2 : TplPrevForm2;

implementation

uses Printers;

{$R *.DFM}

//=============================================================================
//  矩形を描き，そこを基準にしてルーチン名と同じ文字列を描画
//  TplPrevのOnShowイベントにフォーム表示の時の処理を記述する場合はinheritedは
//  不要
//=============================================================================
procedure TplPrevForm2.plPrev1FormShow(Sender: TObject);
var
  X1 : Integer;
  X2 : Integer;
  Y1 : Integer;
  Y2 : Integer;
begin
  PV := plPrev1;
  //印刷方向を横とする
  PV.plSetPrinter.Orientation := poLandscape;

  plPrev1.BeginDoc;

  PV.FontSize(20);
  PV.FontName('Courier New');
  PV.PenWidth(1);
  PV.PenColor(clBlue);

  //矩形の左上から描画
  X1 := 150;
  X2 := 700;
  Y1 := 300;
  Y2 := 450;
  PV.Rectangle(X1, X2, Y1, Y2);
  PV.TextRectLT(X1, X2, Y1, Y2, 'TextRectLT');

  //矩形の左端から描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  PV.Rectangle (X1, X2, Y1, Y2);
  PV.TextRectLC(X1, X2, Y1, Y2, 'TextRectLC');

  //矩形の左下から描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  PV.Rectangle (X1, X2, Y1, Y2);
  PV.TextRectLB(X1, X2, Y1, Y2, 'TextRectLB');

  //矩形の左右中央で上端に寄せて描画
  X1 := X1 + 600;
  X2 := X2 + 600;
  Y1 := 300;
  Y2 := 450;
  PV.Rectangle (X1, X2, Y1, Y2);
  PV.TextRectCT(X1, X2, Y1, Y2, 'TextRectCT');

  //矩形の左右中央に描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  PV.Rectangle (X1, X2, Y1, Y2);
  PV.TextRectCC(X1, X2, Y1, Y2, 'TextRectCC');

  //矩形の左右中央で下端に寄せて描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  PV.Rectangle (X1, X2, Y1, Y2);
  PV.TextRectCB(X1, X2, Y1, Y2, 'TextRectCB');

  //矩形の右上に寄せて描画
  X1 := X1 + 600;
  X2 := X2 + 600;
  Y1 := 300;
  Y2 := 450;
  PV.Rectangle (X1, X2, Y1, Y2);
  PV.TextRectRT(X1, X2, Y1, Y2, 'TextRectRT');

  //矩形の右端に寄せて描画
  Y1  := Y1 + 300;
  Y2  := Y2 + 300;
  PV.Rectangle (X1, X2, Y1, Y2);
  PV.TextRectRC(X1, X2, Y1, Y2, 'TextRectRC');

  //矩形の右下に寄せて描画
  Y1 := Y1 + 300;
  Y2 := Y2 + 300;
  PV.Rectangle (X1, X2, Y1, Y2);
  PV.TextRectRB(X1, X2, Y1, Y2, 'TextRectRB');

  PV.EndDoc;
end;

end.


リスト4
3 番目の継承フォームのコード 
unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PLPREVFRM, Menus, ExtCtrls, ComCtrls, Buttons, ToolWin, plPrev;

type
  TplPrevForm3 = class(TplPrevForm)
    plPrev1: TplPrev;
    procedure FormShow(Sender: TObject);
  private
    { Private 宣言 }
    PV : TplPrev;
    procedure BitMapDrawTest2;
  public
    { Public 宣言 }
  end;

var
  plPrevForm3: TplPrevForm3;

implementation

uses Printers;

{$R *.DFM}

//=============================================================================
//  描画の方法を変えて3頁表示
//=============================================================================
procedure TplPrevForm3.FormShow(Sender: TObject);
begin
  inherited;

  PV := plPrev1;
  //印刷方向を縦する
  PV.plSetPrinter.Orientation := poPortrait;

  PV.PageCount := 3;                //3頁
  PV.ProcName  := BitMapDrawTest2;  //描画用の手続きを指定
end;

//=============================================================================
//  ビットマップファイルChestCT.bmpを指定した枠(四角形)に収めて描画コンポ内の
//  DrawPictとStrechDrawPictを使用した例
//
//  逐次表示方式では、頁番号を示すプロパティPageNumberを用いて表示する頁に応じ
//  た処理を描画ルーチンに記述する．
//  描画する頁数が１頁のみの時は頁番号による分岐は不要．
//
//  1頁目 枠内全体に描画する.元の縦横比は変わる
//  2頁目 元の画像よりも縦長の枠内に描画する場合
//        横方向を枠の幅に合わて描画.縦横比は不変      　  　
//  3頁目 元の画像よりも横長の枠内に描画する場合
//        縦方向を枠の長さに合わせて描画.縦横比は不変
//=============================================================================
procedure TplPrevForm3.BitMapDrawTest2;
begin
  //PageNumberの値はプレビューの頁送りボタンで変わる
  case PV.PageNumber of
    1:
    begin
      PV.DrawPict       (500,  200, 'ChestCT.bmp');
      PV.StretchDrawPict(500, 1500, 900, 2300, True, 'ChestCT.bmp');
      PV.RectLine       (500, 1500, 900, 2300);
    end;
    2:
    begin
      PV.DrawPict       (500,  200, 'ChestCT.bmp');
      PV.StretchDrawPict(500, 1500, 900, 2300, False, 'ChestCT.bmp');
      PV.RectLine       (500, 1500, 900, 2300);
    end;
    3:
    begin
      PV.DrawPict       (500,  200, 'ChestCT.bmp');
      PV.StretchDrawPict(300, 1800, 1100, 2000, False, 'ChestCT.bmp');
      PV.RectLine       (300, 1800, 1100, 2000);
    end;
  end;
end;

end.



TFormPanel の修正


こりページのサンプルでは，FmPnlReg.pas の Resister 部分を以下の様に修正し，Delphi 5 以降でも使用可能にしてテストしています．


リスト5 
procedure Register;
begin

    RegisterComponents('Takeuchi', [TFormPanel]);

{$IFDEF VER130}
        RegisterPropertyInCategory
                (TLegacyCategory,TFormPanel,'FormCaption');
{$ELSE}
        RegisterPropertyInCategory
                ('Legacy',TFormPanel,'FormCaption');
{$ENDIF}
end;