?? 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 日期時(shí)間='" & 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 日期時(shí)間='" & 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("日期時(shí)間") = strDate_Time
rs.Update
Next i
rs.Close
'添加索引記錄
Query = "select * from gdhindex where 日期時(shí)間='" & 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("車數(shù)") = Trim(str(GD.Rows - 2))
rs.Fields("日期時(shí)間") = 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 "缺少打印內(nèi)容,無法打印"
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 = "黑體"
'打印主標(biāo)題
PrintString = Space(6) & "軌 道 衡 稱 重 原 始 計(jì) 量 單"
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) & "時(shí)間: " + Mid(Label3(0).Caption, 12, 5) + Space(4) & "編號: " + strNo
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -