formnewtable.frm

采用三角化的方法基于mapinfo的等值线算法例子。

'''''    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
Private Sub Form_Load()

End Sub