阅读:2681回复:3
程序中如何实现比例尺的动态显示
一个很好的例子,没有改成中文说明,请大家看看。
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 |
|
1楼#
发布于:2003-08-11 10:23
接受建议
多谢,以后尽力做到,只是时间匆忙,有的时候身不由己 |
|
2楼#
发布于:2003-08-08 14:02
老兄真够热心的 。。。让偶等崇拜不已:)
不过我觉得能将思路(问题解决的方法)先声明出来,效果会更好 |
|
|
3楼#
发布于:2003-08-01 12:22
为了先凑够帖子,大家别怪我:)
顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶 顶顶顶顶顶顶 顶顶顶顶顶顶顶顶顶顶 顶顶顶 顶顶顶顶顶 顶顶顶顶顶顶 顶顶顶顶顶顶顶 顶顶顶顶 顶顶顶顶顶 顶顶顶顶顶 顶顶顶顶顶顶顶顶顶 顶顶顶顶 顶顶顶顶 顶顶顶顶 顶顶顶顶顶顶顶顶顶顶顶顶 顶 顶顶 顶顶 顶顶 顶 顶顶顶顶顶顶顶顶顶顶 顶顶顶 顶顶 顶 顶顶顶顶顶 顶顶顶顶顶顶顶顶顶 顶顶顶 顶顶顶顶 顶顶顶顶 顶顶顶顶顶顶顶顶顶顶 顶 顶 顶顶顶顶顶 顶顶顶顶顶顶顶 顶顶顶顶顶顶顶顶顶 顶 顶 顶顶 顶顶 顶 顶顶顶顶顶顶顶顶顶 顶顶顶顶 顶顶顶顶 顶 顶顶 顶顶顶顶顶顶顶顶 顶 顶 顶顶顶顶 顶顶顶顶顶 顶顶顶顶顶顶顶顶 顶 顶顶 顶 顶顶顶顶 顶顶顶顶 顶顶顶顶顶顶 顶顶 顶顶顶顶顶 顶顶顶顶 顶顶顶 顶顶 顶顶顶顶 顶 顶顶 顶顶 顶顶顶顶 顶 顶顶顶顶 顶顶顶顶顶 顶顶顶 顶顶顶顶 顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶顶 |
|
|