StringGrid drucken

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;