私はTPanelを持っています。このパネルには、TImage の子孫、コントロールを含む他のいくつかのパネルなどがあります。実際、画像にはいくつかの図が含まれていますが、実行時にラベル付きの追加のパネルが作成され、ユーザーに追加情報を提供します。
最近、このパネルを印刷して、そのままの形で紙に載せてくれたらいいのにと言われた。手がかりはありますか?
質問する
5623 次
2 に答える
4
パネルの内容を印刷可能なビットマップにコピーすることにより、解決策を提供する古い usenet 投稿を見つけました。
procedure TFormPrintWindows.ButtonPrintPanelClick(Sender: TObject);
var
Bitmap : TBitmap;
FromLeft : INTEGER;
FromTop : INTEGER;
PrintedWidth : INTEGER;
PrintedHeight: INTEGER;
begin
Printer.BeginDoc;
TRY
Bitmap := TBitmap.Create;
TRY
Bitmap.Width := Panel1.Width;
Bitmap.Height := Panel1.Height;
Bitmap.PixelFormat := pf24bit; // avoid palettes
// Copy the Panel area from the Form into a separate Bitmap
Bitmap.Canvas.CopyRect(Rect(0,0, Bitmap.Width,Bitmap.Height),
FormPrintWindows.Canvas,
Rect(Panel1.Left, Panel1.Top,
Panel1.Left + Panel1.Width-1,
Panel1.Top + Panel1.Height-1) );
// Assumes 10% left, right and top margin
// Assumes bitmap aspect ratio > ~0.75 for portrait mode
PrintedWidth := MulDiv(Printer.PageWidth, 80,100); // 80%
PrintedHeight := MulDiv(PrintedWidth, Bitmap.Height, Bitmap.Width);
FromLeft := MulDiv(Printer.PageWidth, 10,100); // 10%
FromTop := MulDiv(Printer.PageHeight,10,100); // 10%
PrintBitmap(Printer.Canvas,
Rect(FromLeft, FromTop,
FromLeft + PrintedWidth,
FromTop + PrintedHeight),
Bitmap);
FINALLY
Bitmap.Free
END;
FINALLY
Printer.EndDoc
END
end;
そして追加
//Source of Code:
//http://www.swissdelphicenter.ch/torry/showcode.php?id=744
//Which refers to a posting to borland.public.delphi.winapi by Rodney E Geraghty, 8/8/97.
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
var
BitmapHeader: pBitmapInfo;
BitmapImage: Pointer;
HeaderSize: DWORD;
ImageSize: DWORD;
begin
GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
GetMem(BitmapHeader, HeaderSize);
GetMem(BitmapImage, ImageSize);
try
GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top, // Destination Origin
DestRect.Right - DestRect.Left, // Destination Width
DestRect.Bottom - DestRect.Top, // Destination Height
0, 0, // Source Origin
Bitmap.Width, Bitmap.Height, // Source Width & Height
BitmapImage,
TBitmapInfo(BitmapHeader^),
DIB_RGB_COLORS,
SRCCOPY)
finally
FreeMem(BitmapHeader);
FreeMem(BitmapImage)
end
end {PrintBitmap};
于 2009-05-30T12:09:59.077 に答える
4
Birger のコード例の PrintBitmap が欠落しています。欠落しているメソッドを追加すると、うまく機能します。
//Source of Code:
//http://www.swissdelphicenter.ch/torry/showcode.php?id=744
//Which refers to a posting to borland.public.delphi.winapi by Rodney E Geraghty, 8/8/97.
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap);
var
BitmapHeader: pBitmapInfo;
BitmapImage: Pointer;
HeaderSize: DWORD;
ImageSize: DWORD;
begin
GetDIBSizes(Bitmap.Handle, HeaderSize, ImageSize);
GetMem(BitmapHeader, HeaderSize);
GetMem(BitmapImage, ImageSize);
try
GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
StretchDIBits(Canvas.Handle,
DestRect.Left, DestRect.Top, // Destination Origin
DestRect.Right - DestRect.Left, // Destination Width
DestRect.Bottom - DestRect.Top, // Destination Height
0, 0, // Source Origin
Bitmap.Width, Bitmap.Height, // Source Width & Height
BitmapImage,
TBitmapInfo(BitmapHeader^),
DIB_RGB_COLORS,
SRCCOPY)
finally
FreeMem(BitmapHeader);
FreeMem(BitmapImage)
end
end {PrintBitmap};
于 2009-05-30T12:38:48.990 に答える