Pergunta

Eu tenho TPanel. Neste painel existe um descendente TImage, alguns outros painéis com controles, etc. Na verdade, quadro contém algumas diagrama, enquanto que os painéis adicionais com rótulos são criados durante a execução para fornecer usuário com informações adicionais.
Recentemente foi-me dito que seria bom, se fosse possível imprimir este painel, e tê-lo no papel exatamente como aparece no formulário. Qualquer pistas, como fazê-lo?

Foi útil?

Solução

I encontrado um pós usenet idade que fornece uma solução, através da cópia dos conteúdos do painel para um mapa de bits, que pode ser impresso:

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;

e add

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

Outras dicas

PrintBitmap no exemplo de código de Birger está faltando, quando você adicionar o método faltando funciona bem.

//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};
Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top