db_t_def.bas

三角形闭合差计算程序

Attribute VB_Name = "DB_Table_Def"
Sub D(Ier)
'定义数据库表
Dim ObsDataTd As TableDef '观测数据表
Dim PotNameTd As TableDef '点名表
Dim LevDirValTd As TableDef '水平方向值表
Dim CalResultTd As TableDef '计算成果表
Dim BInfTd As TableDef '基本信息表
Dim InfTd As TableDef '信息表
Dim RepHeadTd As TableDef '报表表头表
Dim RepDataTd As TableDef '报表数据表
Dim ProInfTd As TableDef '项目信息表
'定义数据库字段
Dim ObsDataFlds(4) As Field, PotNameFlds(2) As Field
Dim CalResultFlds(8) As Field, BInfFlds(8) As Field
Dim RepHeadFlds(3) As Field, RepDataFlds(8) As Field
Dim LevDirValFlds(5) As Field, 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 CalResultTd = g_d_Base.CreateTableDef("观测成果表")
    Set LevDirValTd = g_d_Base.CreateTableDef("水平方向值表")
    Set BInfTd = g_d_Base.CreateTableDef("基本信息表")
    Set InfTd = g_d_Base.CreateTableDef("信息表")
    Set RepDataTd = g_d_Base.CreateTableDef("报表数据表")
    Set RepHeadTd = 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)
    Set ObsDataFlds(4) = ObsDataTd.CreateField("测回数", dbDouble)
    
'4   用 Append 方法把每个字段添加到表中，并把每个表添加到数据库中，如下所示：
    For I = 0 To 4
         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)
    'Set PotNameFlds(2) = PotNameTd.CreateField("点名2", dbText, 10)
    'Set PotNameFlds(3) = PotNameTd.CreateField("点名3", dbText, 10)
    Set PotNameFlds(2) = PotNameTd.CreateField("水平方向值()", dbDouble)
    For I = 0 To 2
        PotNameTd.Fields.Append PotNameFlds(I)
    Next I
    g_d_Base.TableDefs.Append PotNameTd

    '建立水平方向值表
    Set LevDirValFlds(0) = LevDirValTd.CreateField("序号", dbInteger)
    'Set LevDirValFlds(1) = LevDirValTd.CreateField("点名", dbText, 10)
    Set LevDirValFlds(1) = LevDirValTd.CreateField("测站名", dbDouble)
    Set LevDirValFlds(2) = LevDirValTd.CreateField("目标名", dbDouble)
    Set LevDirValFlds(3) = LevDirValTd.CreateField("水平方向值", dbText, 10)
    Set LevDirValFlds(4) = LevDirValTd.CreateField("测回数", dbDouble)
    Set LevDirValFlds(5) = LevDirValTd.CreateField("平均值", dbDouble)
    For I = 0 To 5
        LevDirValTd.Fields.Append LevDirValFlds(I)
    Next I
    g_d_Base.TableDefs.Append LevDirValTd

    '建立计算成果表
    Set CalResultFlds(0) = CalResultTd.CreateField("序号", dbInteger)
    Set CalResultFlds(1) = CalResultTd.CreateField("点名1", dbText, 10)
    Set CalResultFlds(2) = CalResultTd.CreateField("点名2", dbText, 10)
    Set CalResultFlds(3) = CalResultTd.CreateField("点名3", dbText, 10)
    Set CalResultFlds(4) = CalResultTd.CreateField("角度值1", dbDouble)
    Set CalResultFlds(5) = CalResultTd.CreateField("角度值2", dbDouble)
    Set CalResultFlds(6) = CalResultTd.CreateField("角度值3", dbDouble)
    Set CalResultFlds(7) = CalResultTd.CreateField("三角形内角和", dbDouble)
    Set CalResultFlds(8) = CalResultTd.CreateField("三角形闭合差", dbDouble)
    'Set CalResultFlds(6) = CalResultTd.CreateField("平差值中误差(MM)", dbDouble)
    'Set CalResultFlds(7) = CalResultTd.CreateField("多余观测分量", dbDouble)
    'Set CalResultFlds(8) = CalResultTd.CreateField("标准余差统计量", dbDouble)
    For I = 0 To 8
        CalResultTd.Fields.Append CalResultFlds(I)
    Next I
    g_d_Base.TableDefs.Append CalResultTd
    
    '创建基本信息表
    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, 20)
    'Set BInfFlds(8) = BInfTd.CreateField("高程系统", dbText, 20)
    'Set BInfFlds(9) = BInfTd.CreateField("已知点个数", dbInteger)
    'Set BInfFlds(10) = BInfTd.CreateField("未知点个数", dbInteger)
    Set BInfFlds(8) = BInfTd.CreateField("观测值个数", dbInteger)
    'Set BInfFlds(12) = BInfTd.CreateField("是否用验后方差", dbText, 5)
    'Set BInfFlds(13) = BInfTd.CreateField("水准尺的读数是否加倍", dbText, 5)
    'Set BInfFlds(14) = BInfTd.CreateField("验前方差(MM)", dbDouble)
    'Set BInfFlds(15) = BInfTd.CreateField("验后方差(MM)", dbDouble)
    For I = 0 To 8
        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