Impressao - imprimindo graficos com preview sem QuickReport

{

 Imagine um programa com graficos na tela, colocando icones, labels, Images, etc...

 Para fazer este programa imprimir com preview (sem QuickRep) 

 é necessário 2 etapas ao pressionar o botão Imprimir:

 1. Crie um form com um Image bem grande com um bitmap branco como Picture.

    No meu projeto o bitmap era tamanho 1024 x 768 x 16 cores, AutoSize e Center=True

    Este TImage será usado para "desenhar" temporariamente os componentes

    da tela principal sobre o Canvas. Este form nem mesmo será mostrado apenas

    será usado depois pela de "preview" ao usuario final para ele brincar de 

    dar zoom.

 2. Crie um form de preview de impressao que devera conter:

    2 botões de comando: Imprimir e Sair

    2 botões de zoom   : Ampliar e Reduzir

    1 Label            : Escala (mostra quanto zoom estamos usando)

    1 TImage           : Preview

}

//  No programa principal voce faz com que o usuario possa criar labels, icones, imagens

//  e mover a vontade.... ao pressionar o botão IMPRIMIR:

// ------------------------ IMPRIMIR DO MAINFORM -----------------------------------

// No meu exemplo de onde recortei este codigo tinha 3 labels e 3 images. as labels

// possuiam cores e tamanhos diferentes e as imagens tinham bitmaps diferentes.

// espalhadas aleatoriamente na tela.

procedure ImprimirButtonClick

var

  I: Integer;

begin

  // Esta form PREVIEW é usado pois tem um bitmap onde eu posso "desenhar" por cima

  // no caso, eu desenho todos os icones nas posicoes relativas, depois chamo o ImpressaoForm que

  // é uma tela de impressão de bitmap.

  PreviewForm := TPreviewForm.Create(Self);

  // Percorre os componentes da tela e os "desenha" numa tela intermediaria para ser usada pelo preview.

  for I := 0 to ComponentCount-1 do

    with PreviewForm.Imagem.Picture.Bitmap.Canvas do

    begin

      if Components[I] is TImage then // se for image usa o Draw

        Draw( TImage(Components[I]).Left, TImage(Components[I]).Top + 2, TImage(Components[I]).Picture.Bitmap);

      if Components[I] is TLabel then  // se for Label usa TextOut

      begin

        Font := TLabel(Components[I]).Font;

        TextOut( TLabel(Components[I]).Left, TLabel(Components[I]).Top, TLabel(Components[I]).Caption );

      end;

    end;

  // Chama tela de preview de impressao

  ImpressaoForm := TImpressaoForm.Create(Self);

  ImpressaoForm.ShowModal;

  ImpressaoForm.Free;

  PreviewForm.Free;

end;

// ------------------------ TELA DE IMPRESSAO FORM ------------------------------------

// Para funcionar corretamente nao esqueca dos componentes minimos necessarios.

// Veja no inicio da dica quais precisam.

uses PreviewUnit; // Esta preview é aquela que tem o bitmap grande branco.

var

  Escala: Double;

///////////////////////////////////////////////////////////////////// Rotina Interna

procedure TImpressaoForm.SetaPagina;

begin

  // define o tamanho da imagem para ser proporcional com o tamanho da página

  Printer.Orientation := poLandscape;

  PreviewImagem.Width := Printer.PageWidth  div 5;

  PreviewImagem.Height:= Printer.PageHeight div 5;

  EscalaLabel.Caption := mlStrTran(FormatFloat('0.0x',Escala), ',', '.');

end;

///////////////////////////////////////////////////////////////////// BOTOES DE ZOOM

procedure TImpressaoForm.AmpliarButtonClick(Sender: TObject);

begin

  // Aumenta o tamanho do bitmap

  Escala := Escala + 0.5;

  EscalaLabel.Caption := mlStrTran(FormatFloat('0.0x',Escala), ',', '.');

  DesenhaPreview;

end;

procedure TImpressaoForm.ReduzirButtonClick(Sender: TObject);

begin

  // diminui o tamanho da imagem

  if Escala > 1 then

  begin

    Escala := Escala - 0.5;

    EscalaLabel.Caption := mlStrTran(FormatFloat('0.0x',Escala), ',', '.');

    DesenhaPreview;

  end;

end;

///////////////////////////////////////////////////////////////////// DESENHA PREVIEW

procedure TImpressaoForm.DesenhaPreview;

var

  Rect: TRect;

begin

  // calcula o retângulo para a visualização preévia do bitmap

  Rect.Top    := 10;

  Rect.Left   := 10;

  Rect.Right  := 10 + Trunc(PreviewForm.Imagem.Picture.Graphic.Width  * Escala) div 5;

  Rect.Bottom := 10 + Trunc(PreviewForm.Imagem.Picture.Graphic.Height * Escala) div 5;

  // remove a imagem corrente

  PreviewImagem.Canvas.Pen.Mode := pmWhite;

  PreviewImagem.Canvas.Rectangle(0, 0, PreviewImagem.Width, PreviewImagem.Height);

  // redimensiona o bitmap dentro do retângulo

  PreviewImagem.Canvas.StretchDraw (Rect, PreviewForm.Imagem.Picture.Graphic);

end;

///////////////////////////////////////////////////////////////////////////// BOTOES

procedure TImpressaoForm.ImprimirButtonClick(Sender: TObject);

var

  Rect: TRect;

begin

  // Calcula o retângulo para a impressora

  Rect.Top    := 10;

  Rect.Left   := 10;

  Rect.Right  := 10 + Trunc(PreviewForm.Imagem.Picture.Graphic.Width  * Escala);

  Rect.Bottom := 10 + Trunc(PreviewForm.Imagem.Picture.Graphic.Height * Escala);

  // Imprime o bitmap

  Printer.BeginDoc;

  try

    Printer.Canvas.StretchDraw(Rect, PreviewForm.Imagem.Picture.Graphic);

    Printer.EndDoc;

  except

    Printer.Abort;

    raise;

  end;

end;

procedure TImpressaoForm.SairButtonClick(Sender: TObject);

begin

  Close;

end;

/////////////////////////////////////////////////////////////////////////// FORM

procedure TImpressaoForm.FormActivate(Sender: TObject);

begin

  WindowState := wsMaximized;

  Escala      := 3.5;

  SetaPagina;

  DesenhaPreview;

  PreviewImagem.Left := (ClientWidth div 2) - (PreviewImagem.Width div 2);

end;

procedure TImpressaoForm.FormKeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

  case Key of

    Vk_Escape : Close;

         107  : AmpliarButton.Click;

         109  : ReduzirButton.Click;

  end;

end;

{

 Conclusão.

 Funciona Perféctus. O Zoom é aplica à impressão tambem. Experimente...

}