[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;