?? frmmain.frm
字號:
VERSION 5.00
Object = "{370A8DDA-7915-42DC-B4A1-77662C82B046}#1.0#0"; "TOCControl.ocx"
Object = "{B7D43581-3CBC-11D6-AA09-00104BB6FC1C}#1.0#0"; "ToolbarControl.ocx"
Object = "{C552EA90-6FBB-11D5-A9C1-00104BB6FC1C}#1.0#0"; "MapControl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Begin VB.Form frmMain
BorderStyle = 3 'Fixed Dialog
Caption = "Esri ArcGIS Engine Test(太湖流域水資源信息管理系統(tǒng))"
ClientHeight = 9030
ClientLeft = 150
ClientTop = 720
ClientWidth = 11010
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 9030
ScaleWidth = 11010
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command5
Caption = "刷新"
Height = 375
Left = 9120
TabIndex = 9
Top = 4440
Width = 975
End
Begin VB.CommandButton Command4
Caption = "屬性瀏覽"
Height = 615
Left = 8520
TabIndex = 8
Top = 7800
Width = 1215
End
Begin VB.CommandButton Command3
Caption = "信息查詢(按名稱、屬性)"
Height = 615
Left = 4560
TabIndex = 7
Top = 7800
Width = 2775
End
Begin VB.CommandButton Command2
Caption = "數(shù)據(jù)庫維護及繪制過程線"
Height = 615
Left = 1320
TabIndex = 6
Top = 7800
Width = 2535
End
Begin VB.CommandButton Command1
Caption = "目標數(shù)目"
Height = 495
Left = 9120
TabIndex = 5
Top = 3720
Width = 975
End
Begin VB.ListBox List1
Height = 2595
ItemData = "frmMain.frx":0000
Left = 8640
List = "frmMain.frx":0002
TabIndex = 4
Top = 720
Width = 1815
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 120
Top = 7320
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin esriMapControl.MapControl MapControl2
Height = 2295
Left = 8400
OleObjectBlob = "frmMain.frx":0004
TabIndex = 3
Top = 4920
Width = 2535
End
Begin esriMapControl.MapControl MapControl1
Height = 6495
Left = 2760
OleObjectBlob = "frmMain.frx":06C6
TabIndex = 2
Top = 720
Width = 5535
End
Begin esriTOCControl.TOCControl TOCControl1
Height = 6495
Left = 0
OleObjectBlob = "frmMain.frx":0D86
TabIndex = 1
Top = 720
Width = 2535
End
Begin esriToolbarControl.ToolbarControl ToolbarControl1
Height = 390
Left = 120
OleObjectBlob = "frmMain.frx":0E08
TabIndex = 0
Top = 120
Width = 4575
End
Begin VB.Menu file
Caption = "文件"
Begin VB.Menu open
Caption = "打開"
End
Begin VB.Menu quit
Caption = "退出"
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'地圖鷹眼
Private m_pEnvelope As IEnvelope ' The envelope drawn on the MapControl
Private m_pFillSymbol As ISimpleFillSymbol ' The symbol used to draw the
Private WithEvents m_pTransformEvents As DisplayTransformation
Attribute m_pTransformEvents.VB_VarHelpID = -1
Option Explicit
Public pp As String
Private Sub Command2_Click()
frmMain.Hide
Frmweihu.Show
End Sub
Private Sub Command3_Click()
frmMain.Hide
frmchaxun.Show
End Sub
Private Sub Command4_Click()
Dim button As Long
Dim shift As Long
Dim x As Long
Dim y As Long
Dim mapX As Double
Dim mapY As Double
Dim pmap As IMap
Set pmap = MapControl1.Map
Dim pIdentifyDialog As IIdentifyDialog
Dim pIdentifyDialogProps As IIdentifyDialogProps
Dim pEnumLayer As IEnumLayer
Dim pLayer As ILayer
Dim pPoint As IPoint
Dim pLyr As ILayer
Dim pIdentify As IIdentify
Dim pIDArray As IArray
Dim i As Long
Dim j As Long
For j = 0 To MapControl1.LayerCount - 1
Set pIdentify = MapControl1.Layer(j)
Set pPoint = MapControl1.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
Set pIDArray = pIdentify.Identify(pPoint)
If Not pIDArray Is Nothing Then
i = i + 1
End If
Next
If i = 0 Then Exit Sub
Set pIdentifyDialog = New IdentifyDialog
Set pIdentifyDialogProps = pIdentifyDialog
Set pIdentifyDialog.Map = MapControl1.ActiveView.FocusMap
Set pIdentifyDialog.display = MapControl1.ActiveView.ScreenDisplay
pIdentifyDialog.ClearLayers
Set pEnumLayer = pIdentifyDialogProps.Layers
pEnumLayer.Reset
Set pLayer = pEnumLayer.Next
Do While (Not pLayer Is Nothing)
pIdentifyDialog.AddLayerIdentifyPoint pLayer, x, y
Set pLayer = pEnumLayer.Next
Loop
pIdentifyDialog.Show
End Sub
Private Sub Command5_Click()
MapControl1.ActiveView.GraphicsContainer.DeleteAllElements
MapControl1.Refresh
End Sub
Private Sub Form_Load()
Call CreateOverviewSymbol
End Sub
Private Sub CreateOverviewSymbol() '設置鷹眼圖中的紅線框
'Get the IRgbColor interface.
Dim pColor As IRgbColor
Set pColor = New RgbColor
'Set the color properties.
pColor.RGB = RGB(255, 0, 0)
'Get the ILine symbol interface.
Dim pOutline As ILineSymbol
Set pOutline = New SimpleLineSymbol
'Set the line symbol properties.
pOutline.Width = 1.5
pOutline.Color = pColor
'Get the IFillSymbol interface.
Set m_pFillSymbol = New SimpleFillSymbol
'Set the fill symbol properties.
m_pFillSymbol.Outline = pOutline
m_pFillSymbol.Style = esriSFSHollow
End Sub
Private Sub m_pTransformEvents_VisibleBoundsUpdated(ByVal sender As esriDisplay.IDisplayTransformation, ByVal sizeChanged As Boolean)
'Set the extent to the new visible extent.
Set m_pEnvelope = sender.VisibleBounds
'Refresh the MapControl's foreground phase.
MapControl2.Refresh esriViewForeground
End Sub
Private Sub MapControl1_OnMapReplaced(ByVal newMap As Variant)
Dim pMapUnits As esriUnits
pMapUnits = MapControl1.MapUnits
'當主地圖顯示控件的地圖改變時,鷹眼中的地圖也跟隨改變
'Get the IActiveView of the focus map in the PageLayoutControl.
Dim pActiveview As IActiveView
Set pActiveview = MapControl1.ActiveView.FocusMap
'Trap the ITransformEvents of the PageLayoutControl's focus map.
Set m_pTransformEvents = pActiveview.ScreenDisplay.DisplayTransformation
'Get the extent of the focus map.
Set m_pEnvelope = pActiveview.Extent
'Load the same preauthored map document into the MapControl.
MapControl2.LoadMxFile MapControl1.DocumentFilename
'Set the extent of the MapControl to the full extent of the data.
MapControl2.Extent = MapControl2.FullExtent
End Sub
Private Sub mapcontrol2_OnAfterDraw(ByVal display As Variant, ByVal viewDrawPhase As Long)
If m_pEnvelope Is Nothing Then Exit Sub
'If the foreground phase has drawn
Dim pViewDrawPhase As esriViewDrawPhase
pViewDrawPhase = viewDrawPhase
If pViewDrawPhase = esriViewForeground Then
'Draw the shape on the MapControl.
MapControl2.DrawShape m_pEnvelope, m_pFillSymbol
End If
End Sub
Private Sub MapControl2_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
Dim pPt As IPoint
Set pPt = New Point
pPt.PutCoords mapX, mapY
'改變主控件的視圖范圍
MapControl1.CenterAt pPt
End Sub
Private Sub open_Click()
'打開地圖文檔
On Error Resume Next
Dim sfilename As String
With CommonDialog1
.DialogTitle = "Open Map Document"
.Filter = "Map Documents (*.mxd;*.pmf)|*.mxd;*.pmf"
.ShowOpen
If .FileName = "" Then Exit Sub
sfilename = .FileName
End With
If MapControl1.CheckMxFile(sfilename) Then
MapControl1.LoadMxFile sfilename
MapControl1.Extent = MapControl1.FullExtent
Else
MsgBox sfilename & " is not a valid ArcMap document"
Exit Sub
End If
frmMain.Caption = frmMain.Caption & " - " & sfilename
End Sub
Private Sub quit_Click()
End
End Sub
Private Sub Command1_Click()
Dim i As Integer
Dim pmap As IMap
Dim pfeature As IFeature
Dim penumfeature As IEnumFeature
Set pmap = frmMain.MapControl1.Map
Set penumfeature = pmap.FeatureSelection
Set pfeature = penumfeature.Next
MsgBox "你選擇了" & pmap.SelectionCount & "個對象"
List1.Clear
Do Until pfeature Is Nothing
List1.AddItem pfeature.Value(pfeature.Fields.FindField("ID"))
Set pfeature = penumfeature.Next
Loop
End Sub
Private Sub List1_Click()
pp = List1.List(List1.ListIndex)
If pp <> "常熟" And pp <> "常州" And pp <> "大浦口" And pp <> "甘露" _
And pp <> "杭長橋" And pp <> "夾浦" And pp <> "嘉興" And pp <> "琳橋" _
And pp <> "平望" And pp <> "蘇州" And pp <> "太浦閘" And pp <> "望亭" _
And pp <> "望亭(太)" And pp <> "無錫" And pp <> "西山" And pp <> "小梅山" Then
MsgBox "對不起,暫時沒有你想要的測站水文信息", 48, "提示信息"
Else
With frmchaxun2.Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\GIS1.mdb;Persist Security Info=False"
.RecordSource = "select * from " & pp
.Refresh
End With
Set frmchaxun2.DataGrid1.DataSource = frmchaxun2.Adodc1
frmchaxun2.Show
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -