?? frmmain.frm
字號:
If Map.Layers.Count = 0 Then
MsgBox "當(dāng)前地圖中沒有加載任何圖層!"
Exit Sub
End If
CommonDialog.CancelError = True
CommonDialog.Filter = "*.gst|*.gst"
CommonDialog.ShowSave
sFilePath = CommonDialog.FileName
If Trim(sFilePath) <> "" Then
sFileName = clsPublic.GetFileNamefromPath(sFilePath)
Map.SaveMapAsGeoset "", sFilePath
StatusBar.Panels(1).Text = sFilePath
End If
End Sub
Private Sub mnuPartsAdd_Click()
Map.CurrentTool = miSelectTool
Map.FeatureEditMode = miEditModeAddNode + miEditModeNode
If Not clsPublic.g_bSnaped Then
mnuViewNodeSnap_Click
End If
If Not m_bShowLayerNodes Then
mnuViewShowNodes_Click
End If
Map.SnapToNodeSupport = True
End Sub
Private Sub mnuPartsEdit_Click()
Map.CurrentTool = miSelectTool
Map.FeatureEditMode = miEditModeNode
If Not clsPublic.g_bSnaped Then
mnuViewNodeSnap_Click
End If
If Not m_bShowLayerNodes Then
mnuViewShowNodes_Click
End If
Map.SnapToNodeSupport = True
End Sub
Private Sub mnuSelectbyCircle_Click()
Map.CurrentTool = miRadiusSelectTool
Map.FeatureEditMode = miEditModeFeature
If clsPublic.g_bSnaped Then
Map.SnapToNodeSupport = True
Else
Map.SnapToNodeSupport = False
End If
End Sub
Private Sub mnuSelectbyMaquee_Click()
Map.CurrentTool = miRectSelectTool
Map.FeatureEditMode = miEditModeFeature
If clsPublic.g_bSnaped Then
Map.SnapToNodeSupport = True
Else
Map.SnapToNodeSupport = False
End If
End Sub
Private Sub mnuSelectbyPoint_Click()
Map.CurrentTool = miSelectTool
' If clsPublic.g_bSnaped Then
' Map.SnapToNodeSupport = True
' Else
' Map.SnapToNodeSupport = False
' End If
End Sub
Private Sub mnuSelectbyPolygon_Click()
Map.CurrentTool = miPolygonSelectTool
Map.FeatureEditMode = miEditModeFeature
If clsPublic.g_bSnaped Then
Map.SnapToNodeSupport = True
Else
Map.SnapToNodeSupport = False
End If
End Sub
Private Sub mnuSelectI_Click()
m_bIQuery = True
mnuSelectI.Checked = Not mnuSelectI.Checked
If mnuSelectI.Checked Then
Toolbar.Buttons(11).value = tbrPressed
Else
Toolbar.Buttons(11).value = tbrUnpressed
End If
Map.CurrentTool = miSelectTool
Map.FeatureEditMode = miEditModeFeature
If clsPublic.g_bSnaped Then
Map.SnapToNodeSupport = True
Else
Map.SnapToNodeSupport = False
End If
End Sub
Private Sub mnuSelectLocateFeatures_Click()
Set Map.Bounds = Map.Layers.Bounds
End Sub
Private Sub mnuSelectShowFeatures_Click()
frmShowFeatures.Show 1, Me
End Sub
Private Sub mnuTablePacking_Click()
If Map.Layers.Count > 0 Then
frmPackOption.Show vbModal, Me
Else
MsgBox "當(dāng)前地圖中沒有加載圖層,無法執(zhí)行該操作!"
End If
End Sub
Private Sub mnuThemeLabel_Click()
Dim oLayer As MapXLib.Layer
Dim oDS As MapXLib.Dataset
End Sub
Private Sub mnuViewCoord_Click()
Map.DisplayCoordSys.PickCoordSys
End Sub
Private Sub mnuViewCursorCoord_Click()
clsPublic.g_bShowCursorCoord = Not clsPublic.g_bShowCursorCoord
If clsPublic.g_bShowCursorCoord Then
StatusBar.Panels.Add 2, "CoordPanel", ""
If StatusBar.Panels.Count = 2 Then
StatusBar.Panels(1).Width = StatusBar.Width * 0.6
StatusBar.Panels(2).Width = StatusBar.Width * 0.4
Else
StatusBar.Panels(1).Width = StatusBar.Width * 0.4
StatusBar.Panels(2).Width = StatusBar.Width * 0.4
StatusBar.Panels(3).Width = StatusBar.Width * 0.2
End If
Else
StatusBar.Panels.Remove 2
If StatusBar.Panels.Count = 1 Then
StatusBar.Panels(1).Width = StatusBar.Width
Else
StatusBar.Panels(1).Width = StatusBar.Width * 0.7
StatusBar.Panels(2).Width = StatusBar.Width * 0.3
End If
End If
mnuViewCursorCoord.Checked = clsPublic.g_bShowCursorCoord
End Sub
Private Sub mnuViewLayerCtrl_Click()
Map.PropertyPage
End Sub
Private Sub mnuViewNodeSnap_Click()
clsPublic.g_bSnaped = Not clsPublic.g_bSnaped
Map.SnapTolerance = m_iSnapTolerance
If clsPublic.g_bSnaped Then
If StatusBar.Panels.Count = 1 Then
StatusBar.Panels.Add 2, "InfoPanel", ""
StatusBar.Panels(2).Text = "捕捉節(jié)點"
StatusBar.Panels(1).Width = StatusBar.Width * 0.8
StatusBar.Panels(2).Width = StatusBar.Width * 0.2
Else
StatusBar.Panels.Add 3, "InfoPanel", ""
StatusBar.Panels(3).Text = "捕捉節(jié)點"
StatusBar.Panels(1).Width = StatusBar.Width * 0.4
StatusBar.Panels(2).Width = StatusBar.Width * 0.4
StatusBar.Panels(3).Width = StatusBar.Width * 0.2
End If
Else
If StatusBar.Panels.Count = 2 Then
StatusBar.Panels.Remove 2
StatusBar.Panels(1).Width = StatusBar.Width
Else
StatusBar.Panels.Remove 3
StatusBar.Panels(1).Width = StatusBar.Width * 0.7
StatusBar.Panels(2).Width = StatusBar.Width * 0.3
End If
End If
mnuViewNodeSnap.Checked = clsPublic.g_bSnaped
End Sub
Private Sub mnuViewOption_Click()
frmOptions.Show vbModal, Me
End Sub
Private Sub mnuViewPan_Click()
Map.CurrentTool = miPanTool
End Sub
Private Sub mnuViewShowNodes_Click()
m_bShowLayerNodes = Not m_bShowLayerNodes
If m_bShowLayerNodes Then
If Trim(m_sEditLayerName) <> "" Then
Map.Layers(Trim(m_sEditLayerName)).ShowNodes = True
End If
Else
If Trim(m_sEditLayerName) <> "" Then
Map.Layers(Trim(m_sEditLayerName)).ShowNodes = False
End If
End If
mnuViewShowNodes.Checked = m_bShowLayerNodes
End Sub
Private Sub mnuViewZoomIn_Click()
Map.CurrentTool = miZoomInTool
End Sub
Private Sub mnuViewZoomOut_Click()
Map.CurrentTool = miZoomOutTool
End Sub
Private Sub RefreshcbLayers(ByRef combobox As combobox, ByVal Map As MapXLib.Map, ByVal sLayerName As String)
On Error Resume Next
Dim i As Integer
Dim iSelected As Integer
combobox.Clear
iSelected = 0
For i = 1 To Map.Layers.Count
combobox.AddItem Map.Layers(i)
If StrComp(sLayerName, Map.Layers(i).Name, vbTextCompare) = 0 Then
iSelected = i - 1
End If
Map.Layers(i).Editable = False
Next i
If combobox.ListCount <> 0 Then
combobox.ListIndex = iSelected
Set Map.Layers.InsertionLayer = Map.Layers(iSelected + 1)
Map.Layers(iSelected + 1).Editable = True
End If
End Sub
Private Sub mnuZoomtoLayer_Click()
If Map.Layers.Count > 0 Then
frmSelectLayer.Show vbModal, frmMain
If m_sLayerName <> "" Then
If m_sLayerName = "所有圖層" Then
Set Map.Bounds = Map.Layers.Bounds
Else
Set Map.Bounds = Map.Layers(m_sLayerName).Bounds
End If
End If
End If
End Sub
Private Sub OpenTxtFile(ByVal sFileName As String)
Dim sWinDir As String
Dim sHelpFilePath As String
Const MAX_PATH = 260
On Error Resume Next
'構(gòu)造幫助文件的全路徑名
If Right(App.Path, 1) = "\" Then
sHelpFilePath = App.Path & sFileName
Else
sHelpFilePath = App.Path & "\" & sFileName
End If
'如果找到了幫助文件
If Dir(sHelpFilePath) <> "" Then
'獲得Windows操作系統(tǒng)的安裝路徑
sWinDir = Space(MAX_PATH)
GetWindowsDirectory sWinDir, MAX_PATH
sWinDir = Trim(sWinDir)
'調(diào)用記事本顯示幫助文件
Shell Left(sWinDir, Len(sWinDir) - 1) & "\notepad.exe '" & _
sHelpFilePath & "'", vbNormalFocus
End If
End Sub
Private Sub RotateFeaturebyAngle(ByRef oFtr As MapXLib.Feature, ByVal dblCenterX As Double, ByVal dblCenterY As Double, ByVal dblRotate As Double)
On Error Resume Next
Dim oPnt As MapXLib.Point
Dim oPnts As MapXLib.Points
Dim iCenterX As Double
Dim iCenterY As Double
' iCenterX = oFtr.CenterX
' iCenterY = oFtr.CenterY
iCenterX = dblCenterX
iCenterY = dblCenterY
For Each oPnts In oFtr.Parts
For Each oPnt In oPnts
Select Case dblRotate
Case 90
oPnt.Set iCenterX + oPnt.Y - iCenterY, iCenterY + iCenterX - oPnt.X
Case 180
oPnt.Set iCenterX - (oPnt.X - iCenterX), iCenterY - (oPnt.Y - iCenterY)
Case 270
oPnt.Set iCenterX - (oPnt.Y - iCenterY), iCenterY + (oPnt.X - iCenterX)
End Select
Next oPnt
Next oPnts
End Sub
Private Sub RotateFeaturebyLine(ByRef oFtr As MapXLib.Feature, ByVal dblCenterX As Double, ByVal dblCenterY As Double, ByVal dblMapX As Double, ByVal dblMapY As Double)
On Error Resume Next
Dim oPnt As MapXLib.Point
Dim oPnts As MapXLib.Points
Dim dblX As Double
Dim dblY As Double
Dim l1 As Double
Dim l2 As Double
Dim l3 As Double
For Each oPnts In oFtr.Parts
For Each oPnt In oPnts
l1 = Abs(Sqr((oPnt.X - dblCenterX) * (oPnt.X - dblCenterX) + (oPnt.Y - dblCenterY) * (oPnt.Y - dblCenterY)))
l2 = Abs(Sqr((dblMapX - dblCenterX) * (dblMapX - dblCenterX) + (dblMapY - dblCenterY) * (dblMapY - dblCenterY)))
dblX = dblCenterX + (((oPnt.X - dblCenterX) * (dblMapY - dblCenterY) + (oPnt.Y - dblCenterY) * (dblMapX - dblCenterX)) / l2)
dblY = dblCenterY + (((oPnt.Y - dblCenterY) * (dblMapY - dblCenterY) - (oPnt.X - dblCenterX) * (dblMapX - dblCenterX)) / l2)
oPnt.Set dblX, dblY
Next oPnt
Next oPnts
End Sub
Private Sub Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
mnuSelectI.Checked = False
Select Case Button.Index
Case 1
mnuFileAddTAB_Click
Case 2
mnuFileOpenGST_Click
Case 3
mnuFileSaveas_Click
Case 5
mnuViewPan_Click
Case 6
mnuViewZoomIn_Click
Case 7
mnuViewZoomOut_Click
Case 8
mnuZoomtoLayer_Click
Case 9
mnuViewLayerCtrl_Click
Case 11
mnuSelectI_Click
Case 12
mnuSelectbyPoint_Click
Case 13
mnuSelectbyMaquee_Click
Case 14
mnuSelectbyCircle_Click
Case 15
mnuSelectbyPolygon_Click
End Select
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -