Dicas de impressão no Delphi - parte 2

Dicas de impressão no Delphi - parte 2

Imprimindo um bitmap utilizando TPrinter

As vezes, quando utilizados os médoto Draw e StretchDraw da propriedade Canvas do objeto TPrinter, a imagem não é impressa, para corrigir isto, utilize esta procedure, que passando como parâmetros a instância Printer.Canvas, Margem Esquerda, Margem Superior

procedure .DrawImage( Canvas : TCanvas; X, Y, Width, Height : Integer; ABitmap : TBitmap);
var
  Header, Bits : Pointer;
  HeaderSize : Integer;
  BitsSize : Longint;
begin
  GetDibSizes( ABitmap.Handle, HeaderSize, BitsSize );
  Header := AllocMem( HeaderSize );
  Bits := AllocMem( BitsSize);
  try
    GetDib( ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
    StretchDIBits(Canvas.Handle,X,Y,Width,Height,0,0,ABitmap.Width,ABitmap.Height,Bits,
    TBitmapInfo(Header^),DIB_RGB_COLORS,SRCCOPY);
  finally
    FreeMem( Header, HeaderSize);
    FreeMem( Bits, BitsSize );
  end;
end;

Imprimindo um campo memo via Canvas

Coloque na clásula Uses a unit printers

procedure TForm1.Button1Click(Sender: TObject);
var
  i, altura : Integer;
  sMemo : String;
begin
  With Printer do
  begin
    Title:= 'Imprimindo memo';
    BeginDoc;
  With Canvas do
  begin
    altura := TextHeight('A');
    for i := 1 to Memo1.Lines.Count do
    begin
    sMemo := Memo1.Lines[I];
    TextOut(1, (i - 1) * Altura, sMemo);
    end;
  end;
  EndDoc;
  end;
end;

Imprimir caracteres acentuados diretamente para a impressora

{ Usando comandos da impressora podemos fazer isto de uma forma bastante simples. Quando enviamos o caractere ASCII número 8 (oito) para a impressora, a cabeça de impressão retrocede uma posição, pois este caractere é o BackSpace. Então podemos imprimir a letra sem acento e, sem seguida, voltar e imprimir o acento desejado. Vejamos um exemplo:

  - Coloque um botão no form;

  - Altere o evento OnClick deste botão conforme abaixo: }

procedure TForm1.Button2Click(Sender: TObject);
var
  F: TextFile;
begin
  AssignFile(F, 'LPT1');
  Rewrite(F);
  try
  { Regra: caractere sem acento + chr(8) + acento }
  WriteLn(F, 'Este e' + #8 + '''' + ' um teste.');
  WriteLn(F, 'Acentuac' + #8 + ',a' + #8 + '~o.');
  WriteLn(F, 'Vovo' + #8 + '^');
  WriteLn(F, 'U' + #8 + '''' + 'ltimo.');
  WriteLn(F, #12); // Eject
  finally
  CloseFile(F);
  end;
end;
Observações

Usando este recurso, a acentuação não fica excelente, mas melhora bastante.

Imprimir com precisão milimétrica

O objeto Canvas que está na classe Printer é uma ferramenta que ajuda muito a imprimir qualquer tipo de dados, sejam eles texto ou gráficos. O problema é que a largura e a altura são determinadas em pixels, e esses valores variam de acordo com a resolução da impressora. Para converter de milímetros para pixels, use as funções abaixo, sendo que MMtoPixelX é para a resolução horizontal e MMtoPixelY é para a resolução vertical (porque na impressora é possível uma resolução como 1440x720 dpi - 1440 dpi para a horizontal e 720 dpi para a vertical, por exemplo):

function MMtoPixelX (MM : Integer) : Longint;
var
  mmPointX : Real;
  PageSize, OffSetUL : TPoint;
begin
  mmPointX := Printer.PageWidth / GetDeviceCaps(Printer.Handle,HORZSIZE);
  Escape (Printer.Handle,GETPRINTINGOFFSET,0,nil,@OffSetUL);
  Escape (Printer.Handle,GETPHYSPAGESIZE,0,nil,@PageSize);
  if MM > 0 then
    Result := round ((MM * mmPointX) - OffSetUL.X)
  else
    Result := round (MM * mmPointX);
end;

function MMtoPixelY (MM : Integer) : Longint;
var
  mmPointY : Real;
  PageSize, OffSetUL : TPoint;
begin
  mmPointY := Printer.PageHeight /
  GetDeviceCaps(Printer.Handle,VERTSIZE);
  Escape (Printer.Handle,GETPRINTINGOFFSET,0,nil,@OffSetUL);
  Escape (Printer.Handle,GETPHYSPAGESIZE,0,nil,@PageSize);
  if MM > 0 then
    Result := round ((MM * mmPointY) - OffSetUL.Y)
  else
    Result := round (MM * mmPointY);
end;

Imprimir Direto Para Impressora

procedure TForm1.Button1Click(Sender: TObject);
var
  F : TextFile;
  i : integer;
begin
  AssignFile(F,'LPT1');
  Rewrite(F);
  i := 0;
  Writeln(F,'Teste de impressao - Linha 0');
  Writeln(F,'Teste de impressao - Linha 1');
  Writeln(F,#27#15+'Teste de Impressão - Linha 2');
  Writeln(F,'Teste de impressao - Linha 3');
  Writeln(F,#27#18+'Teste de Impressão - Linha 4');
  Writeln(F,'Teste de impressao - Linha 5');
  Writeln(F,#12); // Ejeta a página
  CloseFile(F);
end;

Imprimir em impressora matricial em modo caracter

Procedure TForm1.Button1Click(Sender: TObject);
var Arquivo : TextFile;
begin
  AssignFile(Arquivo,'LPT1');
  Rewrite(Arquivo);
  Writeln(Arquivo,'Teste de impressao - Linha 0');
  Writeln(Arquivo,'Teste de impressao - Linha 1');
  Writeln(Arquivo,#27#15+'Teste de Impressão - Linha 2');
  Writeln(Arquivo,'Teste de impressao - Linha 3');
  Writeln(Arquivo,#27#18+'Teste de Impressão - Linha 4');
  Writeln(Arquivo,'Teste de impressao - Linha 5');
  Writeln(Arquivo,#12); // Ejeta a página
  CloseFile(Arquivo);
end;