2009-05-30 2 views
3

У меня есть TPanel. На этой панели есть потомок TImage, несколько других панелей с элементами управления и т. Д. На самом деле изображение содержит некоторую диаграмму, в то время как дополнительные панели с метками создаются во время выполнения, чтобы предоставить пользователю дополнительную информацию.
Недавно мне сказали, что было бы неплохо, если бы можно было напечатать эту панель и напечатать ее на бумаге так же, как и в форме. Какие-нибудь подсказки, как это сделать?Как распечатать содержимое TPanel?

ответ

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

Биргер, в духе SO, вы должны изменить свой ответ и добавить функцию от ответа Роберта Лав (с указанием авторства вежливости) - точка ТАК хранить правильные ответы. – Argalatyr

+1

Спасибо за указание на это. Я изменил свой ответ и добавил функцию. Спасибо, Роберт! – Birger

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

Thak you for your addendum! Извините, я не могу принять оба ответа, так что, по крайней мере, это +1 для вас! – smok1

Смежные вопросы