module1.bas

用于控制氧乐果生产的程序

        End If
    End With
    fyfNum = 2
    strCanShu = strWenDu
Case "fyf3_fyfWenDu"
    With baojingfrm.List1
        If IsOutOfRange Then
        .List(3) = CStr(BaoJingTime) + "  " + str3 + strWenDu + "  " + strUp
        strType = strUp
        Else
        strType = strOK
        .List(3) = CStr(BaoJingTime) + "  " + str3 + strWenDu + "  " + strOK
        End If
    End With
    fyfNum = 3
    strCanShu = strWenDu
End Select
With Bjrs
    .AddNew
    .Fields("fyfnum") = fyfNum
    .Fields("date") = Date
    .Fields("time") = BaoJingTime
    .Fields("canshu") = strCanShu
    .Fields("neirong") = strType
    .Update
End With
End Sub
'************************
'控制量输出过程
'************************
Public Sub A_out(ByVal BaseAddress As Integer, _
ByVal Channel As Integer, ByVal tlfKaiDu As Single, _
ByVal fyfNum As Integer)
Dim Num, KaiDuInCurrent As Single
Dim HighByte, LowByte As Byte
Dim deltaAddress, Num1 As Integer
If tlfKaiDu = 100 Then
    Num1 = 4095
Else
    Num1 = 4096
End If
KaiDuInCurrent = 16 * tlfKaiDu / 100 + 4
Num = (KaiDuInCurrent - 4) * Num1 / 16
If Num <= gintKaiDuXiaXian(fyfNum) Then Num = gintKaiDuXiaXian(fyfNum)
'******************************************
'使用中泰板卡(高8位,低4位)请注释b1,b2语句,
'解注释a1,a2,a3语句
'******************************************
a1: HighByte = Int(Num / 16)
a2: LowByte = (Num - HighByte * 16)

'******************************************
'使用备用板卡(高4位,低8位)请注释a1,a2,a3
'语句,解注释b1,b2语句
'******************************************
'b1: HighByte = Int(Num / 256)
'b2: LowByte = (Num - HighByte * 256)

deltaAddress = 2 * (Channel - 1)

'Call MyOutportb(BaseAddress + deltaAddress, HighByte)
'Call MyOutportb(BaseAddress + deltaAddress + 1, LowByte)

'a3: Num = MyInportb(BaseAddress + 0)
End Sub
Public Sub WriteBlackBox()
Dim bbdb As Database
Dim bbRec As Recordset
Set bbdb = DBEngine.Workspaces(0).OpenDatabase("d:\ylg2\lsdata\lsjl.mdb")
Set bbRec = Lsdb.OpenRecordset("blackbox")
With bbRec
    .AddNew
    .Fields("riqi") = Date
    .Fields("shijian") = Time
    .Fields("name") = gstrUserName
    .Fields("caozuo") = gstrCaoZuo
    .Update
End With
End Sub
Public Sub tlBeginOrEndWriteRecord(ByVal BatchRec As Recordset, _
ByVal DetailRec As Recordset, ByVal ContinousRec As Recordset, _
ByVal fyfIndex As Integer, ByVal strNote As String, ByVal IsBegin As Boolean)
With BatchRec
    If IsBegin Then
        .AddNew
        .Fields("riqi") = Date
        .Fields("starttime") = Time
        .Fields("yjatouliaoliang") = gyjaTouLiaoLiang(fyfIndex)
        .Fields("jingzhiliang") = gJingZhiLiang(fyfIndex)
        .Fields("caozuogong") = gstrUserName
        .Fields("chushiyewei") = gjlgStartYewei(fyfIndex)
        .Fields("jieshuyewei") = gjlgEndYewei(fyfIndex)
    Else
        .MoveLast
        .Edit
        .Fields("endtime") = Time
    End If
    .Update
End With
With DetailRec
    .AddNew
    .Fields("riqi") = Date
    .Fields("currenttime") = Time
    .Fields("fyfwendu") = gfyfWenDu(fyfIndex)
    .Fields("jlgyewei") = gjlgYeWei(fyfIndex)
    .Fields("tlfkaidu") = gtlfaKaiDu(fyfIndex)
    .Fields("yjaliuliang") = gyjaLiuLiang(fyfIndex)
    .Fields("lqyswendu") = glqysWenDu
    .Fields("note") = strNote
    .Update
End With
With ContinousRec
    .AddNew
    .Fields("riqi") = Date
    .Fields("currenttime") = Time
    .Fields("fyfwendu") = gfyfWenDu(fyfIndex)
    .Fields("jlgyewei") = gjlgYeWei(fyfIndex)
    .Fields("tlfkaidu") = gtlfaKaiDu(fyfIndex)
    .Fields("yjaliuliang") = gyjaLiuLiang(fyfIndex)
    .Fields("lqyswendu") = glqysWenDu
    .Fields("note") = strNote
    .Update
End With
End Sub
Public Sub Inform(ByVal InformationIndex As Integer)
    On Error Resume Next
    frmInformation.Index = InformationIndex
    frmInformation.Show vbModal
End Sub
Public Sub GotFocusAgain(ByVal myTextBox As TextBox)
With myTextBox
    .SelStart = 0
    .SelLength = Len(.Text)
End With
End Sub
'*********************
'向数据库中写数据
'*********************
Public Sub WriteRecord()
Dim i As Integer
For i = 1 To 3
If gGongZuoZhuangTai(i) Then
    With Detaillsrs(i)
        .AddNew
        .Fields("riqi") = Date
        .Fields("currenttime") = Time
        .Fields("fyfwendu") = gfyfWenDu(i)
        .Fields("jlgyewei") = gjlgYeWei(i)
        .Fields("tlfkaidu") = gtlfaKaiDu(i)
        .Fields("yjaliuliang") = gyjaLiuLiang(i)
        .Fields("lqyswendu") = glqysWenDu
        .Update
    End With
End If
'***************************
'只要程序在运行，就写连续记录
'***************************
With Continousrs(i)
    .AddNew
    .Fields("riqi") = Date
    .Fields("currenttime") = Time
    .Fields("fyfwendu") = gfyfWenDu(i)
    .Fields("jlgyewei") = gjlgYeWei(i)
    .Fields("tlfkaidu") = gtlfaKaiDu(i)
    .Fields("yjaliuliang") = gyjaLiuLiang(i)
    .Fields("lqyswendu") = glqysWenDu
    If gGongZuoZhuangTai(i) Then
        .Fields("note") = "正在投料"
    Else
        .Fields("note") = "停止投料"
    End If
    .Update
