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 vbModal
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