БОЛЬШОЙ FAQ ПО DELPHI



Печать StringGrid

Прибыли ламеры? Сажайте в камеры!


 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.
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Видеокурс ВЗЛОМ