3
我有TPanel。在這個面板上有一個TImage後裔,其他幾個控制面板等。實際上,圖片包含一些圖表,而在運行時創建附加面板和標籤,爲用戶提供更多信息。
最近有人告訴我,如果可以打印此面板並將其放在紙上,就好像它在表單中出現一樣。任何線索,如何去做?如何打印TPanel內容?
我有TPanel。在這個面板上有一個TImage後裔,其他幾個控制面板等。實際上,圖片包含一些圖表,而在運行時創建附加面板和標籤,爲用戶提供更多信息。
最近有人告訴我,如果可以打印此面板並將其放在紙上,就好像它在表單中出現一樣。任何線索,如何去做?如何打印TPanel內容?
我發現了一個老新聞組帖子,提供了一個解決方案,通過複製面板的內容,以一個位圖,它可被印刷:
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};
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};
Birger,本着SO的精神,您應該編輯您的答案並添加來自Robert Love的答案(帶有禮貌歸屬)的功能 - SO的要點是存儲正確的答案。 – Argalatyr 2009-05-30 15:13:00
謝謝你指出給我。我改變了我的答案並添加了該功能。感謝羅伯特! – Birger 2009-05-31 15:09:26