db_table_def.bas

该程序是三角网平差程序

Attribute VB_Name = "DB_Table_def"
Sub DB_T_Def(Ier)
'定义数据库表
Dim ObsDataTd As TableDef '观测数据表
Dim PotNameTd As TableDef '点名表
Dim TrangleClosureErrorTd As TableDef '//三角形闭合差成果表

Dim BInfTd As TableDef '基本信息表
Dim InfTd As TableDef '信息表

Dim ProInfTd As TableDef '项目信息表
'定义数据库字段
Dim ObsDataFlds(3) As Field, PotNameFlds(1) As Field
Dim BInfFlds(10) As Field
Dim TrangleClosureErrorFlds(4) As Field
Dim InfFlds(4) As Field
Dim ProInfFlds(1) As Field
Dim tmp As String, i As Integer

Dim arecord As Recordset
    
' On Error GoTo 100
'1   使用 Workspace 对象的 CreateDatabase 方法创建新的数据库。在本例中，
'该方法使用了两个参量：一个用以指定数据库的名称，一个用以指定区域：
    Set g_MyWs = DBEngine.Workspaces(0)
    Set g_d_Base = g_MyWs.CreateDatabase(g_projectfile, dbLangGeneral, dbVersion30)
    
'    注意  常数 dbVersion30 指定了 Jet version 3.0 数据库。
'如果使用 dbVersion30 常数创建 3.0 版的数据库，则只有使用 Jet 3.0
'或更高版本引擎的 32 位的应用程序才能访问该数据库。
'2   使用 Database 对象的 CreateTableDef 方法为数据库中
'的所有表创建新的 TableDef 对象，如下所示：
    Set ObsDataTd = g_d_Base.CreateTableDef("观测数据表")
    Set PotNameTd = g_d_Base.CreateTableDef("点名表")
    Set TrangleClosureErrorTd = g_d_Base.CreateTableDef("三角形闭合差")
    Set BInfTd = g_d_Base.CreateTableDef("基本信息表")
    Set InfTd = g_d_Base.CreateTableDef("信息表")
    Set ProInfTd = g_d_Base.CreateTableDef("项目信息表")
'3   使用 TableDef 对象的 CreateField 方法，
'为表中每个字段创建 Field 对象，然后设置每一字段的属性来定义字段长度、
'数据类型和其它所需的属性。例如，下面的代码用以创建 Biblio.mdb 数据库中
'的 Authors 表：
    '建立项目信息表
    Set ProInfFlds(0) = ProInfTd.CreateField("项目目录", dbText, 100)
    ProInfTd.Fields.Append ProInfFlds(0)
    g_d_Base.TableDefs.Append ProInfTd
    Set arecord = g_d_Base.OpenRecordset("项目信息表", dbOpenTable)
    With arecord
        .AddNew
        arecord.Fields(0) = g_ProDir
        .Update
        .Bookmark = .LastModified
    End With
    arecord.Close
    
    '建立观测数据表
    Set ObsDataFlds(0) = ObsDataTd.CreateField("序号", dbInteger)
    Set ObsDataFlds(1) = ObsDataTd.CreateField("测站", dbText, 10)
    Set ObsDataFlds(2) = ObsDataTd.CreateField("照准点", dbText, 10)
    Set ObsDataFlds(3) = ObsDataTd.CreateField("观测值", dbDouble)

    
'4   用 Append 方法把每个字段添加到表中，并把每个表添加到数据库中，如下所示：
    For i = 0 To 3
         ObsDataTd.Fields.Append ObsDataFlds(i)
    Next i
    g_d_Base.TableDefs.Append ObsDataTd
        
    '建立点名表
    Set PotNameFlds(0) = PotNameTd.CreateField("序号", dbInteger)
    Set PotNameFlds(1) = PotNameTd.CreateField("点名", dbText, 10)
    For i = 0 To 1
        PotNameTd.Fields.Append PotNameFlds(i)
    Next i
    g_d_Base.TableDefs.Append PotNameTd
    
'建立三角形闭合差表
        Set TrangleClosureErrorFlds(0) = TrangleClosureErrorTd.CreateField("序号", dbInteger)
        Set TrangleClosureErrorFlds(1) = TrangleClosureErrorTd.CreateField("点名1", dbText, 10)
        Set TrangleClosureErrorFlds(2) = TrangleClosureErrorTd.CreateField("点名2", dbText, 10)
        Set TrangleClosureErrorFlds(3) = TrangleClosureErrorTd.CreateField("点名3", dbText, 10)
        Set TrangleClosureErrorFlds(4) = TrangleClosureErrorTd.CreateField("三角形闭合差", dbDouble)
        For i = 0 To 4
          TrangleClosureErrorTd.Fields.Append TrangleClosureErrorFlds(i)
        Next i
     g_d_Base.TableDefs.Append TrangleClosureErrorTd
     
      '创建基本信息表
    Set BInfFlds(0) = BInfTd.CreateField("项目名称", dbText, 20)
    Set BInfFlds(1) = BInfTd.CreateField("项目地点", dbText, 20)
    Set BInfFlds(2) = BInfTd.CreateField("仪器名称", dbText, 10)
    Set BInfFlds(3) = BInfTd.CreateField("仪器编号", dbText, 10)
    Set BInfFlds(4) = BInfTd.CreateField("观测者", dbText, 10)
    Set BInfFlds(5) = BInfTd.CreateField("观测日期", dbText, 20)
    Set BInfFlds(6) = BInfTd.CreateField("计算者", dbText, 10)
    Set BInfFlds(7) = BInfTd.CreateField("计算日期", dbText, 10)
    Set BInfFlds(8) = BInfTd.CreateField("三角网点的个数", dbInteger)
    Set BInfFlds(9) = BInfTd.CreateField("观测值个数", dbInteger)
    Set BInfFlds(10) = BInfTd.CreateField("水平方向中误差", dbDouble)
    For i = 0 To 10
        BInfTd.Fields.Append BInfFlds(i)
    Next i
    g_d_Base.TableDefs.Append BInfTd
    
    '创建信息表
    Set InfFlds(0) = InfTd.CreateField("建表信息1", dbInteger)
    Set InfFlds(1) = InfTd.CreateField("建表信息2", dbInteger)
    For i = 0 To 1
        InfTd.Fields.Append InfFlds(i)
    Next i
    g_d_Base.TableDefs.Append InfTd
    
    Set arecord = g_d_Base.OpenRecordset("信息表", dbOpenTable)
        With arecord
                .AddNew
                .Fields(0) = 0
                .Fields(1) = 0
                .Update
                .Bookmark = .LastModified
        End With
        arecord.Close
    Ier = 0
    g_d_Base.Close
    Set g_d_Base = g_MyWs.OpenDatabase(g_projectfile)
    Exit Sub
    
100:

    Ier = 1
End Sub