⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dotask.bas

📁 用于河南省主体功能区区划的一个小地理信息系统
💻 BAS
字号:
Attribute VB_Name = "dotaskcode"
Public Sub doTask(buttonKey As String)
On Error Resume Next
    '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 frmmain.Map1.Layers.Count > 0 And frmmain.legend1.getActiveLayer > -1 Then
 '     Set g_activelayer = frmmain.Map1.Layers(frmmain.legend1.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"
   '     Call Frmfind.showfrmfieldset
    '    Frmfind.ZOrder 0
   ' Case "query"
   '     Call frmquery.filllvwfield
   '     frmquery.ZOrder 0
    Case "movelast"
        If M_K > 1 Then
             Set frmmain.Map1.Extent = M_extent.Item(M_K - 1)
            M_K = M_K - 1
            frmmain.mnuviewnext.Enabled = True
            frmmain.Toolbar1.Buttons("movenext").Enabled = True
            If M_K <= 1 Then
            frmmain.mnuviewlast.Enabled = False
            frmmain.Toolbar1.Buttons("movelast").Enabled = False
            End If
        End If
  
    Case "movenext"
        If M_K < M_extent.Count Then
            Set frmmain.Map1.Extent = M_extent.Item(M_K + 1)
            M_K = M_K + 1
            frmmain.mnuviewlast.Enabled = True
            frmmain.Toolbar1.Buttons("movelast").Enabled = True
           If M_K >= M_extent.Count Then
               frmmain.mnuviewnext.Enabled = False
            frmmain.Toolbar1.Buttons("movenext").Enabled = False
            End If
       End If
 '    Case "clear selection"
  '      For i = 1 To querynamestr.Count
   '     If g_activelayer.Name = querynamestr(i) Then
    '        querynamestr.Remove g_activelayer.Name
     '       querystr.Remove g_activelayer.Name
      '      queryrecs.Remove g_activelayer.Name
       '     Exit For
        'End If
      ''  Next i
   '     queryenable = True
    '    frmmain.Map1.TrackingLayer.Refresh True
        
    Case "full extent"
     ' If frmmain.map_index = 1 Then
            frmmain.Map1.Extent = frmmain.Map1.FullExtent
    '  Else
     '       frmmain.Map3.Extent = frmmain.Map3.FullExtent
    '  End If
        Dim mapextent As New MapObjects2.Rectangle
        Set mapextent = frmmain.Map1.Extent
      If M_extent.Count < 5 Then
            M_extent.Add mapextent
        Else
            M_extent.Remove 1
            M_extent.Add mapextent
        End If
        M_K = M_extent.Count
        frmmain.mnuviewlast.Enabled = True
        frmmain.Toolbar1.Buttons("movelast").Enabled = True
  '  Case "layer extent"
   '   If g_activelayer Is Nothing Then
    '    MsgBox "当前没有活动图层!", vbCritical
     '   Exit Sub
    '  End If
      
  '    frmmain.Map1.Extent = g_activelayer.Extent

   '   Set mapextent = frmmain.Map1.Extent
    '    If M_extent.Count < 5 Then
     '       M_extent.Add mapextent
    '    Else
     '       M_extent.Remove 1
      '      M_extent.Add mapextent
     '   End If
      '  M_K = M_extent.Count
     '   frmmain.mnuviewlast.Enabled = True
     '   frmmain.Toolbar1.Buttons("movelast").Enabled = True
    '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"
   '   frmmain.Toolbar2.Visible = True
   '   frmmain.Toolbar2.ZOrder 0
    '  frmmain.Toolbar2.Refresh
     ' If frmmain.map_index = 1 Then
        frmmain.Map1.MousePointer = moCross
      'Else
       ' frmmain.Map3.MousePointer = moCross
      'End If
 '   Case "spatial select"
  '    If frmmain.Map1.Layers.Count > 0 Then
   '     Unload frmSpatial  'Do unload to make sure it runs through load procedure
    '    frmSpatial.Show
     '   frmmain.Map1.MousePointer = moArrow
   '   End If
     ' If frmmain.Toolbar2.Visible = True Then frmmain.Toolbar2.Visible = False
      
    Case "zoom in"
     ' If frmmain.Toolbar2.Visible = True Then frmmain.Toolbar2.Visible = False
    '  If frmmain.map_index = 1 Then
        frmmain.Map1.MousePointer = moZoomIn
    '  Else
     '   frmmain.Map3.MousePointer = moZoomIn
     ' End If
    Case "zoom out"
    '  If frmmain.Toolbar2.Visible = True Then frmmain.Toolbar2.Visible = False
   '   If frmmain.map_index = 1 Then
        frmmain.Map1.MousePointer = moZoomOut
    '  Else
     '   frmmain.Map3.MousePointer = moZoomOut
     ' End If
    Case "pan"
     ' If frmmain.Toolbar2.Visible = True Then frmmain.Toolbar2.Visible = False
     ' If frmmain.map_index = 1 Then
        frmmain.Map1.MousePointer = moPan
     ' Else
      '  frmmain.Map3.MousePointer = moPan
     ' End If
'    Case "refresh"
    Case "measure"
      ' If frmmain.Toolbar2.Visible = True Then frmmain.Toolbar2.Visible = False
      ' If frmmain.map_index = 1 Then
        frmmain.Map1.MousePointer = moArrow
       'Else
        'frmmain.Map3.MousePointer = moArrow
      ' End If
    Case "measureA"
      ' If frmmain.Toolbar2.Visible = True Then frmmain.Toolbar2.Visible = False
       'If frmmain.map_index = 1 Then
        frmmain.Map1.MousePointer = moArrow
      ' Else
       ' frmmain.Map3.MousePointer = moArrow
      ' End If
    Case "identify"
    '  If frmmain.Toolbar2.Visible = True Then frmmain.Toolbar2.Visible = False
      frmmain.Map1.MousePointer = moIdentify
    Case "label"
     ' If frmmain.Toolbar2.Visible = True Then frmmain.Toolbar2.Visible = False
      frmmain.Map1.MousePointer = moLabel
    Case "select"
     ' If frmmain.map_index = 1 Then
        frmmain.Map1.MousePointer = moArrow
    '  Else
     '   frmmain.Map3.MousePointer = moArrow
     ' End If
  '  Case "about"
   '   frmIntro.Show
              
    End Select
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -