[Kotser]

Хех...

Код:

var PixelsX, PixelsY:integer;
    PrinterCoordX, PrinterCoordY:integer;
begin
   PixelsX:=GetDeviceCaps(printer.Handle, LogPixelsX);
   PixelsY:=GetDeviceCaps(printer.Handle, LogPixelsY);
   PrinterCoordX:=round(PixelsX/25.4*15);
   PrinterCoordY:=round(PixelsY/25.4*11.7);
   image2.Canvas.Rectangle(0,0, PrinterCoordX, PrinterCoordY);

   {Form1.масшатб: poProportional установлен}
   Form1.Print;
end;

Админ: Пользуемся тегами при оформлении кода!

15см на 11.7 см, принтер не печатает прямоугольник с такими размерами. Что я делаю не так?

[lmikle]

И не будет, т.к. разрешение и dpi у экрана и принтера разные. Тебе надо картинку рисовать прямо на канве принтера.
Приду домой, если не забуду - скину пример как это делается.

[lmikle]

Вот кое какие куски:

Код:

procedure TPrintForm.GetPrinterInfo;

  function GetSizeMM(ALengthPX, AResolutionDPI : Integer) : Integer;
  begin
    Result := Round(ALengthPX / (AResolutionDPI / MM_IN_INCH));
  end;

begin
  // Paper width and height in mm
  FPaperWidthMM := GetDeviceCaps(Printer.Handle,HORZSIZE);
  FPaperHeightMM := GetDeviceCaps(Printer.Handle,VERTSIZE);

  // Horizontal and Vertical resolution
  FHResolutionDPI := GetDeviceCaps(Printer.Handle,LOGPIXELSX);
  FVResolutionDPI := GetDeviceCaps(Printer.Handle,LOGPIXELSY);

  // Paper width and height in pixels
  FPaperWidthPX := GetDeviceCaps(Printer.Handle,PHYSICALWIDTH);
  FPaperHeightPX := GetDeviceCaps(Printer.Handle,PHYSICALHEIGHT);

  // Horizontal and vertical offset in pixels
  FHOffsetPX := GetDeviceCaps(Printer.Handle,PHYSICALOFFSETX);
  FVOffsetPX := GetDeviceCaps(Printer.Handle,PHYSICALOFFSETY);

  // Fill info about printer
  lbPaperSizeVal.Caption := Format('%dx%d mm',[GetSizeMM(FPaperWidthPX,FHResolutionDPI),GetSizeMM(FPaperHeightPX,FVResolutionDPI)]);
  If FHResolutionDPI = FVResolutionDPI
    Then lbResolutionVal.Caption := Format('%d dpi',[FHResolutionDPI])
    Else lbResolutionVal.Caption := Format('%dx%d dpi',[FHResolutionDPI,FVResolutionDPI]);
  Case Printer.Orientation Of
    poPortrait : lbOrientationVal.Caption := 'Portrait';
    poLandscape : lbOrientationVal.Caption := 'Landscape';
    Else lbOrientationVal.Caption := '';
  End;
end;

procedure TSinglePrintForm.PrintContent;
var
  X, Y : Integer;
  ARect : TRect;
  ABitmap : TBitmap;
  AWidthPX, AHeightPX : Integer;
begin
  Try
    Screen.Cursor := crHourGlass;
    ABitmap := TBitmap.Create;
    Try
      AWidthPX := Round(FWidthMM * HResolutionDPI / MM_IN_INCH);
      AHeightPX := Round(FHeightMM * VResolutionDPI / MM_IN_INCH);

      ABitmap.PixelFormat := pf24Bit;
      ABitmap.Width := AWidthPX;
      ABitmap.Height := AHeightPX;

      ABitmap.Canvas.Brush.Color := clWhite;
      ABitmap.Canvas.Brush.Style := bsSolid;
      ABitmap.Canvas.FillRect(Rect(0,0,AWidthPX,AHeightPX));

      Case rgFitMode.ItemIndex Of
        0 : // Fit
          ARect := GetFitDrawRect(AWidthPX,AHeightPX,FGraphic);
        1 : // Crop
          ARect := GetCropDrawRect(AWidthPX,AHeightPX,FGraphic);
        2 : // Stretch
          ARect := Rect(0,0,AWidthPX,AHeightPX);
      End;
      ABitmap.Canvas.StretchDraw(ARect,FGraphic);

      Printer.Title := ExtractFileName(FFileName);
      Printer.BeginDoc;
      Try
        X := Round((PaperWidthPX - AWidthPX)/2);
        Y := Round((PaperHeightPX - AHeightPX)/2);
        BltTBitmapAsDib(Printer.Handle,X,Y,AWidthPX,AHeightPX,ABitmap);

        If cbDrawFrame.Checked Then
          With Printer.Canvas Do
            Begin
              Pen.Color := clBlack;
              Pen.Style := psSolid;
              MoveTo(X,Y);
              LineTo(X+AWidthPX,Y);
              LineTo(X+AWidthPX,Y+AHeightPX);
              LineTo(X,Y+AHeightPX);
              LineTo(X,Y);
            End;
      Finally
        Printer.EndDoc;
      End;
    Finally
      ABitmap.Free;
      Screen.Cursor := crDefault;
    End;
  Except
    On E : Exception Do
      Win7MessageDlg('Error printing image.',E.Message,mtError,[mbOK]);
  End;
end;

[Kotser]

Спасибо. Но какой большой код, однако. "кое-какие куски"...
Я думал всё будет проще. Круто.

[lmikle]

Ну дык я из проекта просто пару кусочков выдернул.
Там тебе, в основном, можно смотреть где идеи конкретно печать плюс расчет некоторых размеров и как они получаются от принтера.
FWidthMM и FHeightMM - берутся из интерфейса в милиметрах (там выбор из списка или ввод вручную). Остальное - собственно пересчеты и рисование.

[Kotser]

Ясно. будем грызть)))