// Hiermit werden TStrings (Tstringlist, TMemo.Lines, TListbox.Items...)
// millimetergenau ausgedruckt, wobei "x" und "y" die linke obere Ecke
// auf der Seite angeben. Dabei muss man beachten, dass der Drucker einen
// nicht bedruckbaren Rand hat. Das bedeutet, dass bei
x=0 bzw. y=0
// Buchstaben abgeschnitten werden. Siehe auch weiter unten: "Strings drucken"
// Querverweis:
den bedruckbaren Bereich abfragen
// Oder auch:   ein Image millimetergenau drucken

// Getestet mit D4 unter Win98

uses Printers; 
 
procedure druck(ts: TStrings; SchriftName: TFontName; SchriftHoehe: double; x, y: integer); 
var i, h, a, sh: integer; 
begin 
  with printer do begin 
    h := -round(pageheight / 2.54); 
    x := x * 10 - round(getdevicecaps(handle, physicaloffsetx) / 2.54); 
    y := -y * 10 + round(getdevicecaps(handle, physicaloffsety) / 2.54); 
    title := 'Text in mm'; 
    begindoc; 
    canvas.textout(0, 0, ' '); 
    SetMapMode(canvas.handle, MM_LOMETRIC); 
    sh := round(schrifthoehe * 10); 
    canvas.font.height := sh; 
    canvas.font.name := schriftname; 
    a := 0; 
    for i := 0 to ts.count - 1 do begin 
      canvas.textout(x, y - sh * a, ts.strings[i]); 
      inc(a); 
      if (y - sh * a) < h then begin 
        if a <= ts.count then newpage; 
        a := 0; 
      end; 
    end; 
    enddoc; 
  end; 
end; 
 
// ----------------------- Beispielaufrufe -------------------- 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  druck(memo1.lines, 'Arial', 4.7, 10, 10); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  druck(Listbox1.items, 'Times New Roman', 3.9, 9, 12); 
end; 
 
// ------------------------------------------------------------ 
 
// Abgeleitet davon, hier das Drucken einzelner Strings auf einem Blatt: 
 
uses Printers; 
 
procedure druck(txt: string; SchriftName: TFontName; SchriftHoehe: double; 
  x, y: integer); 
begin 
  with printer do begin 
    x := x * 10 - round(getdevicecaps(handle, physicaloffsetx) / 2.54); 
    y := -y * 10 + round(getdevicecaps(handle, physicaloffsety) / 2.54); 
    canvas.font.height := round(schrifthoehe * 10); 
    canvas.font.name := schriftname; 
    canvas.textout(x, y, txt); 
  end; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  LinksInMM, ObenInMM: integer; 
  SchriftHoeheInMM: double; 
begin 
  with printer do begin 
    title := 'Test-Druck'; 
    begindoc; 
    canvas.textout(0, 0, ' '); 
    SetMapMode(canvas.handle, MM_LOMETRIC); 
    LinksInMM := 125; 
    ObenInMM := 150; 
    SchriftHoeheInMM := 4.7; 
    druck('Zeile 1', 'Courier New', SchriftHoeheInMM, LinksInMM, ObenInMM); 
    LinksInMM := 12; 
    ObenInMM := 50; 
    SchriftHoeheInMM := 5; 
    druck('Zeile 2', 'Arial', SchriftHoeheInMM, LinksInMM, ObenInMM); 
    LinksInMM := 100; 
    ObenInMM := 100; 
    SchriftHoeheInMM := 7.2; 
    druck('Zeile 3', 'Times New Roman', SchriftHoeheInMM, LinksInMM, ObenInMM); 
// usw. 
    enddoc; 
  end; 
end; 


Zugriffe seit 6.9.2001 auf Delphi-Ecke