main.frm

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

      Begin VB.Menu mnuView_MapProperties 
         Caption         =   "&Map Properties..."
      End
      Begin VB.Menu mnuView_Sep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuView_FullExtent 
         Caption         =   "&Full Extent"
      End
      Begin VB.Menu mnuView_ZoomIn 
         Caption         =   "Zoom &In"
      End
      Begin VB.Menu mnuView_ZoomOut 
         Caption         =   "Zoom &Out"
      End
      Begin VB.Menu mnuView_Pan 
         Caption         =   "&Pan"
      End
      Begin VB.Menu mnuView_Sep3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuView_Identify 
         Caption         =   "I&dentify"
      End
      Begin VB.Menu mnuView_Graphics 
         Caption         =   "&Draw Graphics"
      End
      Begin VB.Menu mnuClearGraphics 
         Caption         =   "&Clear Graphics"
      End
      Begin VB.Menu mnuView_SpatialSelect 
         Caption         =   "&Spatial Select..."
      End
   End
   Begin VB.Menu mnuLayers 
      Caption         =   "&Layers"
      Begin VB.Menu mnuAddLayer 
         Caption         =   "&Add Layer..."
      End
      Begin VB.Menu mnuAddSDELayer 
         Caption         =   "Add &SDE Layer..."
      End
      Begin VB.Menu mnuRemoveLayer 
         Caption         =   "&Remove Active Layer"
      End
      Begin VB.Menu mnuRemoveAllLayers 
         Caption         =   "Remove All Layers"
      End
      Begin VB.Menu mnuLegendEditor 
         Caption         =   "&Legend Editor..."
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuHelp_About 
         Caption         =   "&About..."
      End
      Begin VB.Menu mnuActive 
         Caption         =   "Which is active?"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
'  ********************* VERY IMPORTANT *************************
'  *                                                            *
'  * PLEASE TAKE A MOMENT TO READ THE FILE...                   *
'  *    <MapObjects folder>\samples\vb\moView2\README_FIRST.TXT *
'  *                                                            *
'  * ...FOR INFORMATION REGARDING THE USE AND TROUBLESHOOTING   *
'  * OF THIS moView2 SAMPLE APPLICATION                         *
'  *                                                            *
'  **************************************************************
'
' moView2 is an unsupported sample application for MapObjects
' version 2.0.  It demonstrates much of MapObjects' functionality
' within a simple application framework.
'
' You may use the Visual Basic code in moView2 to jump-start
' your application development and for guidance on solving some
' practical interface issues when designing a graphical user
' interface for mapping.
'
' Some of moView2 is documented in the book "Building
' Applications with MapObjects 2.0" which is provided with
' your MapObjects distribution.
'
' Written by Michael Zeiler and Larry Young, January - April 1996.
' Updated for MapObjects 1.1, MZ, November 1996.
' Updated for MapObjects 2.0 / Visual Basic 6.0, Jim Barry, February 1999.
' Environmental Systems Research Institute, Inc.
' www.esri.com


'The active layer and the coordinate system units
'of the map are information that need to be known
'to many of the modules within this project, hence
'they are public.
Public g_ActiveLayer As Object
Public strMapUnits As String

Private collGtextStrings As New VBA.Collection
Private collGtextPoints As New VBA.Collection
Private symGtext As New mapobjects2.TextSymbol
Private m_mapTip As New clsMapTip
Private dropValid As Boolean
Private BarState As String

Private Const MIN_LEGEND_WIDTH = 350
Private Const INCH2FEET = 12
Private Const INCH2METERS = 39.37
Private Const INCH2DEGREES = 4322893.46

'
'******************************************************************************************************************************************
'   FORM-RELATED ACTIVITY
'******************************************************************************************************************************************
'

Private Sub Form_Load()

  Dim i As Integer
  
  'Display the splash screen as MODAL - frmIntro
  frmIntro.Show vbModal

  'Position the Main form to the upper left of the screen
  Me.Top = 0
  Me.Left = 0
  
  'Only show the Graphic draw toolbar if the Graphic button is selected.
  barGraphics.Visible = False
  
  'The map units begin as "Unknown" until the user declares
  'this property on the MapProperties form.
  strMapUnits = "Unknown"
  
  'Initialize TrackingLayer symbols
  Dim tl As mapobjects2.TrackingLayer
  Set tl = mapDisp.TrackingLayer
  With tl
    .SymbolCount = 3
    .Symbol(0).SymbolType = moPointSymbol
    .Symbol(0).style = moTriangleMarker
    .Symbol(0).color = moRed
    .Symbol(0).Size = 4
    .Symbol(1).SymbolType = moLineSymbol
    .Symbol(1).style = moSolidLine
    .Symbol(1).color = moRed
    .Symbol(1).Size = 2
    .Symbol(2).SymbolType = moFillSymbol
    .Symbol(2).style = moTransparentFill
    .Symbol(2).OutlineColor = moRed
    .Symbol(2).Size = 2
  End With
  
  'Bring the map tip controls to the top.
  picMapTip.ZOrder 0
  lblMapTip.ZOrder 0
  
  'Initialize the splitter between the legend and map
  picSplitter.BackColor = frmMain.BackColor
  legMapDisp.ZOrder 0
  mapDisp.ZOrder 0
  
  'Initialize MapTip class (used in Identify tool)
  m_mapTip.Initialize mapDisp, tmrMapTip, picMapTip, lblMapTip
  
  'Insert pre-loaded data for user to see on startup.
  '  See modDataLoader (DataLoader.bas)
  Call DataLoader
 
  'Link legend to the Map control
  legMapDisp.setMapSource mapDisp
  legMapDisp.LoadLegend True
  legMapDisp.ShowAllLegend
  legMapDisp.Active(0) = True
  
  'Set the variable holding theb status of the ToolBar to ""
  BarState = ""
End Sub

Private Sub Form_Resize()
  'This procedure resizes the map when the form is resized.
  Dim border As Double, sideBorder As Double
  Dim topBorder As Double, statusbarHeight As Double
  
  ' Spacing of side borders
  border = 30
  ' Spacing down from top of form
  topBorder = 480
  'Spacing for graphics toolbar on side.
  sideBorder = mapDisp.Left
  
  'Spacing for status bar
  statusbarHeight = 400
  
  mapDisp.Top = topBorder
  mapDisp.Left = sideBorder
  If ScaleHeight > topBorder + border + statusbarHeight Then
    mapDisp.Height = ScaleHeight - topBorder - border - statusbarHeight
    picSplitter.Height = mapDisp.Height
  End If
  If ScaleWidth > (border * 2) + sideBorder Then
    mapDisp.Width = ScaleWidth - (border * 2) - sideBorder
  End If
  
  legMapDisp.Height = mapDisp.Height
  
  'Now reposition the MapTip controls (which do not otherwise
  'move with the StatusBar and Panels...
  Dim h As Long, w As Long
  h = frmMain.Height
  w = frmMain.Width
  chkTipLayer.Top = h - 975
  chkTipLayer.Left = w - 4800
  cboTipLayer.Top = h - 1035
  cboTipLayer.Left = w - 3840
  cboTipField.Top = h - 1035
  cboTipField.Left = w - 2580
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SDECon.Disconnect
    End
End Sub

'
'******************************************************************************************************************************************
'   BUTTON BAR FOR "DISPLAY" TOOLS
'******************************************************************************************************************************************
'

Private Sub barDisplay_ButtonClick(ByVal Button As Button)

  Dim bKey As String
  bKey = Button.Key
  Call doTask(bKey)
  BarState = bKey
  
End Sub

