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

Вниз

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

 
VladimirL   (2002-01-23 14:29) [0]

Мастера! Помогите! Не знаю, как отправить таблицу на принтер целиком - с рамками. Заранее спасибо.


 
Delirium   (2002-01-23 14:55) [1]

Как тебе такой вариант :)

procedure TForm1.Button1Click(Sender: TObject);
var BMP:TBitMap;
begin
BMP:=TBitMap.Create;
BMP.Height:= StringGrid1.Height;
BMP.Width := StringGrid1.Width;
BitBlt(BMP.Canvas.Handle,0,0,StringGrid1.Width,StringGrid1.Height,GetDC(StringGrid1.Handle),0,0,SRCCOPY);
Printer.BeginDoc;
Printer.Canvas.Draw(10,10,BMP);
Printer.EndDoc;
BMP.Free;
end;


 
Johnny Smith   (2002-01-23 15:07) [2]

Я в свое время печатал StringGrid на канву, разбивая при необходимости таблицу на куски. Если хочешь, кинь мне свой адрес на ilya1975@hotbox.ru и я вышлю исходники.


 
reonid   (2002-01-23 19:57) [3]

Попробуй так:

procedure TForm1.Button1Click(Sender: TObject);
var K: Double;
begin
Printer.BeginDoc;
K := Printer.Canvas.Font.PixelsPerInch /
Canvas.Font.PixelsPerInch;

PrintStringGrid(StrGrid, // TStringGrid
K, // Коэффициент
200, // отступ от края листа в пикселах канвы принтера по Х
200, // --"-- по Y
Printer.PageHeight - 200 // нижний предел
);

Printer.EndDoc;
end;




{--------------------------------------------------------------}
unit GrdPrnEx;

interface

uses
Windows, Classes, Graphics, Grids, Printers, SysUtils;

procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; dX, dY, Yfloor: Integer);

function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow, dX, dY,
Yfloor: Integer; ACanvas: TCanvas): Integer;
// возвращает номер строки, которая не поместилась до Y = Yfloor

// Недоработки:
// не проверяет, вылезает ли общая длина таблицы за пределы страницы
// Слишком длинное слово обрежется (если несколько - перенесутся)

implementation

procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; dX, dY, Yfloor: 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, dX, dY, Yfloor, Printer.Canvas);
if NextRow <> -1 then Printer.NewPage;
until NextRow = -1;

// Printer.EndDoc;
end;

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

function ScaleRect(R: TRect): TRect;
begin
Result.Left := dX + Round(R.Left*Scale);
Result.Right := dX + Round((R.Right)*Scale);
Result.Top := dY + Round(R.Top*Scale);
Result.Bottom := dY + Round((R.Bottom)*Scale);
end;

procedure CorrectCellHeight(ARow: Integer); // вычисление правильной высоты ячейки
// с учетом многострочного текста
// Текст рабивается только по словам
// слишком длинное слово обрубается
var
i, H: Integer;
R: TRect;
s: string;
begin
s := ":)"; // ?
CellH := DrawText(Grid.Canvas.Handle, PChar(s), Length(s), R,
DT_LEFT or DT_TOP or DT_WORDBREAK or DT_CALCRECT) + 4;
for i := 0 to Grid.ColCount-1 do
begin
R := Rect(0, 0, Grid.ColWidths[i], CellH);
InflateRect(R, -2, -2);
s := Grid.Cells[i, ARow];
H := DrawText(Grid.Canvas.Handle, PChar(s), Length(s), R,
DT_LEFT or DT_TOP or DT_WORDBREAK or DT_CALCRECT or DT_NOPREFIX); // Вычисление ширины и высоты текста
if CellH < H + 4 then CellH := H + 4;
// if CellW < R.Right - R.Left then Слишком длинное слово - не помещается в одну строку;
end;
end;

begin
Result := -1; // все строки уместились между dY и Yfloor
if (FromRow < 0)or(FromRow >= Grid.RowCount) then Exit;

d := Round(2*Scale);

ACanvas.Brush.Style := bsClear;
ACanvas.Font := Grid.Font;
ACanvas.Font.Height := Round(Grid.Font.Height*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 := Grid.RowHeights[j];
CorrectCellHeight(j);

if dY + Round( (TotalPrevH + CellH)*Scale) > YFloor then
begin
Result := j; // j-я строка не помещается в заданный диапазон
Exit;
end;

for i := 0 to Grid.ColCount-1 do
begin
CellW := Grid.ColWidths[i];

R := Rect(TotalPrevW, TotalPrevH, TotalPrevW + CellW, TotalPrevH + CellH);
R := ScaleRect(R);

if (i < Grid.FixedCols)or(j < Grid.FixedRows) then ACanvas.Pen.Width := 3
else ACanvas.Pen.Width := 1;

ACanvas.Rectangle(R.Left, R.Top, R.Right+1, R.Bottom+1);
InflateRect(R, -d, -d);

s := Grid.Cells[i, j];
DrawText(ACanvas.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.



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

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

Наверх





Память: 0.47 MB
Время: 0.005 c
6-18942
Deep
2001-11-10 04:25
2002.02.07
как сделать папку сетевой?


4-19040
nika
2001-12-11 01:20
2002.02.07
HELP ME!!!!!!!!!!!!!!!!ОЧЕНЬ ПРОШУ


1-18853
Eraser
2002-01-21 13:00
2002.02.07
Thread - To ALL HELP!!


1-18902
cyborg
2002-01-21 21:19
2002.02.07
Как вывести текст в TImage чтобы фон у него был прозрачный?


3-18746
sasa_ch
2002-01-09 09:55
2002.02.07
PLS





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский