procedure GridDruck(grd: TStringGrid; links, oben, vSpalte, bSpalte, vZeile, 
  bZeile: integer; scal: double; farbig: boolean); 
var 
  x, y, li, ob, re, un, waag, senk, a: integer; 
  fix, grund, schrift: TColor; 
  r: Trect; 
  function rech(i, j: integer): integer; 
  begin 
    result := round(((i * j) / 72) * scal); 
  end; 
begin 
  if vZeile < 0 then vZeile := 0; 
  if vSpalte < 0 then vSpalte := 0; 
  if (bZeile >= grd.rowcount) or (bZeile < 0) 
    then bZeile := grd.rowcount - 1; 
  if (bSpalte >= grd.colcount) or (bSpalte < 0) 
    then bSpalte := grd.colcount - 1; 
  if vZeile > bZeile then begin 
    a := vZeile; 
    vZeile := bZeile; 
    bZeile := a; 
  end; 
  if vSpalte > bSpalte then begin 
    a := vSpalte; 
    vSpalte := bSpalte; 
    bSpalte := a; 
  end; 
  if (scal > 0) and (vZeile < grd.rowcount) and (vSpalte < grd.colcount) 
    then begin 
    if farbig then begin 
      fix := grd.fixedcolor; 
      grund := grd.color; 
      schrift := grd.font.color; 
    end else begin 
      fix := clsilver; 
      grund := clwhite; 
      schrift := clblack; 
    end; 
    waag := getdevicecaps(printer.handle, logpixelsx); 
    senk := getdevicecaps(printer.handle, logpixelsy); 
    links := rech(links, waag); 
    oben := rech(oben, senk); 
    li := getdevicecaps(printer.handle, physicaloffsetx) + 1 + links; 
    a := rech(3, waag); 
    with printer do begin 
      title := 'Grid-Druck'; 
      BeginDoc; 
      if grd.gridlinewidth > 0 then begin 
        canvas.pen.color := $333333; 
        canvas.pen.width := 1; 
        canvas.pen.style := pssolid 
      end else canvas.pen.style := psclear; 
      canvas.font := grd.font; 
      canvas.font.color := schrift; 
      canvas.font.size := round((grd.font.size / 0.72) * scal); 
      for x := vSpalte to bSpalte do begin 
        ob := getdevicecaps(printer.handle, physicaloffsety) + 1 + oben; 
        re := li + rech(grd.ColWidths[x] + 1, waag); 
        for y := vZeile to bZeile do begin 
          un := ob + rech(grd.RowHeights[y] + 1, senk); 
          if (x < grd.fixedcols) or (y < grd.fixedrows) 
            then canvas.brush.color := fix 
          else canvas.brush.color := grund; 
          canvas.rectangle(li, ob, re + 2, un + 2); 
          r := rect(li + a, ob + 1, re - a, un - 2); 
          drawtext(canvas.handle, pchar(grd.Cells[x, y]), length(grd.Cells[x, y]),
           r, DT_SINGLELINE or DT_VCENTER); 
          ob := un; 
        end; 
        li := re; 
      end; 
      enddoc; 
    end; 
  end; 
end; 
 
// Beispielaufrufe 
// Ein Grid wird an der äußersten Druckkante in Originalgröße ausgegeben 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  griddruck(stringgrid1, 0, 0, -1, -1, -1, -1, 1, true); 
end; 
 
// Die ersten 3 x 3 Zellen werden mit Randabstand wie auf der Form ausgegeben 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  griddruck(stringgrid1, stringgrid1.left, stringgrid1.top, 0, 2, 0, 2, 1, 
    true); 
end; 
 
// Ein Grid wird in halber Größe und schwarz/weiss ausgegeben 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  griddruck(stringgrid1, 0, 0, 0, 0, -1, -1, 0.5, false); 
end; 
 
// von einem Stringgrid wird je ein Viertel 
// auf einer eigenen Seite gedruckt 
procedure TForm1.Button1Click(Sender: TObject); 
var s, z: integer; 
begin 
  s := stringgrid1.ColCount - 1; 
  z := stringgrid1.RowCount - 1; 
  griddruck(stringgrid1, 25, 30, 0, s div 2, 0, z div 2, 1, true); 
  griddruck(stringgrid1, 25, 30, s div 2 + 1, s, 0, z div 2, 1, true); 
  griddruck(stringgrid1, 25, 30, 0, s div 2, z div 2 + 1, z, 1, true); 
  griddruck(stringgrid1, 25, 30, s div 2 + 1, s, z div 2 + 1, z, 1, true); 
end;