この発言に対し以下のコメントが寄せられています

#00727　ＴＮ            さん　RE:Panelをそのままプリント






フォームに載せたTPanelとその上のControlは，いちおうそのままプリンタに
印刷できます．Windowsは，DCに描きさえすれば，DCの実体が何であろうと気に
しなくていいという建前なので．
　例では台紙の横幅とプリンタの紙の横幅の比率で縦横等倍した印刷実行パネル
にControlのコピーを作って載せて，そいつを印刷します．

　Pen.WidthはDCのPixcelsPerInch（DevPPIX）に合わせて太くしないと，細く
なってしまいます．WinControlのBorderラインも細くなりますが，こいつは印刷
実行Panelの改造が必要．Alignもやっかい．

unit Preview;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Printers;

type
  TPreviewForm = class(TForm)
    PagePanel: TPanel; // 台紙
    Label1: TLabel;    // 台紙に載っている
    Label2: TLabel;    // 台紙に載っている
    Shape1: TShape;    // 台紙に載っている
    Memo1: TMemo;      // 台紙に載っている
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

  TPrPanel = class(TCustomPanel)
  protected
  public
    constructor Create(AOwner: TComponent); override;
    procedure CopyControl(AControl: TControl; Scale: Double);
  end;

var
  PreviewForm: TPreviewForm;

implementation

{$R *.DFM}

procedure CopyComponent(const Src: TComponent; var Dest: TComponent);

var Stream: TMemoryStream;
    SrcName: string;
begin
  Stream := TMemoryStream.Create;
  try
    SrcName := Src.Name;
    with Stream do begin
      WriteComponent(Src);
      Seek(0,0);
      ReadComponent(Dest);
    end;
  finally
    Stream.Free;
  end;
end;


{ TPrPanel }
constructor TPrPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Color := clWhite;
  ParentCtl3D := False;
  ParentColor := False;
  ParentFont := False;
  Ctl3D := False;
  BevelInner := bvNone;
  BevelOuter := bvNone;
end;

type
  TDummyControl = class(TControl)
  public
    property Font;
  end;

procedure TPrPanel.CopyControl;
var
  Ctrl: TControl;
begin
  Ctrl := TControlClass(AControl.ClassType).Create(Self);
  Ctrl.Parent := Self;
  CopyComponent( AControl, TComponent(Ctrl) );
  Ctrl.SetBounds(
      Trunc(AControl.Left * Scale),
      Trunc(Acontrol.Top * Scale),
      Trunc(AControl.Width * Scale),
      Trunc(AControl.Height * Scale) );
  TDummyControl(Ctrl).Font.Height :=
      Trunc(TDummyControl(AControl).Font.Height * Scale);
end;

{ TPreviewForm }
procedure TPreviewForm.Button1Click(Sender: TObject);
var
  i: integer;
  DC: HDC;
  Scale: Double;
  DevPPIX, DevPPIY: integer;
  PrPanel: TPrPanel;
begin
  PrPanel := TPrPanel.Create(Self);
  try
    PrPanel.Parent := Self;  // 親は何でもいい

    Printer.BeginDoc;
    DC := Printer.Canvas.Handle;
    DevPPIX := GetDeviceCaps( DC, LOGPIXELSX );
    DevPPIY := GetDeviceCaps( DC, LOGPIXELSY );
    SetMapMode( DC, MM_ANISOTROPIC );
    SetWindowExtEx( DC, DevPPIX, DevPPIX, nil);
    SetViewPortExtEx(DC, DevPPIX, DevPPIY, nil );
    Scale := Printer.PageWidth / PagePanel.Width;
    with PrPanel do begin
      Width := Trunc(PagePanel.Width * Scale);
      Height := Trunc(PagePanel.Height * Scale);
      for i := 0 to PagePanel.ControlCount-1 do begin
        CopyControl(PagePanel.Controls[i], Scale);
      end;
    end;
    SetViewPortOrgEx(DC, 0, 0, nil );  // 原点ずらしはしていない
    PrPanel.PaintTo(DC, 0, 0);
  finally
    Printer.EndDoc;
    PrPanel.Free;
  end;
end;

end.

                                                  ＴＮ(CQJ01721)

Original document by ＴＮ            氏 ID:(CQJ01721)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。