Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2002.07.08;
Скачать: [xml.tar.bz2];

Вниз

Как программно распечатать содержимое StringGrid’а?   Найти похожие ветки 

 
Nickes   (2002-06-26 14:54) [0]

Как программно по нажатию на кнопочку распечатать содержимое StringGrid’а?
Заранее спасибо!


 
Song   (2002-06-26 15:10) [1]

Нарисовать таблицу на канвасе принтера.


 
Бурундук   (2002-06-26 15:12) [2]

Printer.BeginDoc;
K := Printer.Canvas.Font.PixelsPerInch / Canvas.Font.PixelsPerInch*1.2;

PrintStringGrid(StrGrid,
K, // zoom
200, // left margin
200, // top margin
200 // bottom margin
);

Printer.EndDoc;

{------------------------------------------------------------}
unit GrdPrn2;

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: 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_CALCRECT or DT_NOPREFIX) + 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_CALCRECT or DT_NOPREFIX); // Вычисление ширины и высоты текста
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;

d := Round(2*Scale);

DestCanvas.Brush.Style := bsClear;
DestCanvas.Font := Grid.Font;
DestCanvas.Font.Height := Round(Grid.Font.Height*Scale);

// Scale := DestCanvas.Font.Height/Grid.Font.Height;

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
DestCanvas.Pen.Width := BoldLineWidth
else
DestCanvas.Pen.Width := OrdinaryLineWidth;

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.


 
Song   (2002-06-26 15:13) [3]

Нарисовать таблицу на канвасе принтера.


 
Nickes   (2002-06-26 17:11) [4]


> Song © (26.06.02 15:13)
> Нарисовать таблицу на канвасе принтера.

А как, помогите пожалуйста!


 
Nickes   (2002-06-26 17:45) [5]


> Бурундук (26.06.02 15:12)

Выходит куча ошибок!!!
[Error] Unit2.pas(40): Undeclared identifier: "DrawStringGridEx"
[Error] Unit2.pas(67): Undeclared identifier: "CellH"
[Error] Unit2.pas(69): Undeclared identifier: "DestCanvas"
[Error] Unit2.pas(69): Not enough actual parameters
[Error] Unit2.pas(71): ";" expected but "FOR" found
[Error] Unit2.pas(73): Undeclared identifier: "CellW"
[Error] Unit2.pas(73): Undeclared identifier: "Grid"
[Error] Unit2.pas(73): Undeclared identifier: "i"
[Error] Unit2.pas(83): "." expected but "IF" found
[Warning] Unit2.pas(86): Text after final "END." - ignored by compiler
[Hint] Unit2.pas(13): Private symbol "PrintStringGrid" declared but never used
[Error] Unit2.pas(16): Unsatisfied forward or external declaration: "TForm2.DrawStringGridEx"
[Fatal Error] Project1.dpr(6): Could not compile used unit "Unit2.pas"

Там я заметил функция есть:

function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow, LeftMargin, TopMargin,
Yfloor: Integer; DestCanvas: TCanvas): Integer;
// возвращает номер строки, которая не поместилась до Y = Yfloor
var
i, j, d, TotalPrevH, TotalPrevW, CellH, CellW: Integer;
R: TRect;
s: string;

Как видишь она ничем не заканчивается! А где Begin/End;???
Как тут быть?


 
Бурундук   (2002-06-26 18:00) [6]

У меня только что всё распечаталось без проблем.
Ты хоть сделал GrdPrn2 отдельным юнитом?

А на счет ф-м DrawStringGridEx - так внутри неё другая ф-я CorrectCellHeight, а её begin начинается после конца этой ф-и


 
Nickes   (2002-06-26 18:13) [7]

Я новенький в Delphi :(, а как создать новый юнит?
Помоги пожалуйста!


 
Бурундук   (2002-06-26 18:22) [8]

Меню File->New->Unit
и замени в нём весь текст на то что после
{------------------------------------------------------------}
Назови его GrdPrn2.pas.

А в твоём файле (подозреваю, он называется unit2), в раздел uses
добавь GrdPrn2.



 
Nickes   (2002-06-26 18:39) [9]

Спасибо большое!
А как сделать чтобы на печать он выводил без линий, чтобы только текст?


 
Бурундук   (2002-06-26 19:02) [10]

Закоментируй строку (в DrawStringGridEx)
DestCanvas.Rectangle(R.Left, R.Top, R.Right+1, R.Bottom+1);

И на всякий случай увеличь ширину колонки, чтобы текст не сливался:
Замени (там же)
CellW := Round(Grid.ColWidths[i]*Scale);
На
CellW := Round(Grid.ColWidths[i]*Scale) + 6*d;



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

Форум: "Основная";
Текущий архив: 2002.07.08;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.006 c
1-23546
Дельфятник
2002-06-26 17:37
2002.07.08
Access Violation при работе с TComboBox.


14-23733
Kaban
2002-06-05 12:38
2002.07.08
Наши выигрывают 2-0.


4-23823
AlexanderSK
2002-05-06 12:27
2002.07.08
GetVolumeInformation


8-23690
Spirit
2002-02-28 09:14
2002.07.08
Как сделать пазл из картинки?


1-23558
rdm
2002-06-26 22:27
2002.07.08
Изменить разрешение экрана





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский