Текущий архив: 2007.04.08;
Скачать: CL | DM;

Вниз

Печать содержимого TStringGrid   Найти похожие ветки 

← →
Malik ©   (2007-03-14 20:14) [0]

Подскажите пожалуста как распечатать содержимое StringGrid"a?

---

← →
Anatoly Podgoretsky ©   (2007-03-14 20:23) [1]

> Malik  (14.03.2007 20:14:00)  [0]

Вариантов много, например WriteLn

---

← →
RASkov   (2007-03-14 20:33) [2]

На принтер?

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.
© Delphi World

---

← →
Malik ©   (2007-03-14 21:26) [3]

Хочу выразить всем искреннюю благодарность за помощь

---

Страницы: 1 вся ветка

Текущий архив: 2007.04.08;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.046 c