End With
Next
End Sub
'***********************************************
'以下过程用来动态创建历史数据库(一天一个),数据库名
'为日期(如20001205.mdb),本工程中未用到，保留代码
'供以后升级参考
'***********************************************
'Public Sub CreateLSDB()
'Dim str1, strYear, strMonth, strDay As String
'strYear = CStr(Year(Date))
'strMonth = CStr(Month(Date))
'If Len(strMonth) < 2 Then strMonth = "0" + strMonth
'strDay = CStr(Day(Date))
'If Len(strDay) < 2 Then strDay = "0" + strDay
'gstrDBName1 = strYear + strMonth + strDay
'gstrDBName1 = "d:\ylg2\lsdata\" & gstrDBName1 & ".mdb"
'Dim WS As Workspace
'Dim DB As Database
'
'Dim tblCaoZuo(1 To 3), tblBatch(1 To 3), tblContinous(1 To 3) As TableDef
'Dim fldCZ(1 To 3, 0 To 16), fldBatch(1 To 3, 0 To 7), fldContinous(1 To 3, 0 To 7) As Field
'
'Dim tblBlackBox As TableDef
'Dim fldBlack(3) As Field
'
'Dim tblStat As TableDef
'Dim fldstat(7) As Field
'
'Dim i, j As Integer
'
'Set WS = DBEngine.Workspaces(0)
'
'Set DB = WS.CreateDatabase(gstrDBName1, dbLangGeneral, dbVersion30)
'
'For j = 1 To 3
'Set tblCaoZuo(j) = DB.CreateTableDef("batchls" + CStr(j))
'With tblCaoZuo(j)
'    Set fldCZ(j, 0) = .CreateField("riqi", dbDate, 8)
'    Set fldCZ(j, 1) = .CreateField("pici", dbInteger, 4)
'    Set fldCZ(j, 2) = .CreateField("banci", dbInteger, 4)
'    Set fldCZ(j, 3) = .CreateField("caozuogong", dbText, 15)
'    Set fldCZ(j, 4) = .CreateField("starttime", dbDate, 8)
'    Set fldCZ(j, 5) = .CreateField("end time", dbDate, 8)
'    Set fldCZ(j, 6) = .CreateField("fyfhao", dbInteger, 4)
'    Set fldCZ(j, 7) = .CreateField("jingzhiliang", dbSingle, 4)
'    Set fldCZ(j, 8) = .CreateField("toulufang", dbSingle, 4)
'    Set fldCZ(j, 9) = .CreateField("yjatouliaoliang", dbSingle, 4)
'    Set fldCZ(j, 10) = .CreateField("yansuan", dbSingle, 4)
'    Set fldCZ(j, 11) = .CreateField("bujialufang", dbSingle, 4)
'    Set fldCZ(j, 12) = .CreateField("zdph", dbSingle, 4)
'    Set fldCZ(j, 13) = .CreateField("hcyzongliang", dbSingle, 4)
'    Set fldCZ(j, 14) = .CreateField("chuliang", dbSingle, 4)
'    Set fldCZ(j, 15) = .CreateField("chushiyewei", dbSingle, 4)
'    Set fldCZ(j, 16) = .CreateField("jieshuyewei", dbSingle, 4)
'    For i = 0 To 16
'        .Fields.Append fldCZ(j, i)
'    Next
'End With
'DB.TableDefs.Append tblCaoZuo(j)
'
'Set tblBatch(j) = DB.CreateTableDef("detaills" + CStr(j))
'With tblBatch(j)
'    Set fldBatch(j, 0) = .CreateField("riqi", dbDate, 8)
'    Set fldBatch(j, 1) = .CreateField("currenttime", dbDate, 8)
'    Set fldBatch(j, 2) = .CreateField("fyfwendu", dbSingle, 4)
'    Set fldBatch(j, 3) = .CreateField("jlgyewei", dbSingle, 4)
'    Set fldBatch(j, 4) = .CreateField("tlfkaidu", dbSingle, 4)
'    Set fldBatch(j, 5) = .CreateField("yjaliuliang", dbSingle, 4)
'    Set fldBatch(j, 6) = .CreateField("lqyswendu", dbSingle, 4)
'    Set fldBatch(j, 7) = .CreateField("note", dbText, 15)
'    For i = 0 To 7
'        .Fields.Append fldBatch(j, i)
'    Next
'End With
'DB.TableDefs.Append tblBatch(j)
'
'Set tblContinous(j) = DB.CreateTableDef("continous" + CStr(j))
'With tblContinous(j)
'    Set fldContinous(j, 0) = .CreateField("riqi", dbDate, 8)
'    Set fldContinous(j, 1) = .CreateField("currenttime", dbDate, 8)
'    Set fldContinous(j, 2) = .CreateField("fyfwendu", dbSingle, 4)
'    Set fldContinous(j, 3) = .CreateField("jlgyewei", dbSingle, 4)
'    Set fldContinous(j, 4) = .CreateField("tlfkaidu", dbSingle, 4)
'    Set fldContinous(j, 5) = .CreateField("yjaliuliang", dbSingle, 4)
'    Set fldContinous(j, 6) = .CreateField("lqyswendu", dbSingle, 4)
'    Set fldContinous(j, 7) = .CreateField("note", dbText, 15)
'    For i = 0 To 7
'        .Fields.Append fldContinous(j, i)
'    Next
'End With
'DB.TableDefs.Append tblContinous(j)
'Next
'
'Set tblBlackBox = DB.CreateTableDef("blackbox")
'With tblBlackBox
'    Set fldBlack(0) = .CreateField("riqi", dbDate, 8)
'    Set fldBlack(1) = .CreateField("shijian", dbDate, 8)
'    Set fldBlack(2) = .CreateField("name", dbText, 15)
'    Set fldBlack(3) = .CreateField("caozuo", dbText, 15)
'    For i = 0 To 3
'        .Fields.Append fldBlack(i)
'    Next
'End With
'DB.TableDefs.Append tblBlackBox
'
'Set tblStat = DB.CreateTableDef("stat")
'With tblStat
'    Set fldstat(0) = .CreateField("no", dbText, 15)
'    Set fldstat(1) = .CreateField("jzl", dbSingle, 4)
'    Set fldstat(2) = .CreateField("tlf", dbSingle, 4)
'    Set fldstat(3) = .CreateField("yjal", dbSingle, 4)
'    Set fldstat(4) = .CreateField("ys", dbSingle, 4)
'    Set fldstat(5) = .CreateField("bjlf", dbSingle, 4)
'    Set fldstat(6) = .CreateField("hcyzl", dbSingle, 4)
'    Set fldstat(7) = .CreateField("cl", dbSingle, 4)
'    For i = 0 To 7
'        .Fields.Append fldstat(i)
'    Next
'End With
'DB.TableDefs.Append tblStat
'End Sub