Содержание материала

 

 

Code:

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,

TopMargin, BottomMargin:

Integer);

function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow,

LeftMargin, TopMargin, Yfloor: Integer; DestCanvas: TCanvas): Integer;

// возвращает номер строки, которая не поместилась до Y = Yfloor

// не проверяет, вылезает ли общая длина таблицы за пределы страницы

// Слишком длинное слово обрежется

implementation

procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; LeftMargin,

TopMargin, BottomMargin: Integer);

var NextRow: Integer;

begin

//Printer.BeginDoc;

if not Printer.Printing then raise Exception.Create('function

PrintStringGrid must be called between Printer.BeginDoc

  and Printer.EndDoc');

NextRow := 0;

repeat

NextRow := DrawStringGridEx(Grid, Scale, NextRow, LeftMargin, TopMargin,

  Printer.PageHeight - BottomMargin, Printer.Canvas);

if NextRow <> -1 then Printer.NewPage;

until NextRow = -1;

//Printer.EndDoc;

end;

function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow,

LeftMargin, TopMargin, 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.Top := R.Top + 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; // все строки уместились между TopMargin и 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 TopMargin + 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, TopMargin);

  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.Top, R.Right+1, R.Bottom+1);

  //InflateRect(R, -d, -d);

  R.Left := R.Left+d;

  R.Top := R.Top + 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.

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить