frmnewtable.frm

vb+mapxvb+mo二次开发实现鹰眼功能

        FieldDec.Enabled = False
        MSFlexGrid1.TextArray(MSFlexGrid1.RowSel * 3 + 1) = ComboField.Text
    ElseIf ComboField.ListIndex = 4 Then '十进制类型
        FieldWidth.Enabled = True
        FieldWidth.Enabled = True
    
        FieldDec.Enabled = True
        FieldDec.Enabled = True
        MSFlexGrid1.TextArray(MSFlexGrid1.RowSel * 3 + 1) = Trim(ComboField.Text) + "[" + Trim(FieldWidth.Text) + "," + Trim(FieldDec) + "]"
    Else '字符串型
        FieldWidth.Enabled = True
        FieldWidth.Enabled = True
    
        FieldDec.Enabled = False
        FieldDec.Enabled = False
        MSFlexGrid1.TextArray(MSFlexGrid1.RowSel * 3 + 1) = Trim(ComboField.Text) + "[" + Trim(FieldWidth.Text) + "]"
    End If
End Sub
Private Sub ChangeCombo()
    Dim lyr As MapXLib.Layer
    Dim I As Integer, TmpStr As String
    
    I = 0
    For Each lyr In ActiveForm.Map1.Layers
        I = I + 1
        TmpStr = ActiveForm.Map1.Layers.Item(I).Name
        If (ActiveForm.Map1.Layers(TmpStr).Editable = True) Then
            Set EditLayer = lyr
            Exit For
        End If
    Next
End Sub
Private Sub CommandCreate_Click()
    Dim I As Integer, LayerName As String, StrName As String, StrType As String
    Dim LayerInfo As New MapXLib.LayerInfo, flds As New MapXLib.Fields
    Dim NumWidth As Integer, NumDec As Integer, TmpNum As Integer, TmpStr As Integer
    Dim DirFile As String
    
    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
    LayerName = CM1.FileTitle
    I = InStr(LayerName, ".")
    If (I > 0) Then
        LayerName = Left(LayerName, I - 1)
    End If
    
    DirFile = Dir(FileSpec)
    If (DirFile <> "") Then
        I = InStr(FileSpec, ".")
        DirFile = Left(FileSpec, I - 1) + "*"
        Kill DirFile
    End If
    

    For I = 1 To Grid1.Rows - 1
        Grid1.Row = I
        Grid1.Col = 0
        StrName = Grid1.Text
        
        Grid1.Col = 1
        StrType = Grid1.Text
     
        If InStr(StrType, "[") > 0 Then
            TmpNum = InStr(StrType, "[")
            TmpStr = Mid(StrType, TmpNum + 1, Len(StrType) - TmpNum - 1)
            NumWidth = Val(TmpStr)
            If InStr(TmpStr, ",") > 0 Then
                NumWidth = Val(Left(TmpStr, InStr(TmpStr, ",") - 1))
                NumDec = Val(Right(TmpStr, Len(TmpStr) - InStr(TmpStr, ",")))
            End If
        End If
     
        If InStr(StrType, "字符型") > 0 Then
            flds.AddStringField StrName, NumWidth
        ElseIf InStr(StrType, "整型") Then
            flds.AddIntegerField StrName
        ElseIf InStr(StrType, "短整型") Then
            flds.AddSmallIntField StrName
        ElseIf InStr(StrType, "浮点型") Then
            flds.AddFloatField StrName
        ElseIf InStr(StrType, "十进制型") Then
            flds.AddNumericField StrName, NumWidth, NumDec
        ElseIf InStr(StrType, "日期型") Then
            flds.AddDateField StrName
        ElseIf InStr(StrType, "逻辑型") Then
            flds.AddLogicalField StrName
        End If
    Next I
   
    LayerInfo.Type = 7 'miLayerInfoTypeNewTab
    LayerInfo.AddParameter "FileSpec", FileSpec
   
    LayerInfo.AddParameter "Name", LayerName
    LayerInfo.AddParameter "Fields", flds
    
    '将新建图层加入到数据集
    LayerInfo.AddParameter "AutoCreateDataset", 1
    LayerInfo.AddParameter "DataSetName", LayerName
    
    frmD.Map1.Layers.Add LayerInfo, 1
    
   '若要为新表创建投影，则先要设置Map1.NumericCoorsys.
    ''''Set ActiveForm.Map1.NumericCoordSys = ActiveForm.Map1.DisplayCoordSys
    ''''activeform.Map1.MapUnit = activeform.Map1.NumericCoordSys.Units
    
    Call ChangeCombo

    Unload Me
End Sub

Private Sub CommandCreat_Click()
  Dim I As Integer, LayerName As String, StrName As String, StrType As String
    Dim LayerInfo As New MapXLib.LayerInfo, flds As New MapXLib.Fields
    Dim NumWidth As Integer, NumDec As Integer, TmpNum As Integer, TmpStr As Integer
    Dim DirFile As String
    
    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
    LayerName = CM1.FileTitle
    I = InStr(LayerName, ".")
    If (I > 0) Then
        LayerName = Left(LayerName, I - 1)
    End If
    
    DirFile = Dir(FileSpec)
    If (DirFile <> "") Then
        I = InStr(FileSpec, ".")
        DirFile = Left(FileSpec, I - 1) + "*"
        Kill DirFile
    End If
    

    For I = 1 To MSFlexGrid1.Rows - 1
        MSFlexGrid1.Row = I
        MSFlexGrid1.Col = 0
        StrName = MSFlexGrid1.Text
        
        MSFlexGrid1.Col = 1
        StrType = MSFlexGrid1.Text
     
        If InStr(StrType, "[") > 0 Then
            TmpNum = InStr(StrType, "[")
            TmpStr = Mid(StrType, TmpNum + 1, Len(StrType) - TmpNum - 1)
            NumWidth = Val(TmpStr)
            If InStr(TmpStr, ",") > 0 Then
                NumWidth = Val(Left(TmpStr, InStr(TmpStr, ",") - 1))
                NumDec = Val(Right(TmpStr, Len(TmpStr) - InStr(TmpStr, ",")))
            End If
        End If
     
        If InStr(StrType, "字符型") > 0 Then
            flds.AddStringField StrName, NumWidth
        ElseIf InStr(StrType, "整型") Then
            flds.AddIntegerField StrName
        ElseIf InStr(StrType, "短整型") Then
            flds.AddSmallIntField StrName
        ElseIf InStr(StrType, "浮点型") Then
            flds.AddFloatField StrName
        ElseIf InStr(StrType, "十进制型") Then
            flds.AddNumericField StrName, NumWidth, NumDec
        ElseIf InStr(StrType, "日期型") Then
            flds.AddDateField StrName
        ElseIf InStr(StrType, "逻辑型") Then
            flds.AddLogicalField StrName
        End If
    Next I
   
    LayerInfo.Type = 7 'miLayerInfoTypeNewTab
    LayerInfo.AddParameter "FileSpec", FileSpec
   
    LayerInfo.AddParameter "Name", LayerName
    LayerInfo.AddParameter "Fields", flds
    
    '将新建图层加入到数据集
    LayerInfo.AddParameter "AutoCreateDataset", 1
    LayerInfo.AddParameter "DataSetName", LayerName
    
    frmD.Map1.Layers.Add LayerInfo, 1
    
   '若要为新表创建投影，则先要设置Map1.NumericCoorsys.
    ''''Set ActiveForm.Map1.NumericCoordSys = ActiveForm.Map1.DisplayCoordSys
    ''''activeform.Map1.MapUnit = activeform.Map1.NumericCoordSys.Units
    
    Call ChangeCombo

    Unload Me
End Sub


Private Sub CommandExit_Click()
    Unload Me
End Sub

Private Sub Coordinate_Click()
    '投影
    Dim csys As New MapXLib.CoordSys
    Dim xmin As Double, ymin As Double, xmax As Double, ymax As Double
    Dim rect As New MapXLib.Rectangle
    'Dim cunits As Integer
    Dim ctype As Integer

    On Error Resume Next
    
    csys.PickCoordSys

    ctype = csys.Type
    If ctype > 0 Then Exit Sub
    cunits = csys.Units
    
    FrmProjectRect.Show 1
     
