1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:

Stringgrid ausdrucken Version 1:
uses printers;

//StringGrid-Inhalt ausdrucken 

procedure PrintStringGrid(Grid: TStringGrid; Title: String; Orientation:TPrinterOrientation);
var
  P, I, J, YPos, XPos, HorzSize, VertSize: Integer;
  AnzSeiten, Seite, Zeilen, HeaderSize, FooterSize, ZeilenSize, FontHeight: Integer;
  mmx, mmy: Extended;
  Footer: String;
begin
  //Kopfzeile, Fußzeile, Zeilenabstand, Schriftgröße festlegen
  HeaderSize := 100;
  FooterSize := 200;
  ZeilenSize := 36;
  FontHeight := 36;
  //Printer initializieren
  Printer.Orientation := Orientation;
  Printer.Title := Title;
  Printer.BeginDoc;
  //Druck auf mm einstellen
  mmx := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALWIDTH) /
    GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSX) * 25.4;
  mmy := GetDeviceCaps(Printer.Canvas.Handle, PHYSICALHEIGHT) /
    GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY) * 25.4;
  VertSize := Trunc(mmy)*10;
  HorzSize := Trunc(mmx)*10;
  SetMapMode(Printer.Canvas.Handle, MM_LOMETRIC);

  //Zeilenanzahl festlegen
  Zeilen := (VertSize - HeaderSize - FooterSize) div ZeilenSize;
  //Seitenanzahl ermitteln
  if Grid.RowCount mod Zeilen <> 0 then
    AnzSeiten := Grid.RowCount div Zeilen + 1
  else
    AnzSeiten := Grid.RowCount div Zeilen;
  Seite := 1;
  //Grid drucken
  for P := 1 to AnzSeiten do
  begin
    //Kopfzeile
    Printer.Canvas.Font.Height := 48;
    Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Title) div 2)),
      -20, Title);
    Printer.Canvas.Pen.Width := 5;
    Printer.Canvas.MoveTo(0, -HeaderSize);
    Printer.Canvas.LineTo(HorzSize, -HeaderSize);
    //Fußzeile
    Printer.Canvas.MoveTo(0, -VertSize+FooterSize);
    Printer.Canvas.LineTo(HorzSize, -VertSize+FooterSize);
    Printer.Canvas.Font.Height := 36;
    Footer := ‚Seite: ‚ + IntToStr(Seite) + ‚ von ‚ + IntToStr(AnzSeiten);
    Printer.Canvas.TextOut((HorzSize div 2 - (Printer.Canvas.TextWidth(Footer) div 2)),
      -VertSize+150, Footer);
    //Zeilen drucken
    Printer.Canvas.Font.Height := FontHeight;
    YPos := HeaderSize + 10;
    for I := 1 to Zeilen do
    begin
      if Grid.RowCount >= I + (Seite-1)*Zeilen then
      begin
        XPos := 0;
        for J := 0 to Grid.ColCount - 1 do
        begin
          Printer.Canvas.TextOut(XPos, -YPos, Grid.Cells[J,I+(Seite-1)*Zeilen-1]);
          XPos := XPos + Grid.ColWidths[J]*3;
        end;
        YPos := YPos + ZeilenSize;
      end;
    end;
    //Seite hinzufügen
    Inc(Seite);
    if Seite <= AnzSeiten then Printer.NewPage;
  end;
  Printer.EndDoc;
end;

//Example
procedure TForm1.Button1Click(Sender: TObject);
begin
  //Drucken im Querformat
  PrintStringGrid(Grid,‘StringGrid Print Landscape‘, poLandscape);
  //Drucken im Hochformat
  PrintStringGrid(Grid,‘StringGrid Print Portrait‘, poPortrait);
end;
 Stringgrid ausdrucken Version 2:

// Es wird ein Stringgrid an den Drucker geschickt. Der Einfachheit halber // sowie aus Platzgründen werden die Trennstriche zwischen den einzelnen Zellen // stets nur 1 Pixel breit gezeichnet. Es kann ein Offset von der linken // und/oder der oberen Druckkante angegeben werden. Diese Werte entsprechen der // Pixelzahl auf dem Bildschirm, d.h. wenn z.B. das Grid 10 Pixel vom Rand // der Form liegt, werden diese zehn Pixel proportional in die Anzahl der // Pixel auf dem Drucker umgerechnet, um den gleichen Abstand vom Rand zu // gewährleisten wie auf dem Schirm. Mit scal kann die Größe der Ausgabe // beeinflußt werden. Bei scal=1 erscheint es auf dem Papier in der selben // Größe, wie auf einem 800x600 Bildschirm.
// Durch Werte in vSpalte (erste zu druckende Spalte), bSpalte (letzte zu
// druckende Spalte), vZeile (erste zu druckende Zeile) und bZeile (letzte
// zu druckende Zeile) erreicht man Teilausdrucke (Zählung beginnt bei 0!).
// Haben diese Variablen negative Werte, wird das gesamte Grid ausgedruckt.
// Zusätzlich kann man angeben, ob das Grid in der Farbe wie auf dem Schirm
// (farbig=true) oder in Schwarz/Weiss (farbig=false) gedruckt werden soll.
// Siehe auch Stringgrids speichern und laden
// Getestet mit D4 unter Win98
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;
 Stringgrid ausdrucken Version 3:

procedure GridDruck(grd:TStringGrid; links, oben: Integer; scal:double; farbig:boolean);
   var
      x, y, li, ob, re, un, waag, senk, a,  vSpalte, bSpalte, vZeile, bZeile: integer;
      fix, grund, schrift: TColor;
      r: TRect;

      function rech(i,j:integer):integer;
      begin
         result:=round(((i*j) / 72) * scal);
      end;
   begin
      vZeile := 0;
      vSpalte := 0;
      bZeile := grd.rowcount - 1;
      bSpalte := grd.colcount - 1;
      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 := ‚Statistik‘;
            Orientation := poLandscape;
            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);
            ob := GetDeviceCaps(Printer.Handle, PhysicalOffsetY) + 1 + oben;
            for y := vZeile to bZeile do
            begin
               un := ob + rech(Grd.RowHeights[y]+1, senk);
               //neue Seite + Kopf
               if (un > Printer.PageHeight) and
                  (Printing) then
               begin
                  EndDoc;
                  BeginDoc;
                  ob := GetDeviceCaps(Printer.Handle, PhysicalOffsetY) + 1 + oben;
                  un := ob + rech(Grd.RowHeights[y]+1, senk);
                  for x := vSpalte to bSpalte do
                  begin
                     Canvas.Brush.Color := fix;
                     re := li + rech(Grd.ColWidths[x] + 1, waag);
                     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,0]), length(Grd.Cells[x,0]), r, DT_SINGLELINE or DT_VCENTER);
                     li := re;
                  end;
                  li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
                  ob := un;
               end;
               un := ob + rech(Grd.RowHeights[y]+1, senk);
               for x := vSpalte to bSpalte do
               begin
                  if (x < Grd.FixedCols) or
                     (y < Grd.FixedRows) then
                     Canvas.Brush.Color := fix
                  else
                     Canvas.Brush.Color := Grund;
                  re := li + rech(Grd.ColWidths[x] + 1, waag);
                  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);
                  li := re;
               end;
               ob := un;
               li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
            end;
            if Printing then
               EndDoc;
         end;
      end;
   end; //GridDruck
 Stringgrid ausdrucken Version 4:

Uses
  Printers, Grids;

procedure GridDruck(grd:TStringGrid;links,oben:word;scal:double);
var
  x,y,li,ob,re,un,waag,senk,h,a: integer;
  s: string;

function rech(i,j:integer):integer;
begin
  result:=round(((i*j) / 72) * scal);
end;

begin
  if scal > 0 then
  begin
    waag:=getdevicecaps(printer.handle,logpixelsx);
    senk:=getdevicecaps(printer.handle,logpixelsy);
    links:=rech(links,waag);
    oben:=rech(oben, senk);
    a:=rech(3,waag);
    li:=getdevicecaps(printer.handle,physicaloffsetx)+1+links;
    with printer do
    begin
      s:='Grid-Druck';
      title:=s;
      BeginDoc;
      canvas.font:=grd.font;
      canvas.font.size:=round((grd.font.size / 0.72) * scal);
      h:=canvas.textheight(s);
      canvas.pen.color:=$333333;
      for x:=0 to grd.colcount-1 do
      begin
        if grd.gridlinewidth > 0 then
        begin
          canvas.pen.style:=pssolid;
          canvas.pen.width:=1;
        end
        else
          canvas.pen.style:=psclear;
        ob:=getdevicecaps(printer.handle,physicaloffsety)+1+oben;
        re:=li+rech(grd.ColWidths[x]+1,waag);
        for y:=0 to grd.rowcount-1 do
        begin
          un:=ob+rech(grd.RowHeights[y]+1,senk);
          if (x < grd.fixedcols) or
             (y < grd.fixedrows) then
            canvas.brush.color:=grd.fixedcolor
          else
            canvas.brush.color:=grd.color;
          canvas.rectangle(li,ob,re,un);
          canvas.brush.style:=bsclear;
          canvas.textrect(rect(li+a,ob+1,re-a,un-1),
          li+a,ob+(un-ob-h)div 2,grd.Cells[x,y]);
          ob:=un;
        end;
        canvas.brush.color:=clwhite;
        canvas.pen.style:=psclear;
        canvas.rectangle(li,ob+1,re,ob+h);
        li:=re;
      end;
      enddoc;
    end;
  end;
end;


Die Procedure erwartet vier Parameter. Dem ersten Parameter muss das zu druckende StringGrid übergeben werden (z.B. StringGrid1), dem zweiten Parameter den linken und oberen Rand beim Drucken. Der vierte Parameter ist für die Skalierung zuständig.

So kann man die Procedure Beispielsweise aufrufen:

// Ein Grid wird an der äußersten Druckkante in Originalgröße ausgegeben
procedure TForm1.Button1Click(Sender: TObject);
begin
  griddruck(stringgrid1,0,0,1);
end;

// Ein Grid wird mit dem Abstand wie auf der Form ausgegeben
procedure TForm1.Button2Click(Sender: TObject);
begin
  griddruck(stringgrid1,stringgrid1.left,stringgrid1.top,1);
end;

// Ein Grid wird in halber Größe ausgegeben
procedure TForm1.Button1Click(Sender: TObject);
begin
  griddruck(stringgrid1,0,0,0.5);
end;


 Stringgrid ausdrucken Version 5:

uses 
  Printers; 

procedure PrintGrid (sGrid: TStringGrid; sTitle: string); 
var 
  X1, X2: Integer; 
  Y1, Y2: Integer; 
  TmpI: Integer; 
  F: Integer; 
  TR: TRect; 
begin 
  Printer.Title := sTitle; 
  Printer.BeginDoc; 
  Printer.Canvas.Pen.Color  := 0; 
  Printer.Canvas.Font.Name  := 'Times New Roman'; 
  Printer.Canvas.Font.Size  := 12; 
  Printer.Canvas.Font.Style := [fsBold, fsUnderline]; 
  Printer.Canvas.TextOut(0, 100, Printer.Title); 

  for F := 1 to sGrid.ColCount - 1 do  
  begin 
    X1 := 0; 
    for TmpI := 1 to (F - 1) do 
      X1 := X1 + 5 * (sGrid.ColWidths[TmpI]); 
    Y1 := 300; 

    X2 := 0; 
    for TmpI := 1 to F do 
      X2 := X2 + 5 * (sGrid.ColWidths[TmpI]); 
    Y2 := 450; 

    TR := Rect (X1, Y1, X2 - 30, Y2); 

    Printer.Canvas.Font.Style := [fsBold]; 
    Printer.Canvas.Font.Size := 7; 
    Printer.Canvas.TextRect(TR, X1 + 50, 350, sGrid.Cells[F, 0]); 
    Printer.Canvas.Font.Style := []; 

    for TmpI := 1 to sGrid.RowCount - 1 do  
    begin 
      Y1 := 150 * TmpI + 300; 
      Y2 := 150 * (TmpI + 1) + 300; 
      TR := Rect(X1, Y1, X2 - 30, Y2); 
      Printer.Canvas.TextRect(TR, X1 + 50, Y1 + 50, sGrid.Cells[F, TmpI]); 
    end; 
  end; 
  Printer.EndDoc; 
end;
 Stringgrid ausdrucken Version 6:

procedure GridDrucktitel(grd:TStringGrid; links, oben: Integer; scal:double; farbig:boolean);
 var x, y, li, ob, re, un, waag, senk, a,  vSpalte, bSpalte, vZeile, bZeile,xWidth: integer;
     fix, grund, schrift: TColor;
     r: TRect;
  function rech(i,j:integer):integer;
  begin
    result:=round(((i*j) / 72) * scal);
  end;
begin
  xWidth:=printer.PageWidth;
  //while StringgridWidth<xWidth do
  //begin
  vZeile := 0;
  vSpalte := 0;
  bZeile := grd.rowcount - 1;
  bSpalte := grd.colcount - 1;
  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 := 'Filial-Listen';
      Orientation := poLandscape;
      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);
      ob := GetDeviceCaps(Printer.Handle, PhysicalOffsetY) + 1 + oben;
      for y := vZeile to bZeile do
      begin
        un := ob + rech(Grd.RowHeights[y]+1, senk);
        //neue Seite + Kopf
        //ArtDruck:=1;
        //AutoSignatur;
        if (un > Printer.PageHeight) and
           (Printing) then
        begin
          //EndDoc;
          //BeginDoc;
          ob := GetDeviceCaps(Printer.Handle, PhysicalOffsetY) + 1 + oben;
          un := ob + rech(Grd.RowHeights[y]+1, senk);
          for x := vSpalte to bSpalte do
          begin
            Canvas.Brush.Color := fix;
            re := li + rech(Grd.ColWidths[x] + 1, waag);
            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,0]), length(Grd.Cells[x,0]), r, DT_SINGLELINE or DT_VCENTER);
            li := re;
          end;
          li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
          ob := un;
        end;
        un := ob + rech(Grd.RowHeights[y]+1, senk);
        for x := vSpalte to bSpalte do
        begin
          if (x < Grd.FixedCols) or
             (y < Grd.FixedRows) then
             Canvas.Brush.Color := fix
          else
            Canvas.Brush.Color := Grund;
            re := li + rech(Grd.ColWidths[x] + 1, waag);
            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);
            li := re;
          end;
            ob := un;
            li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
        end;
        if Printing then
          EndDoc;
        //StringgridWidth:=grd.Width;
    end;
  end;
  //end;
end; //GridDruck					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:

procedure GridDruckNeu(grd:TStringGrid; links, oben: Integer; scal:double; farbig:boolean);
   var
      x, y, li, ob, re, un, waag, senk, a, vSpalte, bSpalte, vZeile, bZeile: integer;
      fix, grund, schrift: TColor;
      r: TRect;
      fertig:boolean;
      i,breite,waagseiten:integer;

      function rech(i,j:integer):integer;
      begin
         result:=round(((i*j) / 72) * scal);
      end;

   begin
      vZeile := 0;
      vSpalte := 0;
      bZeile := grd.rowcount - 1;
      bSpalte := grd.colcount - 1;
      waag := GetDeviceCaps(Printer.Handle, LogPixelSX);
      senk := GetDeviceCaps(Printer.Handle, LogPixelSY);
      SetWindowOrgEx(printer.Handle, 0, 0, nil);

      breite:=0; // breite des Ausdrucks, wird gebraucht um ggfs. viewport zu verschieben
      for i := vSpalte to bSpalte do breite:=breite + rech(Grd.colwidths[i]+1, waag);
      waagseiten:=0;

      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;
         links := rech(links, waag);
         oben := rech(oben, senk);
         li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
         a := rech(3, waag);
         with Printer do
         begin
            Title := 'Druck Titel';
            // Orientation := poLandscape;
            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);

            fertig:=false;
            while not fertig do begin
              ob := GetDeviceCaps(Printer.Handle, PhysicalOffsetY) + 1 + oben;
              for y := vZeile to bZeile do // alle markierten Zeilen abarbeiten...
              begin
                 un := ob + rech(Grd.RowHeights[y]+1, senk); // aufaddieren des Unterrandes
                 //neue Seite + Kopf
                 if (un > Printer.PageHeight) and
                    (Printing) then
                 begin
                    // EndDoc;
                    // BeginDoc;
                    printer.NewPage;
                    ob := GetDeviceCaps(Printer.Handle, PhysicalOffsetY) + 1 + oben;
                    un := ob + rech(Grd.RowHeights[y]+1, senk);
(*                    for x := vSpalte to bSpalte do     // Grauer Rand
                    begin
                       Canvas.Brush.Color := fix;
                       re := li + rech(Grd.ColWidths[x] + 1, waag);
                       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,0]), length(Grd.Cells[x,0]), r, DT_SINGLELINE or DT_VCENTER);
                       li := re;
                    end;
                    li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
*)                    ob := un;
                 end;
                 un := ob + rech(Grd.RowHeights[y]+1, senk);
                 for x := vSpalte to bSpalte do begin
                    if (x < Grd.FixedCols) or
                       (y < Grd.FixedRows) then
                       Canvas.Brush.Color := fix
                    else
                       Canvas.Brush.Color := Grund;
                    re := li + rech(Grd.ColWidths[x] + 1, waag);
                    // Canvas.Rectangle(li, ob, re + 2, un + 2);  // zeichnet grauen Rahmen um das Grid
                    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);
                    li := re;
                 end;
                 ob := un;
                 li := GetDeviceCaps(Printer.Handle, PhysicalOffsetX) + 1 + links;
              end;
              // jetzt Prüfung, ob der Ausdruck zu breit ist und ggfs, neue Serie mit verschobenem Viewport
              inc(waagseiten); // anzahl der waagerechten nebeneinanderliegen seiten, die ausgedruckt wurden
              if (breite > (Printer.PageWidth*waagseiten)) then fertig:=false else fertig:=true;
              if not fertig then begin
                printer.NewPage;
                SetWindowOrgEx(printer.Handle,printer.pageWidth*waagseiten, 0, nil); // viewport um Seitengröße verschieben
              end;
            end; // von while not fertig...
            if Printing then EndDoc;
         end; // von WITH PRINTER
      end;
   end; //GridDruckNeu