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

Вниз

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

 
Urvin   (2005-02-27 00:26) [0]

Есть тема - надо напечатать табличку на принтере. Сложность в том, что я не знаю, сколько строк займет каждая ячейка.
Можно ли как-нибудь узнать будующую высоту ячейки с учетом заданной ширины?


 
DiamondShark ©   (2005-02-27 00:31) [1]

Ответ на вопрос зависит от используемого метода печати.


 
Anatoly Podgoretsky ©   (2005-02-27 00:31) [2]

Теперь тоже самое по русски и своими словами.


 
reonid ©   (2005-02-27 00:58) [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.



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

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

Наверх





Память: 0.47 MB
Время: 0.05 c
3-1107976969
Diaskhan
2005-02-09 22:22
2005.03.13
базы


4-1107184514
ANB
2005-01-31 18:15
2005.03.13
Управление другими приложениями


1-1108919240
Sicilla
2005-02-20 20:07
2005.03.13
XP Manifest


3-1108024003
REA
2005-02-10 11:26
2005.03.13
SQL Запрос


3-1107933130
Scorpio
2005-02-09 10:12
2005.03.13
ADOTable - ошибка при подключении





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