Печать TStringGrid

Материал из DRKB

Печать TStringGrid[править | править код]

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);

// возвращает номер строки, которая не поместилась до Y = Yfloor
// не проверяет, вылезает ли общая длина таблицы за пределы страницы
// Слишком длинное слово обрежется
function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow,
  LeftMargin, TopMargin, Yfloor: Integer; DestCanvas: TCanvas): Integer;

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;

// возвращает номер строки, которая не поместилась до Y = Yfloor
function DrawStringGridEx(Grid: TStringGrid; Scale: Double;
  FromRow, LeftMargin, TopMargin, Yfloor: Integer; DestCanvas: TCanvas): Integer;
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, TotalPrevH + 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.


Source: Взято с http://delphiworld.narod.ru
ID: 00613



Недавно довелось использовать код из "DRKB", для печати StringGrid, однако он не выводит на печать (у меня не вывел) 0-й столбец. Я Переделал его, добавив прорисовку ячеек таблицы, более удобное расположение заголовка таблицы, в качестве параметров процедуре можно передать отступ от края и сверху листа в миллиметрах. Также снабдил код комментариями. (я сам новичок в программировании, и будь в том коде комменты, разобрался бы куда легче чем пришлось). Надеюсь кому нибудь пригодится...


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 // перебираем столбцы
  begin
    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;
  end;
  Printer.EndDoc; // конец печати
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  PrintGrid(StringGrid1, 20, 20, 'Таблица1: "Название"');
end;


Source: Взято с Vingrad.ru http://forum.vingrad.ru
ID: 00614