'rect的左下角不能为（0，0）
    xmin = Val(FrmProjectRect.xmin)
    ymin = Val(FrmProjectRect.ymin)
    xmax = Val(FrmProjectRect.xmax)
    ymax = Val(FrmProjectRect.ymax)

    Unload FrmProjectRect
    rect.Set xmin, ymin, xmax, ymax
'
    If ctype = 0 Then
       csys.Set ctype, , cunits, , , , , , , , , , rect
    End If
   
   Set FrmMap.Map1.DisplayCoordSys = csys
   Set FrmMap.Map1.NumericCoordSys = csys
End Sub

Private Sub delete_Click()
    '删除一个字段
    MSFlexGrid1.RemoveItem (MSFlexGrid1.RowSel)
End Sub
Private Sub down_Click()
    If MSFlexGrid1.RowSel < MSFlexGrid1.Rows - 1 Then
        MSFlexGrid1.RowPosition(MSFlexGrid1.RowSel) = MSFlexGrid1.RowSel + 1
        MSFlexGrid1.RowSel = MSFlexGrid1.RowSel + 1
    End If
End Sub

Private Sub FieldDec_Change()
    If Trim(FieldDec.Text) = "" Then FieldDec.Text = "0"
    MSFlexGrid1.TextArray(MSFlexGrid1.RowSel * 3 + 1) = Trim(ComboField.Text) + "[" + Trim(FieldWidth.Text) + "," + Trim(FieldDec.Text) + "]"
End Sub


Private Sub FieldName_Change()
    MSFlexGrid1.TextArray(MSFlexGrid1.RowSel * 3) = FieldName.Text
End Sub


Private Sub FieldWidth_Change()
   MSFlexGrid1.Row = MSFlexGrid1.RowSel
   MSFlexGrid1.Col = 1
   If ComboField.ListIndex = 0 Then '字符串
      MSFlexGrid1.Text = Trim(ComboField.Text) + "[" + Trim(FieldWidth) + "]"
   ElseIf ComboField.ListIndex = 4 Then '十进制
      MSFlexGrid1.TextArray(MSFlexGrid1.RowSel * 3 + 1) = Trim(ComboField.Text) + "[" + Trim(FieldWidth.Text) + "," + Trim(FieldDec) + "]"
   End If
End Sub

Private Sub File1_Click()

End Sub

Private Sub Form_Load()
    FileSpec = ""
    MSFlexGrid1.Rows = 2
    
    ComboField.ListIndex = 0
    CheckIndex.Value = 0
    Call CheckIndex_Click
End Sub

Private Sub Grid1_Click()
    Dim TmpStr As String
    Dim TmpNum As Integer
      
    FieldName = Grid1.TextArray(Grid1.Row * 3)
    TmpStr = Grid1.TextArray(Grid1.Row * 3 + 1)
   
    If InStr(TmpStr, "[") > 0 Then
        TmpNum = InStr(TmpStr, "[")
        TmpStr = Mid(TmpStr, TmpNum + 1, Len(TmpStr) - TmpNum - 1)
        If InStr(TmpStr, ",") > 0 Then
            ComboField.ListIndex = 4 '十进制
            FieldWidth.Text = Left(TmpStr, InStr(TmpStr, ",") - 1)
            FieldDec.Text = Right(TmpStr, Len(TmpStr) - InStr(TmpStr, ","))
        Else
            ComboField.ListIndex = 0
            FieldWidth.Text = TmpStr
        End If
    Else
        ComboField.Text = Trim(TmpStr)
        FieldWidth.Enabled = False
        FieldDec.Enabled = False
    End If
   
    TmpNum = Val(Grid1.TextArray(Grid1.Row * 3 + 2))
    If TmpNum = 1 Then
        CheckIndex.Value = 1
    ElseIf TmpNum = 0 Then
        CheckIndex.Value = 0
    End If
End Sub



Private Sub up_Click()
    If MSFlexGrid1.RowSel > 1 Then
        MSFlexGrid1.RowPosition(MSFlexGrid1.RowSel) = MSFlexGrid1.RowSel - 1
        MSFlexGrid1.RowSel = MSFlexGrid1.RowSel - 1
    End If
End Sub