ptsobj.cls

这个是grs源程序,mo在图象显示上很好,所以大家一定要下载

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPTSobj"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'This class provides "printing to scale" functionality
'
'No Property procedures due to the very basic nature
'of this class.  All four properties are exposed.
'The one single method is exposed.

Public MapControl As mapobjects2.map
Public MapUnits As String
Public RatioScale As Long
Public OneInchToUnits As Double

Public Sub PrintNow()

Dim PrinterWidth As Double
Dim PrinterHeight As Double
Dim MapWidth As Double
Dim MapHeight As Double
Dim TwipsPerPixX As Double
Dim TwipsPerPixY As Double
Dim OutputRectWidth As Double
Dim OutputRectHeight As Double
Dim ConversionFactor As Double
Dim PageOriginX As Double
Dim PageOriginY As Double

'Establish map units conversion factor
If MapUnits = "Feet" Then
 ConversionFactor = 12
    'number of inches in a foot
 ElseIf MapUnits = "Meters" Then
 ConversionFactor = 39.37
    'number of inches in a meter
 ElseIf MapUnits = "Decimal Degrees" Then
 ConversionFactor = 4322893.46
    'number of inches in an longitudinal
    'degree at the equator
 Else
 MsgBox "Map units property not correctly set." & vbCrLf & _
        "Set it as a string, FEET, METERS, or DD."
 Exit Sub
End If

'Ensure that MapControl property is set.
If MapControl Is Nothing Then
 MsgBox "Please set MapControl property before using" & vbCrLf & _
        "the PrintNow method."
 Exit Sub
End If

'Ensure that one of the two scale properties are set.
If RatioScale = 0 Then
 If OneInchToUnits = 0 Then
  MsgBox "Please set the RatioScale or OneInchToScale property" & vbCrLf & _
        "before using the PrintNow method."
   Exit Sub
  Else
   RatioScale = OneInchToUnits * ConversionFactor
 End If
End If

'Convert page units to inches
Printer.ScaleMode = vbInches

'Get this printer's Twips per Pixel value
TwipsPerPixX = Printer.TwipsPerPixelX
TwipsPerPixY = Printer.TwipsPerPixelY

'Get width and height of page in inches
PrinterWidth = Printer.ScaleWidth
PrinterHeight = Printer.ScaleHeight

'Convert ground map units into inches
MapWidth = MapControl.Extent.Width * ConversionFactor
MapHeight = MapControl.Extent.Height * ConversionFactor

'Calculate output rectangle
OutputRectWidth = MapWidth / RatioScale
OutputRectHeight = MapHeight / RatioScale

'Set the InchToUnits property
OneInchToUnits = RatioScale / ConversionFactor

'Check to ensure that the output rectangle
'is not too large for the printer page.  If it
'is, warn the user, then bail out.
If OutputRectWidth > PrinterWidth Then
  MsgBox "The scale you specified makes the map too wide for the printed page." & _
         vbCrLf & vbCrLf & _
         "Your printer is only " & Format(PrinterWidth, "#0.00") & " inches wide," & vbCrLf & _
         "but a scale of 1:" & RatioScale & " makes the map " & _
         Format(OutputRectWidth, "#0.00") & " inches wide."
  Exit Sub
  ElseIf OutputRectHeight > PrinterHeight Then
  MsgBox "The scale you specified makes the map too tall for the printed page." & _
         vbCrLf & vbCrLf & _
         "Your printer is only " & Format(PrinterHeight, "#0.00") & " inches tall," & vbCrLf & _
         "but a scale of 1:" & RatioScale & " makes the map " & _
         Format(OutputRectHeight, "#0.00") & " inches tall."
  Exit Sub
  Else
  Dim continueAnswer As Integer
  
  continueAnswer = MsgBox("DO YOU WISH TO CONTINUE?" & vbNewLine & _
          "Page Size: " & vbNewLine & _
          Format(PrinterWidth, "#0.00") & " inches wide" & vbNewLine & _
          Format(PrinterHeight, "#0.00") & " inches tall" & vbNewLine & vbNewLine & _
          "Printed map extent: " & vbNewLine & _
          Format(OutputRectWidth, "#0.00") & " inches wide" & vbNewLine & _
          Format(OutputRectHeight, "#0.00") & " inches tall" & vbNewLine & vbNewLine & _
          "RATIO SCALE" & vbNewLine & _
         "1:" & RatioScale & vbNewLine & vbNewLine & _
         "SCALE TO MAP UNITS" & vbNewLine & _
         "One inch equals " & Format(OneInchToUnits, "#0.00") & _
         " " & MapUnits, vbYesNo)
         
  If continueAnswer = 7 Then
    'MsgBox "Output process halted"
    Exit Sub
  End If
End If

'Center the output rectangle onto the page
PageOriginX = (PrinterWidth - OutputRectWidth) / 2
PageOriginY = (PrinterHeight - OutputRectHeight) / 2

'Convert all measurements into Printer Pixels
PageOriginX = (PageOriginX * 1440) / TwipsPerPixX
PageOriginY = (PageOriginY * 1440) / TwipsPerPixY
OutputRectWidth = (OutputRectWidth * 1440) / TwipsPerPixX
OutputRectHeight = (OutputRectHeight * 1440) / TwipsPerPixY

'Print the map
Printer.Print
MapControl.OutputMap2 Printer.hDC, _
                PageOriginX, PageOriginY, _
                OutputRectWidth, OutputRectHeight
Printer.EndDoc

End Sub