editpd.frm

一个酒厂派车单管理系统,很方便的系统

Pssum.Text = FormatNumber(Psum())
End Sub

Private Sub Command5_Click()
If MSG2.Rows > 2 Then
MSG2.RemoveItem (MSG2.RowSel)
Else
For s = 1 To MSG2.Cols - 1
MSG2.TextMatrix(1, s) = ""
Next
End If
Pssum.Text = FormatNumber(Psum())
SelrowP = 0
End Sub

Private Sub Command6_Click()
On Error Resume Next
s = 2
If MSG2.TextMatrix(1, 1) = "" Then
s = 2
Else
MSG2.Rows = MSG2.Rows + 1
s = MSG2.Rows
End If
For i = 0 To MSG2.Cols - 2
MSG2.TextMatrix(s - 1, i + 1) = p1(i).Text
p1(i).Text = ""
Next
Pssum.Text = FormatNumber(Psum())
If s > 6 Then
MsgBox "总行数不能超过6行！", 0 + 48 + 0
Command7.SetFocus
Exit Sub
End If
p1(0).SetFocus
End Sub

Private Sub Command7_Click()
If Flags(3) <> "1" Then MsgBox "无权操作！", 0 + 48 + 0: Exit Sub
If VbTextEx1.Text = "" Then MsgBox "发货日期不能为空！": VbTextEx1.SetFocus: Exit Sub
If VbTextEx2.Text = "" Then MsgBox "承运人不为空！", 0 + 48 + 0: VbTextEx2.SetFocus: Exit Sub
DBname = App.Path & "\xjdb.dll"
DBpass = "www.ahxc.net"
DBconn
If Conn.State = 1 Then Conn.Close
Conn.Open Connstr
If Rs.State = 1 Then Rs.Close
Rs.Open "select * from pd where pdcode='" & Trim(pdcode.Caption) & "'", Conn, 1, 3
If Rs.EOF And Rs.BOF Then
Rs.AddNew
End If
If pdcode.Caption <> "" Then Rs("pdcode") = Trim(pdcode.Caption)
If VbTextEx1.Text <> "" Then Rs("pddate") = CDate(VbTextEx1.Text)
If VbTextEx2.Text <> "" Then Rs("pdcyname") = Trim(VbTextEx2.Text)
If VbTextEx3.Text <> "" Then Rs("pdch") = Trim(VbTextEx3.Text)
If VbTextEx4.Text <> "" Then Rs("pdname") = Trim(VbTextEx4.Text)
If VbTextEx5.Text <> "" Then Rs("pdck") = Trim(VbTextEx5.Text)
If VbTextEx6.Text <> "" Then Rs("pdshdh") = Trim(VbTextEx6.Text)
If IsNumeric(Ssum()) = True Then Rs("pdhss") = Ssum()
If IsNumeric(Sjsum()) = True Then Rs("pdhjss") = Sjsum()
If IsNumeric(hqsum.Text) = True Then Rs("pdhqs") = CLng(hqsum.Text)
If IsNumeric(Pssum.Text) = True Then Rs("pdpss") = CLng(Pssum.Text)
If Text1.Text <> "" Then Rs("pdm1") = Trim(Text1.Text)
If Text2.Text <> "" Then Rs("pdm2") = Trim(Text2.Text)
Rs.Update
If Rs.State = 1 Then Rs.Close
AddH Trim(pdcode.Caption)
AddP Trim(pdcode.Caption)
MsgBox "[" & pdcode.Caption & "]派车单签发成功！", 0 + 48 + 0, "签发派车单"
If Conn.State = 1 Then Conn.Close
If FormExists("hlist") Then
Unload hlist
End If
'Command7.Enabled = False
Hcode = Trim(pdcode.Caption)
Command9.Enabled = True
'hlist.Show
'Unload Me
End Sub
Function AddH(pdcodes)
Conn.Execute "delete from hlist where pdcode='" & pdcodes & "'"
If oRs.State = 1 Then oRs.Close
oRs.Open "select * from hlist where id is null", Conn, 1, 3
For i = 1 To MSG1.Rows - 1
oRs.AddNew
oRs(9) = pdcode.Caption
oRs(10) = Trim(VbTextEx4.Text)
For j = 1 To oRs.Fields.Count - 1
Select Case j
Case 1
If MSG1.TextMatrix(i, j) <> "" Then oRs(j) = MSG1.TextMatrix(i, j)
Case 2
If MSG1.TextMatrix(i, j) <> "" Then oRs(j) = MSG1.TextMatrix(i, j)
Case 3
If MSG1.TextMatrix(i, j) <> "" Then oRs(j) = MSG1.TextMatrix(i, j)
Case 4
If IsNumeric(MSG1.TextMatrix(i, j)) = True Then oRs(j) = MSG1.TextMatrix(i, j)
Case 5
If IsNumeric(MSG1.TextMatrix(i, j)) = True Then oRs(j) = MSG1.TextMatrix(i, j)
Case 6
If MSG1.TextMatrix(i, j) <> "" Then oRs(j) = MSG1.TextMatrix(i, j)
Case 7
If IsDate(MSG1.TextMatrix(i, j)) = True Then oRs(j) = MSG1.TextMatrix(i, j)
Case 8
If MSG1.TextMatrix(i, j) <> "" Then oRs(j) = MSG1.TextMatrix(i, j)
End Select
Next
Next
oRs.Update
If oRs.State = 1 Then oRs.Close
End Function
Function AddP(pdcodes)
Conn.Execute "delete from plist where pdcode='" & pdcodes & "'"
If oRs.State = 1 Then oRs.Close
oRs.Open "select * from plist where id is null", Conn, 1, 3
For i = 1 To MSG2.Rows - 1
oRs.AddNew
oRs(7) = Trim(Me.pdcode.Caption)
oRs(8) = Trim(VbTextEx4.Text)
For j = 1 To oRs.Fields.Count - 1
Select Case j
Case 1
If MSG2.TextMatrix(i, j) <> "" Then oRs(j) = MSG2.TextMatrix(i, j)
Case 2
If MSG2.TextMatrix(i, j) <> "" Then oRs(j) = MSG2.TextMatrix(i, j)
Case 3
If IsNumeric(MSG2.TextMatrix(i, j)) = True Then oRs(j) = MSG2.TextMatrix(i, j)
Case 4
If MSG2.TextMatrix(i, j) <> "" Then oRs(j) = MSG2.TextMatrix(i, j)
Case 5
If IsDate(MSG2.TextMatrix(i, j)) = True Then oRs(j) = MSG2.TextMatrix(i, j)
Case 6
If MSG2.TextMatrix(i, j) <> "" Then oRs(j) = MSG2.TextMatrix(i, j)
End Select
Next
Next
oRs.Update
If oRs.State = 1 Then oRs.Close
End Function