Public Sub doTask(buttonKey As String)

    'Gotta clean up some forms first...
    If frmIdentify.Visible Then
      Unload frmIdentify
    End If
    If frmSpatial.Visible Then
      Unload frmSpatial
    End If
    
    'Determine the legend's active layer
    If mapDisp.Layers.count > 0 And legMapDisp.getActiveLayer > -1 Then
      Set g_ActiveLayer = mapDisp.Layers(legMapDisp.getActiveLayer)
     Else
      Set g_ActiveLayer = Nothing
    End If
    
    'This block examines the return key from the toolbar or menu
    'and performs the requested action.
    Select Case buttonKey
    
    Case "Print"
      frmPrint.Show
      frmPrint.ZOrder 0
                
    Case "Map Properties"
      frmMapProperties.Show
      frmMapProperties.ZOrder 0
      
    Case "Find"
      frmFind.Show
      frmFind.ZOrder 0
        
    Case "Address matching"
      'Close any addressmatching forms that are open
      Dim i As Integer
      For i = (Forms.count - 1) To 0 Step -1
        If Forms(i).Name = "frmPlaceLocator" Or _
           Forms(i).Name = "frmGeocoder" Then
         Unload Forms(i)
        End If
      Next i
    
      'Ensure there is an active layer
      If g_ActiveLayer Is Nothing Then
        MsgBox "No active layers.", vbCritical
        Exit Sub
      End If
      
      'Ensure the active layer is a shapefile.  All shapefiles
      'added to the Map through the MapContents form get a Tag
      'which contains the string "[SHAPEFILE]" or "[SHAPEFILZ]"
      'appended to the the front of the source data's path string.
      If InStr(g_ActiveLayer.tag, "[SHAPEFIL") = 0 Then
        MsgBox "Active layer is not a shapefile.", vbCritical
        Exit Sub
      End If
      
      'if the active layer is a line layer, then open
      'the Geocoder form.  If it is a point or polygon
      'layer, then open the PlaceLocator form.
      If g_ActiveLayer.shapeType = moShapeTypeLine Then
        frmGeocoder.Show vbModeless
        frmGeocoder.ZOrder 0
       Else
        frmPlaceLocator.Show vbModeless
        frmGeocoder.ZOrder 0
      End If
      
    Case "Full extent"
      mapDisp.Extent = mapDisp.FullExtent
        
    Case "Layer extent"
      If g_ActiveLayer Is Nothing Then
        MsgBox "No active layers.", vbCritical
        Exit Sub
      End If
      mapDisp.Extent = g_ActiveLayer.Extent
      
    'Zoom in, Zoom out, Pan, Identify and Graphics are on the same button
    'command group. When graphics is pushed, then display the graphics toolbar
    'and refresh the map. Otherwise, make the graphics toolbar invisible.
    Case "Graphics"
      barGraphics.Visible = True
      barGraphics.ZOrder 0
      barGraphics.Refresh
      mapDisp.MousePointer = moCross
      
    Case "Spatial Select"
      If frmMain.mapDisp.Layers.count > 0 Then
        Unload frmSpatial  'Do unload to make sure it runs through load procedure
        frmSpatial.Show
        mapDisp.MousePointer = moArrow
      End If
      If barGraphics.Visible = True Then barGraphics.Visible = False
      
    Case "Zoom in"
      If barGraphics.Visible = True Then barGraphics.Visible = False
      mapDisp.MousePointer = moZoomIn
      
    Case "Zoom out"
      If barGraphics.Visible = True Then barGraphics.Visible = False
        mapDisp.MousePointer = moZoomOut
    
    Case "Pan"
      If barGraphics.Visible = True Then barGraphics.Visible = False
        mapDisp.MousePointer = moPan
    
    Case "Identify"
      If barGraphics.Visible = True Then barGraphics.Visible = False
      mapDisp.MousePointer = moIdentify
              
    Case "About"
      frmIntro.Show
              
    End Select

End Sub

'
'******************************************************************************************************************************************
'   MAP LEGEND
'******************************************************************************************************************************************
'

Private Sub legMapDisp_LayerDblClick(Index As Integer)

  'Double-click on a legend layer entry opens the legend
  'editor (frmLayerSymbol) for that layer.

  Set g_ActiveLayer = mapDisp.Layers(Index)
  
    If g_ActiveLayer.LayerType = moImageLayer Then
       MsgBox "Sorry, you cannot set properties for an image layer." & _
              vbCrLf & "Try setting properties for a layer with vector data."
       Exit Sub
    End If

  'Invoke property sheet for new layer.
  'Load frmLayerSymbol
  frmLayerSymbol.Show vbModal

End Sub



'
'******************************************************************************************************************************************
'   DYNAMIC RESIZER FOR THE MAP AND LEGEND
'******************************************************************************************************************************************
'

Private Sub picSplitter_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

'The picSplitter allow simultaneous resizing of the legend and map
'by grabbing and dragging the area between the two controls.
picSplitter.ZOrder 0
picSplitter.BackColor = 8421504  'dark-gray
picSplitter.Refresh

End Sub

Private Sub picSplitter_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

'The picSplitter allow simultaneous resizing of the legend and map
'by grabbing and dragging the area between the two controls.
If Button = 1 Then
  picSplitter.Left = picSplitter.Left + x - 50
  If picSplitter.Left > MIN_LEGEND_WIDTH Then
    picSplitter.Refresh
    frmMain.Refresh
   Else
    picSplitter.Left = MIN_LEGEND_WIDTH
    picSplitter_MouseUp Button, Shift, x, y
  End If
End If

End Sub

Private Sub picSplitter_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

'The picSplitter allow simultaneous resizing of the legend and map
'by grabbing and dragging the area between the two controls.
picSplitter.BackColor = frmMain.BackColor
legMapDisp.Width = legMapDisp.Left + picSplitter.Left
mapDisp.Left = picSplitter.Left + picSplitter.Width
mapDisp.Width = frmMain.Width - legMapDisp.Width - picSplitter.Width - 180
picSplitter.ZOrder 1

End Sub

Private Sub legMapDisp_AfterSetLayerVisible(Index As Integer, isVisible As Boolean)

mapDisp.Refresh

End Sub

'
'******************************************************************************************************************************************
'   MAP DISPLAY RELATED ACTIVITY
'******************************************************************************************************************************************
'

Private Sub mapDisp_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE)
  
If mapDisp.Layers.count > 0 Then
  frmSpatial.DrawSelectedFeatures (hDC)
  frmPlaceLocator.DrawLocatedPlaces (hDC)
  frmGeocoder.DrawLocatedPlace (hDC)
End If

Dim i As Long
If collGtextStrings.count > 0 Then