📄 mdiform.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.MDIForm MDIForm1
BackColor = &H8000000C&
Caption = "MapX "
ClientHeight = 3195
ClientLeft = 165
ClientTop = 735
ClientWidth = 6345
LinkTopic = "MDIForm1"
ScrollBars = 0 'False
StartUpPosition = 3 '窗口缺省
WindowState = 2 'Maximized
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 330
Left = 0
TabIndex = 0
Top = 2865
Width = 6345
_ExtentX = 11192
_ExtentY = 582
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 2
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 6175
MinWidth = 6175
Object.ToolTipText = "坐标点"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 4304
MinWidth = 4304
Object.ToolTipText = "编辑图层"
EndProperty
EndProperty
End
Begin MSComDlg.CommonDialog CM1
Left = 480
Top = 960
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Menu Openfile
Caption = "文件"
Begin VB.Menu LinkOracle
Caption = "打开Oracle数据源"
End
Begin VB.Menu Exit
Caption = "退出"
End
End
Begin VB.Menu FeatureDraw
Caption = "对象绘制"
Begin VB.Menu DrawFeature
Caption = "创建符号"
Index = 1
End
Begin VB.Menu DrawFeature
Caption = "创建文本"
Index = 2
End
Begin VB.Menu DrawFeature
Caption = "创建线段"
Index = 4
End
Begin VB.Menu DrawFeature
Caption = "创建折线"
Index = 5
End
Begin VB.Menu DrawFeature
Caption = "创建多边形"
Index = 12
End
End
Begin VB.Menu View
Caption = "视图"
Begin VB.Menu ControlLayer
Caption = "图层控制"
End
Begin VB.Menu ChangeView
Caption = "改变视野..."
Enabled = 0 'False
Visible = 0 'False
End
Begin VB.Menu Entirelayer
Caption = "全层显示"
End
Begin VB.Menu CreateLegend
Caption = "显示图例"
Enabled = 0 'False
Visible = 0 'False
End
End
Begin VB.Menu MapOption
Caption = "地图"
Begin VB.Menu SelectAll
Caption = "全选"
End
Begin VB.Menu PointSelect
Caption = "单点选择"
End
Begin VB.Menu RectSelect
Caption = "矩形选择"
End
Begin VB.Menu CircleSelect
Caption = "圆形选择"
End
Begin VB.Menu IrregularSelect
Caption = "不规则选择"
End
Begin VB.Menu PolygonSelect
Caption = "多边形选择"
Visible = 0 'False
End
Begin VB.Menu BufferSelect
Caption = "缓冲区选择"
Visible = 0 'False
End
Begin VB.Menu menu32
Caption = "-"
End
Begin VB.Menu UnselectAll
Caption = "全不选"
End
Begin VB.Menu menu33
Caption = "-"
End
Begin VB.Menu MapOpt
Caption = "地图选项"
Enabled = 0 'False
Visible = 0 'False
End
End
Begin VB.Menu Browser
Caption = "浏览"
Begin VB.Menu OpenBroswer
Caption = "打开浏览"
End
End
Begin VB.Menu Options
Caption = "选项"
Begin VB.Menu linestyle
Caption = "线样式..."
End
Begin VB.Menu regionstyle
Caption = "区域样式..."
End
Begin VB.Menu symbolstyle
Caption = "符号样式..."
End
Begin VB.Menu textstyle
Caption = "文本样式..."
End
Begin VB.Menu Option
Caption = "选项..."
End
End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub AddToGeoset_Click()
Dim lyrinfo As New MapXLib.LayerInfo
lyrinfo.Type = miLayerInfoTypeGeodictUserName
lyrinfo.AddParameter "name", Formmain.Map1.Layers.Item(1).name
Formmain.Map1.Layers.Add lyrinfo
End Sub
Private Sub ADOType_Click()
Dim bindlayer As New bindlayer
Dim conn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
'引用中加入Microsoft ActiveX Data Objects 2.0 Library
bindlayer.LayerName = "us_cust2"
bindlayer.LayerType = miBindLayerTypeXY
bindlayer.RefColumn1 = "x"
bindlayer.RefColumn2 = "y"
conn.Open "dsn=mapstats"
Set cmd.ActiveConnection = conn
cmd.CommandText = "select * from us_cust"
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenDynamic, adLockBatchOptimistic
Formmain.Map1.Datasets.Add miDataSetADO, rs, "us_cust2", "company", , bindlayer
'****不能使用ADODC控件作为其数据源.
'***Formmain.Map1.Datasets.Add miDataSetADO, Formmain.Ado1.Recordset, "us_cust1", "company", , bindlayer
ChangeCombo
Set bindlayer = Nothing
Set conn = Nothing
Set cmd = Nothing
Set rs = Nothing
End Sub
Private Sub bandus_Click()
Dim bindlayer As New bindlayer
Dim ds As MapXLib.Dataset
Dim lyr As MapXLib.layer
'绑定层字段要作索引。
'(1)
Set lyr = Formmain.Map1.Layers.Item("us_cust1")
Set ds = Formmain.Map1.Datasets.Add(miDataSetDAO, Formmain.Data1.Recordset, "us_cust21", "city", "state", lyr)
'(2)
'bindlayer.LayerName = "usa"
'bindlayer.LayerType = miBindLayerTypeNormal
'Set ds = Formmain.Map1.Datasets.Add(miDataSetDAO, Formmain.Data1.Recordset, "us_cust1", "state", , bindlayer)
Formmain.Map1.MatchThreshold = 1
'Set ds = Formmain.Map1.Datasets.Add(miDataSetDAO, Formmain.Data1.Recordset, "us_cust21", "state")
ds.Themes.Add 5
ChangeCombo
Set bindlayer = Nothing
End Sub
Private Sub CircleSelect_Click()
Formmain.Map1.CurrentTool = miRadiusSelectTool
End Sub
Private Sub CloseGeoset_Click()
Formmain.Map1.Geoset = ""
End Sub
Private Sub CloseTable_Click()
End Sub
Private Sub CloseTables_Click()
CloseTable.Show 1
End Sub
Private Sub ControlLayer_Click()
On Error Resume Next
Formmain.Map1.Layers.LayersDlg
ChangeCombo
End Sub
Private Sub copy_Click()
Dim lyr As MapXLib.layer
For Each lyr In Formmain.Map1.Layers
If lyr.Selection.Count > 0 Then
Set CopyFtrs = lyr.NoFeatures
CopyFtrs.Add lyr.Selection.Clone
Exit For
End If
Next
End Sub
Private Sub CreateTheme_Click()
Dim ds As MapXLib.Dataset
If Trim(ToolBars.Combo2.Text) <> "" Then
ThemeDlg.Show 1
Else
MsgBox "请先选择数据集.", , "错误提示"
End If
End Sub
Private Sub DAOType_Click()
Dim bindlayer As New bindlayer
Dim ds As New MapXLib.Dataset
bindlayer.LayerName = "us_cust1"
bindlayer.LayerType = miBindLayerTypeXY
bindlayer.RefColumn1 = "x"
bindlayer.RefColumn2 = "y"
Set ds = Formmain.Map1.Datasets.Add(miDataSetDAO, Formmain.Data1.Recordset, "us_cust1", "state", , bindlayer)
ChangeCombo
Set bindlayer = Nothing
End Sub
Private Sub DeleteAllAnnotation_Click()
Formmain.Map1.Annotations.RemoveAll
End Sub
Private Sub DispPRJ_Click()
Formmain.Map1.DisplayCoordSys.PickCoordSys
End Sub
Private Sub DrawFeature_Click(Index As Integer)
Dim lyr As MapXLib.layer
Dim i As Integer
For i = 1 To ToolBars.Toolbar1.Buttons.Count
ToolBars.Toolbar1.Buttons.Item(i).Value = tbrUnpressed
Next i
If Trim(ToolBars.Combo1.Text) = "" Then
MsgBox "请选择编辑图层.", , "警告"
Else
Set lyr = Formmain.Map1.Layers(ToolBars.Combo1.Text)
If lyr.Editable = False Then MsgBox "图层不可编辑", , "警告"
End If
Select Case Index
Case 1 '创建符号
Set Formmain.Map1.Layers.InsertionLayer = lyr
Formmain.Map1.CurrentTool = miAddPointTool
'Formmain.Map1.CurrentTool = CreateSymbolTool
Case 2 '创建文本
Formmain.Map1.CurrentTool = CreateTextTool
Case 4 '创建线段
' Formmain.Map1.CurrentTool = CreateLineTool
Set Formmain.Map1.Layers.InsertionLayer = lyr
Formmain.Map1.CurrentTool = miAddLineTool
Case 5 '创建折线
' Formmain.Map1.CurrentTool = CreatePolyLineTool
Set Formmain.Map1.Layers.InsertionLayer = lyr
Formmain.Map1.CurrentTool = miAddPolylineTool
Case 6 '创建弧段
Formmain.Map1.CurrentTool = CreateArcTool
Case 7 '创建矩形
Formmain.Map1.CurrentTool = CreateRectTool
Case 9 '创建矩形区域
Formmain.Map1.CurrentTool = CreateRectRegionTool
Case 10 '创建圆形区域
Formmain.Map1.CurrentTool = CreateCircleRegionTool
Case 11 '创建椭圆区域
Formmain.Map1.CurrentTool = CreateEllipseRegionTool
Case 12 '创建多边形
' Formmain.Map1.CurrentTool = CreatePolygonTool
Set Formmain.Map1.Layers.InsertionLayer = lyr
Formmain.Map1.CurrentTool = miAddRegionTool
End Select
End Sub
Private Sub DrawUserLayer_Click()
Dim LayerInfo As MapXLib.LayerInfo
LayerInfo.Type = miLayerInfoTypeUserDraw
LayerInfo.AddParameter "name", UserDraw
Formmain.Map1.Layers.Add LayerInfo, 1
End Sub
Private Sub Entirelayer_Click()
FrmEntireLayer.Show
End Sub
Private Sub Exit_Click()
End
End Sub
Private Sub GlobalHandleType_Click()
Dim fileData As String, lineData As String, filepath As String
Dim flds As New MapXLib.Fields
Dim MemoryBlockId As Long
Dim MemoryBlockAddress As Long
Dim bindlayer As New MapXLib.bindlayer
'对文本文件的要求: 以TAB制表符作为分隔.(因为用line input语句读入)
'出错处: 1.文本文件中数据格式.经验: 先以其中少量数据试验,已排出数据问题
' 2.用bindlayer时一定要设置GeoField参数.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -