分享

对tab表进行操作(新建、打开、关闭)

 ufo999 2011-08-19
 
对tab表进行操作(新建、打开、关闭)
2008-06-24 11:23

对表操作
(1) 新建表
Option Explicit

Dim FileSpec As String
Dim csys As MapXLib.CoordSys

Private Sub Command1_Click()
  
   On Error Resume Next
  
   CM1.DialogTitle = "保存表文件"
   CM1.DefaultExt = "表文件|*.tab"
   CM1.Filter = "表(*.tab)|*.tab"
   CM1.CancelError = True
   CM1.Action = 2
  
   If Err.Number = 32755 Then Exit Sub
  
   FileSpec = CM1.filename
  
End Sub

Private Sub Command2_Click()
     Dim ctype As Integer
     Dim cunits As Integer
    
     Formmain.Map1.NumericCoordSys.PickCoordSys
     Set csys = Formmain.Map1.NumericCoordSys
     ctype = csys.Type
     cunits = csys.Units
    
     'Set Formmain.Map1.Bounds = rect
    ' If csys.Type = 0 Then
        'FrmRange.Show 1
        'rect的左下角不能为(0,0)
        'csys.Set ctype, , cunits, , , , , , , , , , rect
     'End If
    
End Sub

Private Sub Command3_Click()
    
     Dim LayerName As String
     Dim FeatureNameLen As Integer
     Dim LayerPos As Integer
     Dim LayerInfo As MapXLib.LayerInfo
     Dim retn As Integer
    
     On Error GoTo ErrorHand
    
     LayerName = Text1.Text
     FeatureNameLen = Val(Text2.Text)
     LayerPos = Val(Text3.Text)
    
     If FeatureNameLen <= 0 Then MsgBox "请输入大于0的数字!", , "警告"
     If LayerPos <= 0 Then MsgBox "请输入大于0的数字!", , "警告"
    
     Formmain.Map1.Layers.CreateLayer LayerName, FileSpec, LayerPos, FeatureNameLen, csys
    
     '将新建图层加入到数据字典和数据集
     'If Option_AddToGeoDict = True Then
         'LayerInfo.Type = miLayerInfoTypeGeodictUserName
         'LayerInfo.AddParameter "Name", Text1.Text
         'If Option_AddToDataset = True Then
             'LayerInfo.AddParameter "AutoCreate", 1
             'LayerInfo.AddParameter "DatasetName", Text1.Text
         'End If
         'Formmain.Map1.Layers.Add LayerInfo
     'End If
    
     'ChangeCombo
    
     Unload Me
    
ErrorHand:
    
     Select Case Err.Number
       Case 1230
         retn = MsgBox("是否覆盖?", 4, "错误提示")
         If retn = 6 Then
            Kill FileSpec
            Resume
         ElseIf retn = 7 Then
         End If
     End Select
End Sub

Private Sub Command4_Click()
    
     Unload Me
    
End Sub

Private Sub Form_Load()
     FileSpec = ""
End Sub

控件解释:
text1 新建图层的名称
text2 图元名称长度
text3 图层位置
command1 保存
command2 投影
command3 确定
command4 取消
(2) 打开表
Dim filename As String
   Dim filepath As String
   Dim LayerName As String
   Dim lyr As MapXLib.Layer
   Dim LayerInfo As New MapXLib.LayerInfo
   Dim FilterIndex As Integer
   Dim ftrs As New MapXLib.Features
   Dim csys As New MapXLib.CoordSys
  
   On Error Resume Next
  
   CM2.DialogTitle = "打开文件"
   CM2.DefaultExt = "Tab|*.tab"
   CM2.Filter = "表(*.tab)|*.tab|GeoTiff file(*.tif)|*.tif|shapefile(*.tab)|*.tab|ServerLayer(spatialware)"
   CM2.CancelError = True
   CM2.Action = 1
  
   If Err.Number = 32755 Then Exit Sub
    
   filename = CM2.FileTitle
   filepath = CM2.filename
   filepath = Left(filepath, InStr(filepath, filename) - 1)
   LayerName = Left(filename, InStr(filename, ".") - 1)

   FilterIndex = CM2.FilterIndex
  
   Select Case FilterIndex
    
     Case 1:
       LayerInfo.Type = miLayerInfoTypeTab
       LayerInfo.AddParameter "FileSpec", filepath + filename
       LayerInfo.AddParameter "Name", LayerName
    
     Case 2:
       LayerInfo.Type = miLayerInfoTypeRaster
       LayerInfo.AddParameter "FileSpec", filepath + filename
       LayerInfo.AddParameter "Name", LayerName
    
     Case 3:
       
     
       csys.Set 1, 0
     
       LayerInfo.Type = miLayerInfoTypeShape
       LayerInfo.AddParameter "FileSpec", filepath + filename
       LayerInfo.AddParameter "CoordSys", csys
    
   End Select
  

  
   Set lyr = Formmain.Map1.Layers.Add(LayerInfo, 1)
   

    
(3) 关闭表
Private Sub Command1_Click()
     Dim lyr As MapXLib.Layer
     Dim i As Integer
    
     If Trim(Combo1.Text) <> "" Then Set lyr = Formmain.Map1.Layers(Combo1.Text)
    
     lyr.Datasets.RemoveAll
     Formmain.Map1.Layers.Remove lyr
    
  
     Set lyr = Nothing
    
     Unload Me
End Sub

Private Sub Command2_Click()
     Unload Me
End Sub

Private Sub Form_Load()
    
     Dim lyr As MapXLib.Layer
    
     For Each lyr In Formmain.Map1.Layers
       Combo1.AddItem lyr.Name
     Next
    
     If Combo1.ListCount > 0 Then Combo1.ListIndex = 0
       
     Set lyr = Nothing
    
End Sub
控件解释:
combo1   tab表的列表
command1   确定关闭
command2   取消


    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多