?? form2.frm
字號:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Form2
Caption = "Form2"
ClientHeight = 3375
ClientLeft = 45
ClientTop = 330
ClientWidth = 4950
LinkTopic = "Form2"
ScaleHeight = 3375
ScaleWidth = 4950
StartUpPosition = 3 'Windows Default
Begin ComctlLib.Toolbar layerTools
Height = 390
Left = 3600
TabIndex = 3
Top = 2520
Width = 855
_ExtentX = 1508
_ExtentY = 688
Appearance = 1
ImageList = "ImageList1"
_Version = 327682
BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7}
NumButtons = 3
BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Promote"
Description = "Promote"
Object.ToolTipText = "MoveLayerUp"
Object.Tag = ""
ImageIndex = 1
EndProperty
BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
Style = 3
EndProperty
BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7}
Key = "Demote"
Description = "Demote"
Object.ToolTipText = "Move Layer Down"
Object.Tag = ""
ImageIndex = 2
EndProperty
EndProperty
End
Begin VB.CommandButton cmdProps
Caption = "Properties"
Height = 372
Left = 3480
TabIndex = 4
Top = 1680
Width = 1212
End
Begin VB.CommandButton cmdRemove
Caption = "Remove"
Height = 372
Left = 3480
TabIndex = 2
Top = 1080
Width = 1212
End
Begin VB.ListBox lstLayers
Height = 2310
Left = 480
Style = 1 'Checkbox
TabIndex = 1
Top = 240
Width = 2532
End
Begin VB.CommandButton cmdAdd
Caption = "Add Shape"
Height = 372
Left = 3480
TabIndex = 0
Top = 360
Width = 1212
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 480
Top = 360
_ExtentX = 688
_ExtentY = 688
_Version = 393216
DialogTitle = "Add Shape"
Filter = "*.shp"
End
Begin ComctlLib.ImageList ImageList1
Left = 240
Top = 2760
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 2
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form2.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "Form2.frx":0552
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim FormUp As Boolean
Private Sub cmdProps_Click()
Set drawLayer = Form1.Map1.Layers(lstLayers.ListIndex)
frmDrawProps.Show
End Sub
Private Sub cmdRemove_Click()
If lstLayers.ListIndex < 0 Then
Exit Sub
End If
'what do we know if we get here?
Form1.Map1.Layers.Remove (lstLayers.ListIndex)
lstLayers.Clear
Form_Load
refreshButtons
End Sub
Private Sub Form_Load()
Dim i As Integer
FormUp = True
For i = 0 To Form1.Map1.Layers.Count - 1
lstLayers.AddItem Form1.Map1.Layers(i).Name
lstLayers.Selected(i) = Form1.Map1.Layers(i).Visible
Next i
refreshButtons
FormUp = False
End Sub
Private Sub layerTools_ButtonClick(ByVal Button As ComctlLib.Button)
Dim curIndex As Integer
curIndex = lstLayers.ListIndex
'Here, we promote or demote the layer.
Select Case Button.Key
Case "Promote"
Form1.Map1.Layers.MoveTo curIndex, curIndex - 1
lstLayers.Clear
Form_Load
lstLayers.ListIndex = curIndex - 1
Case "Demote"
Form1.Map1.Layers.MoveTo curIndex, curIndex + 1
lstLayers.Clear
Form_Load
lstLayers.ListIndex = curIndex + 1
End Select
refreshButtons 'Refresh the button enabled status on Map Contents
Form1.Map1.Refresh 'Redraw the map with the new Layer order
End Sub
Private Sub lstLayers_Click()
refreshButtons
End Sub
Private Sub lstLayers_ItemCheck(i As Integer)
If lstLayers.listCount = 0 Then
Exit Sub
End If
If Not FormUp Then
Form1.Map1.Layers(i).Visible = lstLayers.Selected(i)
Form1.Map1.Refresh
End If
End Sub
Private Sub cmdAdd_Click()
addFile
End Sub
Private Sub addFile()
'This procedure sets up the common dialog and returns a shapefile or image file
'for processing into the Layers collection.
Dim fullFile As String, path As String, tempChar As String, ext As String
Dim Test As Boolean
Dim textPos As Long, periodPos As Long
Dim curPath As String
'Execute common dialog for selecting a file to open.
Dim strShape As String, strImage As String, strOtherImage As String
Dim strCov As String, strAll As String
strShape = "Shape files (*.shp)|*.shp"
strCov = "Coverage feature attribute tables(*.adf,*.tat,*.pat,*.rat)|aat.adf;pat.adf;nat.adf;txt.adf;*.tat;*.pat;*.rat"
strImage = "Images (*.bmp; *.tif)|*.bmp;*.tif"
strOtherImage = "Other formats (*.*)|*.*"
strAll = "Shape files(*.shp),coverages(*.adf),images(*.bmp,*.tif)|*.shp;*.bmp;*.tif;aat.adf;pat.adf;nat.adf;txt.adf;*.tat;*.pat;*.rat"
CommonDialog1.Filter = strAll & "|" & strShape & "|" & strCov & "|" & strImage & "|" & strOtherImage
CommonDialog1.DialogTitle = "Select file for new layer"
CommonDialog1.ShowOpen
'We have the full path name from the common dialog. Parse out base path.
If CommonDialog1.filename = "" Then Exit Sub
fullFile = Trim$(CommonDialog1.filename)
textPos = Len(fullFile)
Test = False
'This loop goes backwards through the string, searching for the
'last back slash. This marks the base path from the returned string.
Do While Test = False
textPos = textPos - 1
tempChar = Mid$(fullFile, textPos, 1)
If tempChar = "." Then
periodPos = textPos
ElseIf tempChar = "\" Or textPos = 0 Then
Test = True
End If
Loop
'Path is the part of the full file string up to the last back slash.
curPath = Left$(fullFile, textPos - 1)
'Send the file name to the procedures that add the layers...
Dim filename As String
filename = CommonDialog1.FileTitle
'Check for file extension. If extension is *.shp, assumed to be shape file.
'Otherwise, it will be processed and checked as an image file.
ext = LCase(Mid$(fullFile, periodPos + 1, 3))
If ext = "shp" Then
Call addShapeFile(curPath, filename) 'Add shapefile into Layers collection
'ElseIf ext = "adf" Or ext = "pat" Or ext = "rat" Or ext = "tat" Then
' Call addCoverageTable(curPath, filename)
'Else
' Call addImageFile(fullFile) 'Add image file into Layers collection
End If
lstLayers.Clear
Form_Load
refreshButtons
End Sub
Private Sub addShapeFile(basepath As String, shpfile As String)
'This procedure validates and adds a shape file to the Layers collection.
Dim dCon As New DataConnection
Dim gSet As GeoDataset
dCon.Database = basepath 'Set Database property of DataConnection
If dCon.Connect Then
shpfile = GetFirstToken(shpfile, ".") 'Extract suffix of shpfile string
Set gSet = dCon.FindGeoDataset(shpfile) 'Find shapefile as GeoDataset in DataConnection
If gSet Is Nothing Then
MsgBox "Error opening shapefile " & shpfile
Exit Sub
Else
Dim newLayer As New MapLayer
newLayer.GeoDataset = gSet 'Set GeoDataset property of new MapLayer
newLayer.Name = shpfile 'Set Name property of new MapLayer
Form1.Map1.Layers.Add newLayer 'Add MapLayer to Layers collection
'curSelectedListItem = 1 'Set the first ListItem to be selected
End If
Else
MsgBox ConnectErrorMsg(dCon.ConnectError), vbCritical, "Connection error"
End If
End Sub
Private Sub refreshButtons()
Dim listCount As Integer
Dim curItem As Integer
listCount = Form1.Map1.Layers.Count
curItem = lstLayers.ListIndex
cmdProps.Enabled = True
If listCount = 0 Then
cmdRemove.Enabled = False
layerTools.Buttons("Promote").Enabled = False
layerTools.Buttons("Demote").Enabled = False
cmdProps.Enabled = False
End If
'No items selected.
If curItem = -1 Then
cmdRemove.Enabled = False
layerTools.Buttons("Promote").Enabled = False
layerTools.Buttons("Demote").Enabled = False
cmdProps.Enabled = False
'Only one item selected.
ElseIf listCount = 1 Then
cmdRemove.Enabled = True
layerTools.Buttons("Promote").Enabled = False
layerTools.Buttons("Demote").Enabled = False
'Many items, first item is selected.
ElseIf curItem = 0 Then
cmdRemove.Enabled = True
layerTools.Buttons("Promote").Enabled = False
layerTools.Buttons("Demote").Enabled = True
'Many items, last item is selected.
ElseIf curItem = listCount - 1 Then
cmdRemove.Enabled = True
layerTools.Buttons("Promote").Enabled = True
layerTools.Buttons("Demote").Enabled = False
'Many items, an item between first and last is selected.
Else
cmdRemove.Enabled = True
layerTools.Buttons("Promote").Enabled = True
layerTools.Buttons("Demote").Enabled = True
End If
Form1.RefreshCombo1
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -