gdhweight.frm

齐鲁石化某分公司的数据采集管理系统

    If Int(Val(ss)) >= 0 Then
        gdh_Print_Lline = Int(Val(ss))
    Else
        gdh_Print_Lline = 1
    
    End If
    
    ss = GetKeyValue(str_FilePath, "print", "spacecount", "0")
    If Int(Val(ss)) >= 0 Then
        gdh_Print_Spacecount = Int(Val(ss))
    Else
        gdh_Print_Spacecount = 0
    
    End If
    
    ss = GetKeyValue(str_FilePath, "print", "printmode", "L")
    If ss = "P" Then
        gdh_Print_Mode = "P"
    Else
        gdh_Print_Mode = "L"
    
    End If
    
    ss = GetKeyValue(str_FilePath, "mode", "printmode", "1")
    If Int(Val(ss)) = 0 Then
        gdh_Mode_Printmode = 0
    Else
        gdh_Mode_Printmode = 1
    
    End If
    
    ss = GetKeyValue(str_FilePath, "gprs", "path", "D:\RW\SEND")    '2007-1-11 //付建明
    If Right$(ss, 1) <> "\" Then
        ss = ss + "\"
    End If
    gdh_GPRS_Path = ss
    
    ss = GetKeyValue(str_FilePath, "gprs", "dates", "1")   '2007-1-11  //
    If Int(Val(ss)) >= 1 Then
        gdh_Gprs_Sdate = Int(Val(ss))
    Else
        gdh_Gprs_Sdate = 5
    End If
    
    ss = GetKeyValue(str_FilePath, "weight", "dbpath", "")    '2007-1-13 //付建明
    If ss = "" Then
        gdh_Weight_Dbpath = App.Path & "\"
    Else
        If Right$(ss, 1) <> "\" Then
            ss = ss + "\"
        End If
        gdh_Weight_Dbpath = ss
    End If
    
    str_FilePath = App.Path & "\editconfig.ini"
    For j = 0 To 9
        ss = GetKeyValue(str_FilePath, "page", "page" & j, "9")
        PageSize(j) = Int(Val(ss))
    Next j
    
    
ok:
End Function

Private Function myTrim(strtn As String) As String
    Dim i As Integer
    Dim j As Integer
    Dim strtemp As String
    j = 0
    If strtn <> "" Then
        For i = 1 To Len(strtn)
            strtemp = Mid(strtn, i, 1)
            If strtemp >= "0" And strtemp <= "9" Or strtemp >= "A" And strtemp <= "Z" Or strtemp >= "a" And strtemp <= "z" Or strtemp = "+" Then
                j = j + 1
            Else
                Exit For
            End If
        Next
    End If
    If j = 0 Then
        strtn = ""
    ElseIf j > 5 Then
        strtn = Mid(strtn, 1, 5)
    Else
        strtn = Mid(strtn, 1, j)
    End If
    myTrim = strtn
End Function

Function Read_Data_from_gdhysdb(strDate_Time As String, GD As MSHFlexGrid, DBPath As String)
    Dim db As New ADODB.Connection, rs As New ADODB.Recordset
    Dim i As Integer
    Dim Query As String, table_Name As String, dbName As String
    Dim FulldbPath As String
    On Error GoTo ok
    
    GD.Rows = 2
    For i = 0 To GD.Cols - 1
        GD.TextMatrix(1, i) = ""
    Next i
    i = 0
    Select Case Mid(strDate_Time, 6, 2)
        Case "01"
            table_Name = "gdh" & "01"
        Case "02"
            table_Name = "gdh" & "02"
        Case "03"
            table_Name = "gdh" & "03"
        Case "04"
            table_Name = "gdh" & "04"
        Case "05"
            table_Name = "gdh" & "05"
        Case "06"
            table_Name = "gdh" & "06"
        Case "07"
            table_Name = "gdh" & "07"
        Case "08"
            table_Name = "gdh" & "08"
        Case "09"
            table_Name = "gdh" & "09"
        Case "10"
            table_Name = "gdh" & "10"
        Case "11"
            table_Name = "gdh" & "11"
        Case "12"
            table_Name = "gdh" & "12"
        Case Else
            Exit Function
    End Select
    
    dbName = "gdhys" & Mid(strDate_Time, 1, 4) & ".mdb"
    FulldbPath = DBPath & "\" & dbName
    
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & FulldbPath & ";Jet OLEDB:Database Password=dfrw2306;"
    
'    Set db = OpenDatabase(dbPath & "\" & dbName, False, False, ";pwd=1")
    Query = "select * from " & table_Name & " where 日期时间='" & strDate_Time & "' order by 序号 ASC"
'    Set rs = db.OpenRecordset(Query)
    rs.Open Query, db, adOpenDynamic, adLockOptimistic
    If Not rs.BOF And Not rs.EOF Then
        rs.MoveFirst
        Do While Not rs.EOF
            i = i + 1
            GD.Rows = GD.Rows + 1
            GD.TextMatrix(i, Col(0)) = Trim(str(rs.Fields("序号").Value))
            GD.TextMatrix(i, Col(1)) = Trim(rs.Fields("车型").Value)
            GD.TextMatrix(i, Col(2)) = Trim(rs.Fields("车号").Value)
            GD.TextMatrix(i, Col(3)) = Trim(str(rs.Fields("毛重").Value))
            GD.TextMatrix(i, Col(8)) = Trim(str(rs.Fields("速度").Value))
            rs.MoveNext
        Loop
    End If
    
    rs.Close
    db.Close
ok:
End Function

Function Save_Data_to_gdhys(strDate_Time As String, v_Direction As String, GD As MSHFlexGrid, dbsavePath As String) As Boolean
    Dim db As New ADODB.Connection, rs As New ADODB.Recordset
    Dim i As Integer, j As Integer
    Dim Query As String, table_Name As String, dbName As String
    Dim FulldbPath As String
    On Error GoTo ok
    
    If GD.Rows = 2 Or GD.TextMatrix(1, 0) = "" Then
        Exit Function
    End If
    
    Select Case Mid(strDate_Time, 6, 2)
        Case "01"
            table_Name = "gdh" & "01"
        Case "02"
            table_Name = "gdh" & "02"
        Case "03"
            table_Name = "gdh" & "03"
        Case "04"
            table_Name = "gdh" & "04"
        Case "05"
            table_Name = "gdh" & "05"
        Case "06"
            table_Name = "gdh" & "06"
        Case "07"
            table_Name = "gdh" & "07"
        Case "08"
            table_Name = "gdh" & "08"
        Case "09"
            table_Name = "gdh" & "09"
        Case "10"
            table_Name = "gdh" & "10"
        Case "11"
            table_Name = "gdh" & "11"
        Case "12"
            table_Name = "gdh" & "12"
        Case Else
            Exit Function
    End Select
    
    dbName = "gdhys" & Mid(strDate_Time, 1, 4) & ".mdb"
    FulldbPath = dbsavePath & dbName
    
    db.CursorLocation = adUseClient
    db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & FulldbPath & ";Jet OLEDB:Database Password=dfrw2306;"
    
'    Set db = OpenDatabase(dbsavePath & dbName, False, False, "; pwd=1")
    Query = "select * from " & table_Name & " where 日期时间='" & strDate_Time & "'"
'    Set rs = db.OpenRecordset(Query)
    rs.Open Query, db, adOpenDynamic, adLockOptimistic
    
    If Not rs.BOF And Not rs.EOF Then
        rs.MoveFirst
        Do While Not rs.EOF
            rs.Delete
            rs.MoveNext
        Loop
    End If
    
    For i = 1 To GD.Rows - 2
        rs.AddNew
        rs.Fields("序号") = Int(Val(GD.TextMatrix(i, Col(0))))
        rs.Fields("车型") = Trim(GD.TextMatrix(i, Col(1)))
        rs.Fields("车号") = Trim(GD.TextMatrix(i, Col(2)))
        rs.Fields("毛重") = Trim(GD.TextMatrix(i, Col(3)))
        rs.Fields("速度") = Trim(GD.TextMatrix(i, Col(8)))
        rs.Fields("方向") = v_Direction
        rs.Fields("日期时间") = strDate_Time
        rs.Update
    Next i
    rs.Close
    
    '添加索引记录
    Query = "select * from gdhindex where 日期时间='" & strDate_Time & "'"
'    Set rs = db.OpenRecordset(Query)
    rs.Open Query, db, adOpenDynamic, adLockOptimistic
    
    If Not rs.BOF And Not rs.EOF Then
    Else
        rs.AddNew
        rs.Fields("车数") = Trim(str(GD.Rows - 2))
        rs.Fields("日期时间") = strDate_Time
        rs.Fields("方向") = v_Direction
        rs.Update
    End If
    rs.Close
    
    db.Close
    Save_Data_to_gdhys = True
    Exit Function
ok:
End Function

Function Save_Data_to_File(str_FilePath As String, GD As MSHFlexGrid, strDate_Time As String, v_Direction As String)
    
    Dim strLine As String
    Dim j As Integer
    Dim i As Integer
    Dim FileNo As Integer
    On Error GoTo ok
'    str_FilePath = App.Path & "\tempfile.tpr"
    If Dir(str_FilePath) <> "" Then
        Kill str_FilePath
    End If
    
    If GD.Rows = 2 Or GD.TextMatrix(1, 0) = "" Then
        Exit Function
    End If
    
    FileNo = FreeFile
    Open str_FilePath For Output As #FileNo
    Print #FileNo, "GDHW"
    strLine = "序号" + "|" + "车号" + "|" + "车型" + "|" + "毛重" + "|" + "速度" + "|"
    Print #FileNo, strLine
    Print #FileNo, strDate_Time
    Print #FileNo, v_Direction
    Print #FileNo, Trim(str(GD.Rows - 2))
    
    For i = 1 To GD.Rows - 2
        strLine = ""
        strLine = strLine + Trim(GD.TextMatrix(i, Col(0))) + "|"
        strLine = strLine + Trim(GD.TextMatrix(i, Col(2))) + "|"
        strLine = strLine + Trim(GD.TextMatrix(i, Col(1))) + "|"
        strLine = strLine + Trim(GD.TextMatrix(i, Col(3))) + "|"
        strLine = strLine + Trim(GD.TextMatrix(i, Col(8))) + "|"
        Print #FileNo, strLine
    Next i
    Close #FileNo
ok:
End Function

Function Save_Zero_to_File(str_FilePath As String, strDate_Time As String)
    Dim strLine As String
    Dim FileNo As Integer
    Dim j As Integer
    On Error GoTo ok
    
    FileNo = FreeFile
    Open str_FilePath For Output As #FileNo
    
    Print #FileNo, "GDHZ"
    Print #FileNo, strDate_Time
    
    For j = 0 To 11
        strLine = strLine + Trim(Text1(j).text) + "|"
    Next j
    Print #FileNo, strLine
    
    Close #FileNo
    
ok:
End Function

Function Weight_Exit()
    On Error GoTo ok
    If Goods_Vehicle_Exist = True Then
        Call Save_Data_to_File(gdh_GPRS_Path & "gprssend.tpr", MSHFlexGrid1, Trim(Label3(0).Caption), Trim(Label3(1).Caption))
        
        Call CreatDB(Mid(Trim(Label3(0).Caption), 1, 4))
        If Check1.Value = 1 Then
            
            Call Save_Data_to_gdhys(Trim(Label3(0).Caption), Trim(Label3(1).Caption), MSHFlexGrid1, gdh_Weight_Dbpath)
            Call Save_Data_to_File(App.Path & "\tempfile.tpr", MSHFlexGrid1, Trim(Label3(0).Caption), Trim(Label3(1).Caption))
            If gdh_Weight_Savetofile = 1 Then
                Dim str_FilePath As String
                str_FilePath = Mid(Trim(Label3(0).Caption), 1, 4) + Mid(Trim(Label3(0).Caption), 6, 2) + Mid(Trim(Label3(0).Caption), 9, 2)
                str_FilePath = str_FilePath + Mid(Trim(Label3(0).Caption), 12, 2) + Mid(Trim(Label3(0).Caption), 15, 2)
                If Right$(gdh_Weight_Savepath, 1) <> "\" Then
                    str_FilePath = gdh_Weight_Savepath + "\" + str_FilePath + ".txt"
                Else
                    str_FilePath = gdh_Weight_Savepath + str_FilePath + ".txt"
                End If
                Call Save_Data_to_File(str_FilePath, MSHFlexGrid1, Trim(Label3(0).Caption), Trim(Label3(1).Caption))
            
            End If
        End If
        
        If Me.Check2.Value = 1 Then
            If gdh_Print_Mode = "P" Then
                Call totalPrint(MSHFlexGrid1.Rows - 2)
            Else
                Call Line_Print(MSHFlexGrid1)
            End If
        End If
        
    End If
    Goods_Vehicle_Exist = False
ok:
End Function

Private Function totalPrint(RecordCount As Integer)
    Dim i As Integer, j As Integer, px As Long, py As Long
    Dim tt As Integer, printCount As Integer
    Dim intTotal As Single
    Dim strTotal As String
    Dim PrintString As String
    Dim strNo As String
    On Error GoTo ok
    
    If MSHFlexGrid1.Rows = 2 Or MSHFlexGrid1.TextMatrix(1, 0) = "" Then
        MsgBox "缺少打印内容，无法打印"
        Exit Function
    End If
    
    If RecordCount <= 10 Then
        Printer.PaperSize = PageSize(0)
    ElseIf RecordCount > 10 And RecordCount <= 20 Then Printer.PaperSize = PageSize(1)
    ElseIf RecordCount > 20 And RecordCount <= 30 Then Printer.PaperSize = PageSize(2)
    ElseIf RecordCount > 30 And RecordCount <= 40 Then Printer.PaperSize = PageSize(3)
    ElseIf RecordCount > 40 And RecordCount <= 50 Then Printer.PaperSize = PageSize(4)
    ElseIf RecordCount > 50 And RecordCount <= 60 Then Printer.PaperSize = PageSize(5)
    ElseIf RecordCount > 60 And RecordCount <= 70 Then Printer.PaperSize = PageSize(6)
    ElseIf RecordCount > 70 And RecordCount <= 80 Then Printer.PaperSize = PageSize(7)
    ElseIf RecordCount > 80 And RecordCount <= 90 Then Printer.PaperSize = PageSize(8)
    Else
        Printer.PaperSize = PageSize(9)
    End If
    
    px = 500
    py = 100
    Printer.FontName = "黑体"
    '打印主标题
    PrintString = Space(6) & "轨 道 衡 称 重 原 始 计 量 单"
    tt = prnt11(px, py, 12, PrintString, 110)
    
    '打印说明信息
    strNo = Mid(Label3(0).Caption, 1, 4) + Mid(Label3(0).Caption, 6, 2) + Mid(Label3(0).Caption, 9, 2) + Mid(Label3(0).Caption, 12, 2) + Mid(Label3(0).Caption, 15, 2)
    PrintString = "日期: " + Mid(Label3(0).Caption, 1, 10) + Space(4) & "时间: " + Mid(Label3(0).Caption, 12, 5) + Space(4) & "编号: " + strNo