📄 dotask.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 + -