ディスプレイの解像度以上の大きさを持つフォームを印刷するには？ (ID:34342)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

TImageClock = class(TGraphicControl)
  private
  protected
    procedure DoPaint(Canvas: TCanvas; L,T,R,B: Integer);
  public
    procedure Paint;override;
    procedure Print(Canvas: TCanvas; Scale: Integer = 100);
  published
  end;

procedure TImageClock.Paint;
begin
    inherited Paint;
    DoPaint(Canvas,0,0,Width,Height);
end;

procedure TImageClock.Print(Canvas: TCanvas; Scale: Integer = 100);
var
    L,T,R,B: Integer;
begin
    L := Left * Scale div 100;
    T := Top * Scale div 100;
    R := (Left + Width) * Scale div 100;
    B := (Top + Height) * Scale div 100;
    DoPaint(Canvas,L,T,R,B);
end;

procedure TImageClock.DoPaint(Canvas: TCanvas; L,T,R,B: Integer);
begin
    Canvas.Ellipse(L,T,R,B);
end;

procedure Register;
begin
    RegisterComponents('KHE00221 - TGraphicControl', [TImageClock]);
end;

フォームのサイズを
  ClientWidth  := 297;
  ClientHeight := 210;
にして
適当に TImageClock を配置  Button クリックで出来る CanvasBitmap.BMP
を見ればわかる

procedure TForm5.Button1Click(Sender: TObject);
var
    I: Integer;
    Printer: TPrinter;
    CanvasBitmap: TBitmap;
    Scale: Integer;
begin
    CanvasBitmap := TBitmap.Create;
    CanvasBitmap.Width  := 1800;
    CanvasBitmap.Height := ClientHeight * (CanvasBitmap.Width div ClientWidth);
    Scale := (CanvasBitmap.Width div ClientWidth) * 100;

//Printer := TPrinter.Create;
    //Printer.BeginDoc;
    //Scale := (Printer.PageWidth div ClientWidth) * 100;
    for I:=0 to ComponentCount -1 do
    begin
      if Components[I] is TImageClock then
      begin
        //TSampleComponent(Components[I]).Print(Printer.Canvas,1000);
        TImageClock(Components[I]).Print(CanvasBitmap.Canvas,Scale);
      end;
    end;
    //Printer.EndDoc;
    //Printer.Free;
    CanvasBitmap.SaveToFile('CanvasBitmap.BMP');
    CanvasBitmap.Free;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
    ClientWidth  := 297;
    ClientHeight := 210;
end;

←解決時は質問者本人がここをチェックしてください。

戻る