程序中如何实现比例尺的动态显示

一个很好的例子，没有改成中文说明，请大家看看。

Option Explicit
Private Const MILES_PER_DEGREE = 69.09
'

Private Sub ResetScaleBars()

'This is all much better done with the MapObjects
'Projection object classes and the Map control's
'FromMapDistance method.  But without using those
'tools, here is how to create X-axis and Y-axis
'scale bars.

Dim xMapExtentInDegrees As Double, yMapExtentInDegrees, yMapCenterInDegrees As Double
Dim xMapExtentInMiles As Double, yMapExtentInMiles As Double
Dim xFrameCenterInTwips As Double, yFrameCenterInTwips As Double
Dim xControlExtentInTwips As Double, yControlExtentInTwips As Double
Dim xScaleBarSizeInTwips As Double, yScaleBarSizeInTwips As Double

'Get the height, width, and centerY of the map in degrees.
xMapExtentInDegrees = Map1.Extent.Width
yMapExtentInDegrees = Map1.Extent.Height
yMapCenterInDegrees = Map1.Extent.Center.Y

'Calculate the height and width of the map in miles.
xMapExtentInMiles = xMapExtentInDegrees * (MILES_PER_DEGREE * ((90 - yMapCenterInDegrees) / 90))
yMapExtentInMiles = yMapExtentInDegrees * MILES_PER_DEGREE

'Get the height and width of the Map control display window on the form.
xControlExtentInTwips = Map1.Width
yControlExtentInTwips = Map1.Height

'Calculate the scale bar dimensions on the form equivalent to 10 map miles.
xScaleBarSizeInTwips = (10 / xMapExtentInMiles) * xControlExtentInTwips
yScaleBarSizeInTwips = (10 / yMapExtentInMiles) * yControlExtentInTwips

'Get the center of the scale bar frames.
xFrameCenterInTwips = frmX.Left + (frmX.Width / 2)
yFrameCenterInTwips = frmY.Top + (frmY.Height / 2)

'Resize the scale bars so that they are equivalent
'to the length of 10 miles on the map.
lnScaleX.X1 = xFrameCenterInTwips - (xScaleBarSizeInTwips / 2)
lnScaleX.X2 = xFrameCenterInTwips + (xScaleBarSizeInTwips / 2)
lnScaleY.Y1 = yFrameCenterInTwips - (yScaleBarSizeInTwips / 2)
lnScaleY.Y2 = yFrameCenterInTwips + (yScaleBarSizeInTwips / 2)

End Sub

Private Sub Command1_Click()

'Zoom the map back to full extent
Set Map1.Extent = Map1.FullExtent

End Sub

Private Sub Form_Load()

'Load shapefile as new layer
Dim dc As New MapObjects2.DataConnection
Dim mlyr As New MapObjects2.MapLayer
dc.Database = App.Path
dc.Connect
Set mlyr.GeoDataset = dc.FindGeoDataset("counties")
mlyr.Symbol.Color = moBlue
Map1.Layers.Add mlyr

'Zoom out a bit
Dim rect As MapObjects2.Rectangle
Set rect = Map1.FullExtent
rect.ScaleRectangle 1.1
Set Map1.FullExtent = rect
Set Map1.Extent = rect

Call ResetScaleBars

End Sub

Private Sub Map1_BeforeLayerDraw(ByVal index As Integer, ByVal hDC As stdole.OLE_HANDLE)

'Reset the scalebars only before the bottom layer draws.
If index = Map1.Layers.Count - 1 Then
  Call ResetScaleBars
End If

End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Select Case True
  Case Option1  'Pan
    Map1.Pan
  Case Option2  'Zoom in on user-dragged box
    Set Map1.Extent = Map1.TrackRectangle
  Case Option3  'Zoom out 20% on each axis
    Dim rect As MapObjects2.Rectangle
    Set rect = Map1.Extent
    rect.ScaleRectangle (1.2)
    Set Map1.Extent = rect
End Select

End Sub

为了先凑够帖子，大家别怪我：）

顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶
 顶顶顶顶顶顶　顶顶顶顶顶顶顶顶顶顶　顶顶顶　　顶顶顶顶顶
 顶顶顶顶顶顶　　　　顶顶顶顶顶顶顶　顶顶顶顶　顶顶顶顶顶
 顶顶顶顶顶　　　顶顶顶顶顶顶顶顶顶　顶顶顶顶　　顶顶顶顶
 顶顶顶顶　　顶顶顶顶顶顶顶顶顶顶顶顶　顶　　　顶顶　顶顶
 顶顶　　顶　顶顶顶顶顶顶顶顶顶顶　　顶顶顶　顶顶　　　顶
 顶顶顶顶顶　顶顶顶顶顶顶顶顶顶　　　顶顶顶　　　顶顶顶顶
 顶顶顶顶　　　顶顶顶顶顶顶顶顶顶顶　顶　　顶　顶顶顶顶顶
 顶顶顶顶顶顶顶　顶顶顶顶顶顶顶顶顶　　顶　　顶　　　顶顶
 顶顶　　　顶　　顶顶顶顶顶顶顶顶顶　顶顶顶顶　　顶顶顶顶
 顶　顶顶　　　顶顶顶顶顶顶顶顶　　　顶　　　顶　顶顶顶顶
 顶顶顶顶顶　　顶顶顶顶顶顶顶顶　顶　　顶顶　顶　顶顶顶顶
 顶顶顶顶　　　　顶顶顶顶顶顶　顶顶　顶顶顶顶顶　顶顶顶顶
 顶顶顶　　顶顶　　　顶顶顶顶　顶　　顶顶　顶顶　顶顶顶顶
 顶　　　顶顶顶顶　　　　顶顶顶顶顶　顶顶顶　　　顶顶顶顶
 顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶

老兄真够热心的 。。。让偶等崇拜不已：）
不过我觉得能将思路（问题解决的方法）先声明出来，效果会更好

多谢，以后尽力做到，只是时间匆忙，有的时候身不由己