Private Sub Command8_Click()
If FormExists("hlist") Then
Unload hlist
End If
hlist.Show
Unload Me
End Sub

Private Sub Command9_Click()
If Flags(2) <> "1" Then MsgBox "无权操作！", 0 + 48 + 0: Exit Sub
Hcode = Trim(pdcode.Caption)
Sqlrep = " where pdcode='" & Hcode & "'"
Drep.Show
End Sub

Private Sub Form_Activate()
VbTextEx1.SetFocus
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 112 Then
Command1_Click
End If
End Sub

Private Sub Form_Load()
'On Error Resume Next
'Command9.Enabled = False
VbTextEx1.Text = Date
'Me.Caption = "签单"
MSG1.ColWidth(0) = 200
MSG1.ColWidth(1) = 2500
MSG1.ColWidth(2) = 800
MSG1.ColWidth(3) = 1000
MSG1.ColWidth(4) = 1000
MSG1.ColWidth(5) = 1000
MSG1.ColWidth(6) = 1000
MSG1.ColWidth(7) = 1500
MSG1.ColWidth(8) = 2000
MSG1.Cols = 9
MSG2.Cols = 7
MSG2.ColWidth(0) = 200
MSG2.ColWidth(1) = 2500
MSG2.ColWidth(2) = 800
MSG2.ColWidth(3) = 1000
MSG2.ColWidth(4) = 1000
MSG2.ColWidth(5) = 1200
MSG2.ColWidth(6) = 2000
MSG1.TextArray(1) = "品种名称"
MSG1.TextArray(2) = "规格"
MSG1.TextArray(3) = "数量(件)"
MSG1.TextArray(4) = "数量(瓶)"
MSG1.TextArray(5) = "票据号"
MSG1.TextArray(6) = "金额"
MSG1.TextArray(7) = "开票日期"
MSG1.TextArray(8) = "备注"
For s = 1 To MSG1.Cols - 1
MSG1.ColAlignmentFixed(s) = 4
Next
MSG2.TextMatrix(0, 1) = "品种名称"
MSG2.TextMatrix(0, 2) = "规格"
MSG2.TextMatrix(0, 3) = "数量"
MSG2.TextMatrix(0, 4) = "票据号"
MSG2.TextMatrix(0, 5) = "开票日期"
MSG2.TextMatrix(0, 6) = "备注"
For s = 1 To MSG2.Cols - 1
MSG2.ColAlignmentFixed(s) = 4
Next
'整行选择
MSG1.SelectionMode = flexSelectionByRow
MSG1.FocusRect = flexFocusNone
MSG1.HighLight = flexHighlightWithFocus
MSG2.SelectionMode = flexSelectionByRow
MSG2.FocusRect = flexFocusNone
MSG2.HighLight = flexHighlightWithFocus
pdcode.Caption = CStr(Year(Date)) + CStr(Month(Date)) + CStr(Day(Date)) + CStr(Hour(Time)) + CStr(Minute(Time)) + CStr(Second(Time))
pdcode.Caption = hlist.MSG1.TextMatrix(ZselRow, 1)
VbTextEx1.Text = hlist.MSG1.TextMatrix(ZselRow, 2)
VbTextEx2.Text = hlist.MSG1.TextMatrix(ZselRow, 3)
VbTextEx3.Text = hlist.MSG1.TextMatrix(ZselRow, 4)
VbTextEx4.Text = hlist.MSG1.TextMatrix(ZselRow, 5)
VbTextEx5.Text = hlist.MSG1.TextMatrix(ZselRow, 6)
VbTextEx6.Text = hlist.MSG1.TextMatrix(ZselRow, 7)
hssum.Text = Format(hlist.MSG1.TextMatrix(ZselRow, 8), "#0") + "件(" + Format(hlist.MSG1.TextMatrix(ZselRow, 9), "#0") + "瓶)"
hqsum.Text = hlist.MSG1.TextMatrix(ZselRow, 10)
Pssum.Text = hlist.MSG1.TextMatrix(ZselRow, 11)
Text1.Text = hlist.MSG1.TextMatrix(ZselRow, 13)
Text2.Text = hlist.MSG1.TextMatrix(ZselRow, 14)
DBname = App.Path & "\xjdb.dll"
DBpass = "www.ahxc.net"
DBconn
If Conn.State = 1 Then Conn.Close
Conn.Open Connstr
If Rs.State = 1 Then Rs.Close
Sql = "select * from hlist where pdcode='" & Trim(pdcode.Caption) & "' order by id asc"
Rs.Open Sql, Conn, 1, 1
If Rs.RecordCount > 0 Then MSG1.Rows = Rs.RecordCount + 1
For i = 1 To Rs.RecordCount
For j = 1 To Rs.Fields.Count - 3
If Rs(j) <> Empty Then
If j = 6 Then
MSG1.TextMatrix(i, j) = FormatNumber(Rs(j))
Else
MSG1.TextMatrix(i, j) = Rs(j)
End If
Else
If IsNumeric(Rs(j).Value) Then
MSG1.TextMatrix(i, j) = "0"
Else
MSG1.TextMatrix(i, j) = ""
End If
End If
Next
Rs.MoveNext
Next
If Rs.State = 1 Then Rs.Close
Sql = "select * from plist where pdcode='" & Trim(pdcode.Caption) & "' order by id asc"
Rs.Open Sql, Conn, 1, 1
If Rs.RecordCount > 0 Then MSG2.Rows = Rs.RecordCount + 1
For i = 1 To Rs.RecordCount
For j = 1 To Rs.Fields.Count - 3
If Rs(j) <> Empty Then MSG2.TextMatrix(i, j) = Rs(j)
Next
Rs.MoveNext
Next
End Sub

