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

Вниз

StringGrid   Найти похожие ветки 

 
Bishop   (2002-12-28 07:49) [0]

Привет Всем! Подскажите плиз! Как можно распечатать таблицу из StringGrida. И как можно выставить выравнивание например по центру. Заранее благодарен. Если не сложно, то посоветуйте где можно закачать книгу по Делфам (на бумажную пока денег не хватает). :(


 
Mike_Goblin   (2002-12-28 10:11) [1]

1. Как распечатать
Изучай класс TPrinter
2. Выводить текст ячейки с выравниванием по центру
Сделать самостоятельно отрисовку StringGrid
а) DefaultDrawing установить в false
б) написать обработчик OnDrawCell


 
reonid   (2002-12-28 13:24) [2]

Печать грида с использованием TPrinter:
(cделал когда-то в методических целях)

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

PrintStringGrid(StrGrid,
K, // Коэффициент
200, //отступ от края листа в пихелах по Х
200, //Printer.PageHeight div 2 + 200, // --"-- по Y
200 // bottom margine
);

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
const
// Выравнивание - только для печати, естественно
// Выравнивание по правому краю
//DT_Flags = DT_LEFT or DT_TOP or DT_WORDBREAK or DT_NOPREFIX;

// Выравнивание по центру
DT_Flags = DT_CENTER or DT_TOP or DT_WORDBREAK or DT_NOPREFIX;
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_Flags or DT_SINGLELINE 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_Flags 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;


 
reonid   (2002-12-28 13:24) [3]


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_Flags);

TotalPrevW := TotalPrevW + CellW; // Общая ширина всех предыдущих колонок
end;

TotalPrevH := TotalPrevH + CellH; // Общая высота всех предыдущих строк
end;
end;

end.


 
DmitryMN   (2002-12-29 10:33) [4]

Простой способ - выведи все в Excel и потомпечатай себе на здоровье



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

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

Наверх




Память: 0.47 MB
Время: 0.009 c
3-36966
Wowa-K
2002-12-18 14:52
2003.01.13
Нехватка памяти


1-37035
sergl
2003-01-02 15:04
2003.01.13
Создание e-mail и помещение его в Исходяшие Microsoft Outlook2000


1-37126
Stas_a
2003-01-04 15:05
2003.01.13
Перехват OnCLick в компоненте.


1-37074
VJar
2003-01-03 13:45
2003.01.13
Обработка ошибки перевода данных


3-36948
Senator
2002-12-18 12:22
2003.01.13
Спасите, помогите !!!!!!





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