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:

   procedure TForm1.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
        fix := clsilver;
        grund := clwhite;
        schrift := clblack;
         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 := 'Medien-Archiv';
            Orientation := poLandscape;
            BeginDoc;
            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;                    

1:
2:
3:
4:
5:
6:

  with Printer do  
    begin  
    Title := 'Medien-Archiv';  
    Orientation := poLandscape;  
    BeginDoc;  
    Canvas.Pen.Style := psClear;