На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > Печать TStringGrid , пример вывода грида на канву принтера
      ExpandedWrap disabled
        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,
             otalPrevH + 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.

      From DelphiWorld©
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


      Рейтинг@Mail.ru
      [ Script execution time: 0,0184 ]   [ 16 queries used ]   [ Generated: 19.03.24, 11:43 GMT ]