procedure TForm1.Button1Click(Sender: TObject);
var K: Double;
begin
 Printer.BeginDoc;
 K := Printer.Canvas.Font.PixelsPerInch / Canvas.Font.PixelsPerInch*1.2;
 PrintStringGrid(StrGrid,
 K, // Коэффициент
 200, // отступ от края листа в пихелах по Х
 200, // --"-- по Y
 200 // отступ снизу
 );
 Printer.EndDoc;
end;
{----------------------------------------------------------}
unit GrdPrn3;
interface
uses
 Windows, Classes, Graphics, Grids, Printers, SysUtils;
const
 OrdinaryLineWidth: Integer = 2;
 BoldLineWidth: Integer = 4;
procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; LeftMargin,
Margin, BottomMargin:
Integer);
function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow,
LeftMargin, Margin, Yfloor: Integer; DestCanvas: TCanvas): Integer;
 // возвращает номер строки, которая не поместилась до Y = Yfloor
 // не проверяет, вылезает ли общая длина таблицы за пределы страницы
 // Слишком длинное слово обрежется
implementation
procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; LeftMargin,
Margin, BottomMargin: Integer);
var Row: Integer;
begin
 //Printer.BeginDoc;
 if not Printer.Printing then raise Exception.Create('function
 PrintStringGrid must be called between Printer.BeginDoc
  and Printer.EndDoc');
 Row := 0;
 repeat
 Row := DrawStringGridEx(Grid, Scale, Row, LeftMargin, Margin,
  Printer.PageHeight - BottomMargin, Printer.Canvas);
 if Row <> -1 then Printer.NewPage;
 until Row = -1;
 //Printer.EndDoc;
end;
function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow,
LeftMargin, Margin, Yfloor: Integer; DestCanvas: TCanvas): Integer;
 // возвращает номер строки, которая не поместилась до Y = Yfloor
var
 i, j, d, TotalPrevH, TotalPrevW, CellH, CellW, LineWidth: Integer;
 R: TRect;
 s: string;
 procedure CorrectCellHeight(ARow: Integer);
 // вычисление правильной высоты ячейки с учетом многострочного текста
 // Текст рабивается только по словам слишком длинное слово обрубается
 var
  i, H: Integer;
  R: TRect;
  s: string;
 begin
  R := Rect(0, 0, CellH*2, CellH);
  s := ':)'; // Одинарная высота строки
  CellH := DrawText(DestCanvas.Handle, PChar(s), Length(s), R,
  DT_LEFT or DT_TOP or DT_WORDBREAK or DT_SINGLELINE or
  DT_NOPREFIX or DT_CALCRECT) + 3*d;
  for i := 0 to Grid.ColCount-1 do
  begin
  CellW := Round(Grid.ColWidths[i]*Scale);
  R := Rect(0, 0, CellW, CellH);
  //InflateRect(R, -d, -d);
  R.Left := R.Left+d;
  R. := R. + d;
  s := Grid.Cells[i, ARow];
  // Вычисление ширины и высоты
  H := DrawText(DestCanvas.Handle, PChar(s), Length(s), R,
  DT_LEFT or DT_TOP or DT_WORDBREAK or DT_NOPREFIX or DT_CALCRECT);
текста
  if CellH < H + 2*d then CellH := H + 2*d;
  // if CellW < R.Right - R.Left then Слишком длинное слово -
  // не помещается в одну строку; Перенос слов не поддерживается
  end;
 end;
begin
 Result := -1; // все строки уместились между Margin и Yfloor
 if (FromRow < 0)or(FromRow >= Grid.RowCount) then Exit;
 DestCanvas.Brush.Style := bsClear;
 DestCanvas.Font := Grid.Font;
// DestCanvas.Font.Height := Round(Grid.Font.Height*Scale);
 DestCanvas.Font.Size := 10;
 Grid.Canvas.Font := Grid.Font;
 Scale := DestCanvas.TextWidth('test')/Grid.Canvas.TextWidth('test');
 d := Round(2*Scale);
 TotalPrevH := 0;
 for j := 0 to Grid.RowCount-1 do
 begin
 if (j >= Grid.FixedRows) and (j < FromRow) then Continue;
 // Fixed Rows рисуются на каждой странице
 TotalPrevW := 0;
 CellH := Round(Grid.RowHeights[j]*Scale);
 CorrectCellHeight(j);
 if Margin + TotalPrevH + CellH > YFloor then
 begin
  Result := j; // j-я строка не помещается в заданный диапазон
  if Result < Grid.FixedRows then Result := -1;
  // если фиксированные строки не влезают на страницу -
  // это тяж?лый случай...
  Exit;
 end;
 for i := 0 to Grid.ColCount-1 do
 begin
  CellW := Round(Grid.ColWidths[i]*Scale);
  R := Rect(TotalPrevW, TotalPrevH, TotalPrevW + CellW,
  otalPrevH + CellH);
  OffSetRect(R, LeftMargin, Margin);
  if (i < Grid.FixedCols)or(j < Grid.FixedRows) then
  LineWidth := BoldLineWidth
  else
  LineWidth := OrdinaryLineWidth;
  DestCanvas.Pen.Width := LineWidth;
  if LineWidth > 0 then
  DestCanvas.Rectangle(R.Left, R., R.Right+1, R.Bottom+1);
  //InflateRect(R, -d, -d);
  R.Left := R.Left+d;
  R. := R. + d;
  s := Grid.Cells[i, j];
  DrawText(DestCanvas.Handle, PChar(s), Length(s), R,
  DT_LEFT or DT_TOP or DT_WORDBREAK or DT_NOPREFIX);
  TotalPrevW := TotalPrevW + CellW; // Общая ширина всех предыдущих колонок
 end;
 TotalPrevH := TotalPrevH + CellH; // Общая высота всех предыдущих строк
 end;
end;
end.

procedure PrintGrid(sGrid: TStringGrid;

left_StandOff,top_StandOff:integer; sTitle: string);

var

X1, X2,PixelsX,PrinterCoordX: Integer;

Y1, Y2,PixelsY,PrinterCoordY: Integer;

I: Integer;

F: Integer;

TR: TRect;

begin

{ left_StandOff - отступ в миллиметрах слева от края листа

top_StandOff - отступ в миллиметрах сверху от края листа

PrinterCoordX и PrinterCoordY - тот же отступ только в пикселах

Высота строк и ширина столбцов взяты соответственно 150 и 400,

при желании их размер можно передать в процедуру как параметры

}

//получаем информацию о разрешении принтера

PixelsX:=GetDeviceCaps(printer.Handle,LogPixelsX);//разрешение по Х

PixelsY:=GetDeviceCaps(printer.Handle,LogPixelsY);//разрешение по Y

PrinterCoordX:=round(PixelsX/25.4*left_StandOff);//переводим мм в пиксели

PrinterCoordY:=round(PixelsY/25.4*top_StandOff); //---

with printer do

begin

//Печатаем заголовок таблицы

Title := sTitle;

BeginDoc; // Начало печати

Canvas.Pen.Color := 0; // цвет-чёрный

Canvas.Font.Name := 'verdana'; // шрифт

Canvas.Font.Size := 10; // размер шрифта

Canvas.Font.Style := [];

//Текс заголовка в заданных координатах

Canvas.TextOut(PrinterCoordX, PrinterCoordY-100-

printer.Canvas.Font.Size*10, Printer.Title);

Canvas.Pen.Color := 0;

Canvas.Font.Name := 'Verdana';

Canvas.Font.Size := 8;

end;

for i:=0 to sgrid.colcount-1 do //перебираем столбцы

for f:=0 to sgrid.rowcount-1 do //перебираем в столбце все строки

begin

X1 := PrinterCoordX+i*400; //400-это ширина столбца

X2 := PrinterCoordX+400+i*400; //тоже

Y1:=PrinterCoordY+f*150; //150-высота строки

y2:=PrinterCoordY+150+f*150; //тоже

TR:=Rect(x1,y1,x2,y2);

with printer do

begin

Canvas.MoveTo(x1,y1);//Двигаем рисовалку в верхний левый угол таблицы

{пишем надпись в квадрате(ячейке) i-столбеца и f-строки со сдвигом

от верха на Y+50 и со сдвигом от левого края колонки на X+50

}

Canvas.TextRect(TR, X1 + 50, Y1 + 50, sGrid.Cells[i,f]);

//рисуем линии ячейки

Canvas.LineTo(x1,y2);

Canvas.LineTo(x2,y2);

Canvas.LineTo(x2,y1);

Canvas.LineTo(x1,y1);

end;

end;

Printer.EndDoc; // конец печати

end;



procedure TForm1.Button1Click(Sender: TObject);

begin

PrintGrid(StringGrid1,20,20, 'Таблица1: "Название"');

end;