Private Sub h1_DblClick(Index As Integer)
If Index = 0 Then
Set SelName = EditPd
cpsel.Show vbModal
End If

End Sub

Private Sub h1_GotFocus(Index As Integer)
SendKeys "{Home}+{End}"
End Sub

Private Sub h1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
If Index = 0 Then
Set SelName = EditPd
cpsel.Show vbModal
End If
If Index = 7 Then Command1.SetFocus
If Index = 7 Then Exit Sub
SendKeys "{Tab}"
End If
End Sub

Private Sub h1_LostFocus(Index As Integer)
If IsNumeric(h1(2).Text) = False Then h1(2).Text = 0
If IsNumeric(h1(3).Text) = False Then h1(3).Text = 0
h1(3).Text = CLng(h1(2).Text) * ggtj(h1(1).Text)
If IsNumeric(h1(5).Text) = False Then h1(5).Text = 0
If IsDate(h1(6).Text) = False Then h1(6).Text = Date
End Sub
Private Function ggtj(gg)
On Error Resume Next
bbb = 1
gg = Replace(gg, "＊", "*")
gg = Replace(gg, "×", "*")
gg = Replace(gg, "X", "*")
gg = Replace(gg, "x", "*")
aa = Split(gg, "*")
For Each aaa In aa
If IsNumeric(aaa) = False Then Exit For
bbb = bbb * aaa
Next
ggtj = bbb
End Function
Private Sub MSG1_DblClick()
MSG1_SelChange
End Sub

Private Sub MSG1_SelChange()
If MSG1.TextMatrix(1, 1) = "" Then Exit Sub
For i = 0 To MSG1.Cols - 2
h1(i).Text = MSG1.TextMatrix(MSG1.Row, i + 1)
Next
Selrow = MSG1.Row
End Sub

Private Sub MSG2_DblClick()
MSG2_SelChange
End Sub

Private Sub MSG2_SelChange()
If MSG2.TextMatrix(1, 1) = "" Then Exit Sub
For i = 0 To MSG2.Cols - 2
p1(i).Text = MSG2.TextMatrix(MSG2.Row, i + 1)
Next
SelrowP = MSG2.Row
End Sub

Private Sub p1_DblClick(Index As Integer)
If Index = 0 Then
Set SelName = EditPd
othercpsel.Show vbModal
End If
End Sub

Private Sub p1_GotFocus(Index As Integer)
SendKeys "{Home}+{End}"
End Sub

Private Sub p1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
If Index = 0 Then
Set SelName = EditPd
othercpsel.Show vbModal
End If
If Index = 5 Then Command6.SetFocus
If Index = 5 Then Exit Sub
SendKeys "{Tab}"
End If
End Sub

Private Sub p1_LostFocus(Index As Integer)
If IsNumeric(p1(2).Text) = False Then p1(2).Text = 0
If IsDate(p1(4).Text) = False Then p1(4).Text = Date
End Sub

Private Sub VbTextEx1_LostFocus()
'VbTextEx2.SetFocus
If IsDate(VbTextEx1.Text) = False Then VbTextEx1.Text = Date
End Sub

Private Sub VbTextEx2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Set SelName = EditPd
czsel.Show vbModal
VbTextEx3.SetFocus
End If
End Sub

Private Sub VbTextEx3_LostFocus()
'VbTextEx4.SetFocus
End Sub

Private Sub VbTextEx4_DblClick()
Set SelName = EditPd
shsel.Show vbModal
End Sub

Private Sub VbTextEx4_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Set SelName = EditPd
shsel.Show vbModal
VbTextEx5.SetFocus
End If
End Sub

Private Sub VbTextEx6_LostFocus()
h1(0).SetFocus
End Sub