formnewtable.frm

VB+mapinfo开发的最短路径

    combo1.ListIndex = 0
    Combo1_Click
    '索引
    Check1.Value = 0
    Check1_Click
    '添加
    Delete.Enabled = True
End Sub

'索引
Private Sub Check1_Click()
    If Check1.Value = 1 Then
        Grid1.TextMatrix(Row, 2) = "1"
    Else
        Grid1.TextMatrix(Row, 2) = "0"
    End If
End Sub

Private Sub Check2_Click()
    If (Check2.Value = 1) Then
        Command2.Enabled = True
    Else
        Command2.Enabled = False
    End If
End Sub

'选择类型
Private Sub Combo1_Click()
If combo1.ListIndex <> 0 And combo1.ListIndex <> 4 Then
    Label4.Enabled = False
    fieldwidth.Enabled = False
    
    Label7.Enabled = False
    Text3.Enabled = False
    Grid1.TextMatrix(Row, 1) = combo1.Text
ElseIf combo1.ListIndex = 4 Then '十进制类型
    Label4.Enabled = True
    fieldwidth.Enabled = True
    
    Label7.Enabled = True
    Text3.Enabled = True
    Grid1.TextMatrix(Row, 1) = Trim(combo1.Text) + "[" + Trim(fieldwidth.Text) + "," + Trim(Text3.Text) + "]"
Else '字符串型
    Label4.Enabled = True
    fieldwidth.Enabled = True
    
    Label7.Enabled = False
    Text3.Enabled = False
    Grid1.TextMatrix(Row, 1) = Trim(combo1.Text) + "[" + Trim(fieldwidth.Text) + "]"
End If

End Sub

'投影
Private Sub Command2_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 Formmain.Map1.DisplayCoordSys = csys
''   Set Formmain.Map1.NumericCoordSys = csys
End Sub
'确认，创建字段
Private Sub Command3_Click()
    Dim I1 As Integer, I2 As Integer, I As Integer
    Dim FieldName As String, FieldType As String
    Dim NumWidth As Integer, NumDec As Integer
    Dim TmpNum As Integer, tmpStr As Integer
    Dim Columns() As String, ColumnsType() As String, ColumnsN As Integer
    Dim TheOutPath As String, TheOutFile As String
    Dim Temp As String
    
    On Error Resume Next
    ColumnsN = Grid1.Rows - 1
    ReDim Columns(1 To ColumnsN), ColumnsType(1 To ColumnsN)
    For I = 1 To ColumnsN
        FieldName = Grid1.TextMatrix(I, 0)
        FieldType = Grid1.TextMatrix(I, 1)
        
        If InStr(FieldType, "[") > 0 Then
            TmpNum = InStr(FieldType, "[")
            tmpStr = Mid(FieldType, TmpNum + 1, Len(FieldType) - 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(FieldType, "字符型") > 0 Then
            FieldType = "Char(" + Format(NumWidth, "##0") + ")"
        ElseIf InStr(FieldType, "整型") Then
            FieldType = "Integer"
        ElseIf InStr(FieldType, "短整型") Then
            FieldType = "SmallInt"
        ElseIf InStr(FieldType, "浮点型") Then
            FieldType = "Float"
        ElseIf InStr(FieldType, "十进制型") Then
            FieldType = "Decimal(" + Format(NumWidth, "##0") + "," + Format(NumDec, "##0") + ")"
        ElseIf InStr(FieldType, "日期型") Then
            FieldType = "Date"
        ElseIf InStr(FieldType, "逻辑型") Then
            FieldType = "Logical"
        End If
        
        Columns(I) = FieldName
        ColumnsType(I) = FieldType
    Next I

    CommonDialog1.Filter = "MapInfo Tables (*.tab)|*.tab"
    CommonDialog1.InitDir = TheMapInfoPath
    CommonDialog1.FileName = "新文件" 'TheOutFile
    
    CommonDialog1.FilterIndex = 0
    CommonDialog1.ShowSave
    
    If Err <> 32755 Then    ' User chose Cancel.
        I = InStr(CommonDialog1.FileName, CommonDialog1.FileTitle)
        TheOutPath = Left(CommonDialog1.FileName, I - 1)
        TheOutFile = CommonDialog1.FileTitle
        I1 = InStr(TheOutFile, ".")
        I2 = InStr(I1 + 1, TheOutFile, ".")
        If (I2 > I1) Then
            TheOutFile = Left(TheOutFile, I2 - 1)
        End If
        DirFile = Dir(TheOutPath + TheOutFile)
        If (DirFile <> "") Then
            I = MsgBox(TheOutPath + TheOutFile + "文件已存在,是否覆盖? ", vbYesNo, "关于文件存盘 ")
            If (I = vbNo) Then Exit Sub
        End If
    Else
        Exit Sub
    End If
    
    iMapper = Check2.Value
    
    I = InStr(TheOutFile, ".")
    If (I > 0) Then
        TableName = Left(TheOutFile, I - 1)
    Else
        TableName = TheOutFile
    End If
    Call CloseExistTable(TableName)

    Temp = "Create Table " + TableName + "("
    For I = 1 To ColumnsN - 1
        Temp = Temp + Columns(I) + " " + ColumnsType(I) + ","
    Next I
    Temp = Temp + Columns(ColumnsN) + " " + ColumnsType(ColumnsN) + ")"

    Temp = Temp + " FILE " + """" + TheOutPath + TableName + """"
    '创建一个新表
    MapInfo.Do Temp

    '使表可地图化
    If (iMapper = 1) Then
        MapInfo.Do "Create Map For " & TableName & " Coordsys Earth"
        MapInfo.Do "Set Distance Units ""km"""
        MapInfo.Do "Set CoordSys Earth Projection 1,0"
    End If

    
    bOKCancel = True
    Unload Me
End Sub
Private Sub Command4_Click()
    bOKCancel = False
    Unload Me
End Sub

'删除一个字段
Private Sub delete_Click()
    Grid1.RemoveItem (Row)
    If (Row = Grid1.Rows) Then
        Row = Row - 1
    End If
    Grid1.RowSel = Row
    Grid1_Click
    
    '添加
    If (Grid1.Rows = 2) Then
        Delete.Enabled = False
    End If
End Sub
Private Sub down_Click()
    If Grid1.RowSel < Grid1.Rows - 1 Then
        Grid1.RowPosition(Grid1.RowSel) = Grid1.RowSel + 1
        Grid1.RowSel = Grid1.RowSel + 1
    End If
End Sub

'字段名
Private Sub fieldname_Change()
    Grid1.TextMatrix(Row, 0) = FieldName.Text
End Sub

'字段宽
Private Sub fieldwidth_Change()
   If combo1.ListIndex = 0 Then '字符串
      Grid1.TextMatrix(Row, 1) = Trim(combo1.Text) + "[" + Trim(fieldwidth.Text) + "]"
   ElseIf combo1.ListIndex = 4 Then '十进制
      Grid1.TextMatrix(Row, 1) = Trim(combo1.Text) + "[" + Trim(fieldwidth.Text) + "," + Trim(Text3.Text) + "]"
   End If
End Sub
Private Sub Form_Load()

    bOKCancel = False
    Row = 1
    combo1.ListIndex = 0
    Check1_Click
    
    If (iOpenBrowser = 1) Then '打开新的浏览窗口
        Command2.Enabled = False
        
        Check2.Value = 0
        Check2.Enabled = True
    End If
    
    If (iOpenNewMap = 1) Then '创建新的地图窗口
        Command2.Enabled = True
        
        Check2.Value = 1
        Check2.Enabled = False
    End If
    If (iAddCurMap = 1) Then '添加到当前图层
        Command2.Enabled = True
        
        Check2.Value = 1
        Check2.Enabled = False
    End If
 End Sub
Private Sub Grid1_Click()
    Dim tmpStr As String
    Dim TmpNum As Integer
         
    Row = Grid1.Row
    FieldName = Grid1.TextMatrix(Row, 0)
    tmpStr = Grid1.TextMatrix(Row, 1)
   
    If InStr(tmpStr, "[") > 0 Then
        TmpNum = InStr(tmpStr, "[")
        tmpStr = Mid(tmpStr, TmpNum + 1, Len(tmpStr) - TmpNum - 1)
        If InStr(tmpStr, ",") > 0 Then
            combo1.ListIndex = 4 '十进制
            fieldwidth.Text = Left(tmpStr, InStr(tmpStr, ",") - 1)
            Text3.Text = Right(tmpStr, Len(tmpStr) - InStr(tmpStr, ","))
        Else
            combo1.ListIndex = 0
            fieldwidth.Text = tmpStr
        End If
    Else
        combo1.Text = Trim(tmpStr)
        fieldwidth.Enabled = False
        Text3.Enabled = False
    End If
   
    Check1.Value = Val(Grid1.TextMatrix(Row, 2))
End Sub

'小数位数
Private Sub Text3_Change()
    If Trim(Text3.Text) = "" Then Text3.Text = "0"
    Grid1.TextMatrix(Row, 1) = Trim(combo1.Text) + "[" + Trim(fieldwidth.Text) + "," + Trim(Text3.Text) + "]"
End Sub
Private Sub up_Click()
    If Grid1.RowSel > 1 Then
        Grid1.RowPosition(Grid1.RowSel) = Grid1.RowSel - 1
        Grid1.RowSel = Grid1.RowSel - 1
    End If
End Sub