Печать изображений в правильном размере.

[Человек_Борща]

Доброго времени суток!

Не получается вывести картинку на принтер в истинном размере.
С Canvas простого TImage работает и получается что надо на принтере(печатаю канву этого Image).

А вот если выводить изображения на принтер, то эти изображения получаются очень и очень маленькими. Почему так?

Собственно код:
Так рисую сетку изображений на Canvas TImage:

 procedure TForm1.DrawBtnClick(Sender: TObject);
var
  iRow, iCol, iBorderSize, iImgDistance, iRows, iColumns,
  iLeft, iTop: Integer;
  bmp: TBitmap;
begin
  iBorderSize := StrToInt(BorderSizeEdit.Text);
  iImgDistance := StrToInt(ImgsDistanceEdit.Text);
  iRows := StrToInt(RowsCountEdit.Text);
  iColumns := StrToInt(ColCountEdit.Text);
  iRow := 0;
  iCol := 0;
  iLeft := iBorderSize;
  iTop := iBorderSize;
  bmp := TBitmap.Create;
  try
    bmp.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Source.bmp');
    with Img.Canvas do
    begin
      Brush.Color := clWhite;
      FillRect(Img.BoundsRect);

      for iRow := 1 to iRows do
      begin
        // Кальк. позицию строки
        if (iRow = 1) then
          iTop := iBorderSize
        else
          iTop := iBorderSize + (iImgDistance * (iRow - 1)) +
            (bmp.Height * (iRow - 1));

        // Кальк. позиции картинок в строке
        for iCol := 1 to iColumns do
        begin
          if (iCol = 1) then
            iLeft := iBorderSize
          else
            iLeft := iBorderSize + (iImgDistance * (iCol - 1)) +
              (bmp.Width * (iCol - 1));
          Draw(iLeft, iTop, bmp);
        end;
      end;
    end;
  finally
    FreeAndNil(bmp);
  end;
end;

Вот так печатаю:

procedure PrintImage(Image: TImage; ZoomPercent: Integer);
var
  relHeight, relWidth: Integer;

  procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap: TBitmap);
  var
    Header, Bits: Pointer;
    HeaderSize: DWORD;
    BitsSize: DWORD;
  begin
    GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
    Header := AllocMem(HeaderSize);
    Bits := AllocMem(BitsSize);
    try
      GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
      StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top, DestRect.Right,
        DestRect.Bottom, 0, 0, ABitmap.Width, ABitmap.Height, Bits,
        TBitmapInfo(Header^), DIB_RGB_COLORS, SRCCOPY);
    finally
      FreeMem(Header, HeaderSize);
      FreeMem(Bits, BitsSize);
    end;
  end;

begin
  Screen.Cursor := crHourglass;
  Printer.BeginDoc;
  with Image.Picture.Bitmap do
  begin
    if ((Width / Height) > (Printer.PageWidth / Printer.PageHeight)) then
    begin
      // Stretch Bitmap to width of PrinterPage
      relWidth := Printer.PageWidth;
      relHeight := MulDiv(Height, Printer.PageWidth, Width);
    end
    else
    begin
      // Stretch Bitmap to height of PrinterPage
      relWidth := MulDiv(Width, Printer.PageHeight, Height);
      relHeight := Printer.PageHeight;
    end;
    relWidth := Round(relWidth * ZoomPercent / 100);
    relHeight := Round(relHeight * ZoomPercent / 100);
    DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight),
      Image.Picture.Bitmap);
  end;
  Printer.EndDoc;
  Screen.Cursor := crDefault;
end;

procedure TForm1.PrintBtnClick(Sender: TObject);
begin
  PrintImage(Img, 100);
end;

Итог правильный: http://i49.fastpic.ru/big/2013/0801/...cb24bfa3d7.png

----

[Человек_Борща]

А вот попытка рисовать на Canvas принтера:

var
  i, iRow, iCol, iBorderSize,  iImgDistance, iRows,
  iColumns, iLeft, iTop: Integer;
  bmp: TBitmap;
  bStop, bRowDone, bColDone: Boolean;
  P: TPoint;

  function CalcY: Integer;
  begin
    if (iRow = 1) then
      Result := iBorderSize
    else
      Result := iBorderSize + (iImgDistance * (iRow - 1)) +
        (bmp.Height * (iRow - 1));
  end;

  function CalcX: Integer;
  begin
    if (iCol = 1) then
      Result := iBorderSize
    else
      Result := iBorderSize + (iImgDistance * (iCol - 1)) +
        (bmp.Width * (iCol - 1));
  end;

begin
  iBorderSize := StrToInt(BorderSizeEdit.Text);
  iImgDistance := StrToInt(ImgsDistanceEdit.Text);
  iRows := StrToInt(RowsCountEdit.Text);
  iColumns := StrToInt(ColCountEdit.Text);
  iRow := 1;
  iCol := 1;
  // Начальные значения координат рисования
  iLeft := iBorderSize;
  iTop := iBorderSize;
  bmp := TBitmap.Create;
  try
    bmp.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Source.bmp');
    Printer.BeginDoc;
    for i := 1 to 18 do
    begin
      if (iRow <= iRows) then
      begin
        iTop := CalcY;
        iLeft := CalcX;
        Printer.Canvas.Draw(iLeft, iTop, bmp);
        if not((iRow = iRows) and (iCol = iColumns)) then
        begin
          if (iCol = iColumns) then
          begin
            Inc(iRow);
            iCol := 1;
          end
          else
            Inc(iCol);
        end
        else
        begin
          ShowMessage('Новый лист!');
          Printer.NewPage;
          iRow := 1;
          iCol := 1;
        end;
      end;
    end;
    if Printer.Printing then
      Printer.EndDoc;

  finally
    FreeAndNil(bmp);
  end;
end;

Итог не правильный: http://i49.fastpic.ru/big/2013/0801/...81800713be.png

Где я ошибся?

Проект приложил.

[Человек_Борща]

Проблему решил, умножив размеры картинки на фактор DPI принтера:
<высота> * Фактор по оси Y div Пикселей на дюйм текущего экрана.
<ширина> * Фактор по оси X div Пикселей на дюйм текущего экрана.