Как напечатать StringGrid?

← →
zsv (2002-09-20 06:44) [0]

Мужики, как распечатать таблицу StringGrid в табличном виде на бумагу чтобы сохранялась структура столбцов и строк?
Печатать как файл не получается, т.к. символы имеют разную ширину в пикселах.
С использованием Printers печатается только та часть таблицы, которая видна в окне...

← →
Separator (2002-09-20 06:54) [1]

Попробуй через QuickRep

← →
zsv (2002-09-20 14:37) [2]

Через QuickRep тоже не получается.
На полосе QRStringsBand получается то же, что и через файл- ширина символов разная, пробелами не уравновесить.
А в Detail - не могу подключить таблицу к DataSet...

Как бы это сделать?

← →
reonid (2002-09-20 14:41) [3]

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, 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.

← →
zsv (2002-09-21 07:08) [4]

Ребята, я сражен.
Все работает!
Спасибо большое.

ZSV

← →
Sergey V. Shadrin (2002-09-26 17:06) [5]

этот пример работает. а если вставить в свою программу - то не печатает русский текст. как исправить?

← →
Sergey V. Shadrin (2002-09-26 17:08) [6]

исправил. в свойствах таблицы указал русский чар сет и поставил шрифт ариал.

Как напечатать StringGrid? Найти похожие ветки