2009-05-30 111 views
3

我有TPanel。在這個面板上有一個TImage後裔,其他幾個控制面板等。實際上,圖片包含一些圖表,而在運行時創建附加面板和標籤,爲用戶提供更多信息。
最近有人告訴我,如果可以打印此面板並將其放在紙上,就好像它在表單中出現一樣。任何線索,如何去做?如何打印TPanel內容?

回答

4

我發現了一個老新聞組帖子,提供了一個解決方案,通過複製面板的內容,以一個位圖,它可被印刷:

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}; 
+1

Birger,本着SO的精神,您應該編輯您的答案並添加來自Robert Love的答案(帶有禮貌歸屬)的功能 - SO的要點是存儲正確的答案。 – Argalatyr 2009-05-30 15:13:00

+1

謝謝你指出給我。我改變了我的答案並添加了該功能。感謝羅伯特! – Birger 2009-05-31 15:09:26

4

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};