Delphi - Drucken
(*
* Author : http://www.michael-puff.de
* Date : 2006-04-21
* License : PUBLIC DOMAIN
*)
uses
Printers;
procedure PrintLine(Canvas: TCanvas; const Line: string; idx, OffSetLeft, OffSetTop, Step: Integer);
begin
Canvas.TextOut(OffSetLeft, Step * idx + OffSetTop, Line);
end;
procedure TForm1.Button1Click(Sender: TObject);
const
TOPMARGIN = 20; // Millimeter
BOTTOMMARGIN = 20; // Millimeter
LEFTMARGIN = 20; // Millimeter
var
i, j : Integer;
PaperHeight : Integer;
begin
j := 0;
if PrintDialog1.Execute then
begin
with Printer do
begin
// Druckjob starten
BeginDoc;
// Einheit auf 0.1 Millimeter umstellen
// Each logical unit is mapped to 0.1 millimeter. Positive x is to the right; positive y is up.
SetMapMode(Canvas.Handle, MM_LOMETRIC);
// Blatthöhe in Millimetern
PaperHeight := GetDeviceCaps(Canvas.Handle, VERTSIZE);
// Schriftgröße
Canvas.Font.Size := 7;
// Schriftart
Canvas.Font.Name := 'Courier New';
for i := 0 to ListBox1.Items.Count - 1 do
begin
PrintLine(Printer.Canvas, // Ziel-Canvas, hier Drucker, kann aber auch Formulöar oder sonst was sein
Listbox1.Items[i], // zu druckende Zeichenkette
j, // Zeile
LEFTMARGIN * 10, // Linker Rand (1/10 mm)
-TOPMARGIN * 10, // Oberer Rand (1/10 mm). Negativ, weil y ist von unten nach oben
-Canvas.Font.Size * 10 // Zeilenabstand (= Schriftgröße), abhängig von Schriftgröße.
// Negativ, weil y ist von unten nach oben
);
// nächste Zeile
Inc(j);
// Wenn alles zusammen höher als die Blatthöhe + Ränder wird -> neue Seite
// Achtung hier in Millimetern rechnen, da GetDeviceCaps Millimeter ausgibt!!!
// Zähler + Zeilenabstand (= Schriftgröße) + oberer Rand + unterer Rand
if ((j * Canvas.Font.Size + TOPMARGIN + BOTTOMMARGIN) >= PaperHeight) then
begin
// neue Seite
NewPage;
// Zeilenzähler zurücksetzen
j := 0;
end;
end;
EndDoc;
end;
end;
end;