frmbookoutstorage.frm
来自「通用书店管理系统」· FRM 代码 · 共 1,729 行 · 第 1/5 页
FRM
1,729 行
End If
End If
Case Else
Exit Sub
End Select
End If
If KeyCode = vbKeyReturn Then
If tdbBook.Col = 8 Then
SendKeys "{HOME}{DOWN}"
Else
SendKeys "{RIGHT}"
End If
End If
End Sub
Private Sub tdbBook_AfterColUpdate(ByVal ColIndex As Integer)
Dim i As Integer
Dim dblTotal As Double '总数量
Dim dblTotalMoney As Double '总码洋
Dim dblTotalFactMoney As Double '总实洋
Dim sqlstring As String
Dim rs As New ADODB.Recordset
Dim rstmp As New ADODB.Recordset
Dim rsNewTmp As New ADODB.Recordset
Dim arrQuery
On Error Resume Next
Dim FirstRow1, FirstRow3, Row1, Row3
FirstRow1 = tdbBook.FirstRow
Row1 = tdbBook.row
Select Case ColIndex
Case 1
sqlstring = "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
" from BookData where chrBookNo='" & tdbBook.Columns(1).Value & "'"
rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
If Not rstmp.EOF Then
If rstmp.Recordcount > 1 Then
Call g_CommonSelect(" 书号 | 书名 | 单价 | 折扣 | 供货商 | 出版社 | 出版日期 ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
" from BookData where chrBookNo = '" & tdbBook.Columns(1).Text & "'", "0,1,2,3,6", , , , -1, arrQuery)
FirstRow3 = tdbBook.FirstRow
Row3 = tdbBook.row
tdbBook.Update
' Debug.Print "222222 firstrow3,row3=" & FirstRow3 & " " & Row3
If FirstRow1 = "" Then
tdbBook.FirstRow = 0
tdbBook.row = 0
Else
tdbBook.FirstRow = FirstRow1
tdbBook.row = Row1
End If
If TypeName(arrQuery) = "Variant()" Then
tdbBook.Columns(1) = arrQuery(0, 0)
tdbBook.Columns(2) = arrQuery(0, 1)
tdbBook.Columns(3) = arrQuery(0, 2)
sqlstring = "select top 1 DecAgio from outstorageInformation_list where chrBookNo like '%" & tdbBook.Columns(1).Text & "%' order by chrCKDH desc"
Set rsNewTmp = New ADODB.Recordset
rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
If Not rstmp.EOF Then
tdbBook.Columns(4) = rsNewTmp.Fields("decagio")
Else
tdbBook.Columns(4) = arrQuery(0, 3)
End If
If tdbBook.Columns(4) = "" Then
tdbBook.Columns(4) = 1
End If
End If
Else
tdbBook.Columns(1) = rstmp.Fields("chrBookNo").Value
tdbBook.Columns(2) = rstmp.Fields("chrBookName").Value
tdbBook.Columns(3) = rstmp.Fields("decPrice").Value
sqlstring = "select top 1 DecAgio from outstorageInformation_list where chrBookNo = '" & tdbBook.Columns(1).Text & "' order by chrCKDH desc"
Set rsNewTmp = New ADODB.Recordset
rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
If Not rsNewTmp.EOF Then
tdbBook.Columns(4) = rsNewTmp.Fields("decagio").Value
If tdbBook.Columns(4) = "" Then
tdbBook.Columns(4) = rstmp.Fields("decAgio").Value
End If
Else
tdbBook.Columns(4) = rstmp.Fields("decAgio").Value
End If
If tdbBook.Columns(4) = "" Then
tdbBook.Columns(4) = 1
End If
End If
If tdbBook.Columns("册/包").Text = "" Then tdbBook.Columns("册/包").Value = "册"
If tdbBook.Columns("出库数量").Value = "" Then
sqlstring = "SELECT ChrBookNo, ChrBookName,IntAmount FROM BookStorage where chrBookNo='" & tdbBook.Columns(1).Value & "' "
Set rs = New ADODB.Recordset
rs.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
If Not rs.EOF Then
tdbBook.Columns(8).Value = rs.Fields("IntAmount").Value
End If
End If
Else
MsgBox "图书资料表中没有该书的记录，请重新输入！", vbInformation
Exit Sub
End If
If CheckRepeatData(tdbBook.Columns(1), tdbBook.Columns(2)) Then
If Row1 > 0 Then Row1 = Row1 - 1
End If
If FirstRow1 <> "" Then
tdbBook.FirstRow = FirstRow1
tdbBook.row = Row1
End If
End Select
tdbBook.Update
For i = 0 To X.UpperBound(1)
dblTotal = X(i, 8) + dblTotal '出库总数
dblTotalMoney = X(i, 8) * X(i, 3) + dblTotalMoney '来单码洋
dblTotalFactMoney = X(i, 8) * X(i, 4) * X(i, 3) + dblTotalFactMoney '来单实洋
Next
txtFields(5).Text = Format(dblTotal, "#,##0")
txtFields(6).Text = Format(dblTotalMoney, "#,##0.00")
txtFields(7).Text = Format(dblTotalFactMoney, "#,##0.00")
End Sub
Private Sub tdbBook_AfterDelete()
Dim i As Integer
Dim dblTotal As Double '总数量
Dim dblTotalMoney As Double '总码洋
Dim dblTotalFactMoney As Double '总实洋
On Error Resume Next
tdbBook.Update
For i = 0 To X.UpperBound(1)
dblTotal = X(i, 8) + dblTotal '出库总数
dblTotalMoney = X(i, 8) * X(i, 3) + dblTotalMoney '来单码洋
dblTotalFactMoney = X(i, 8) * X(i, 4) * X(i, 3) + dblTotalFactMoney '来单实洋
Next
txtFields(5).Text = Format(dblTotal, "#,##0")
txtFields(6).Text = Format(dblTotalMoney, "#,##0.00")
txtFields(7).Text = Format(dblTotalFactMoney, "#,##0.00")
End Sub
'
Private Sub tdbBook_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
Dim i As Integer
Dim dblTotal As Double '总数量
Dim dblTotalMoney As Double '总码洋
Dim dblTotalFactMoney As Double '总实洋
Dim sqlstring As String
Dim rsNewTmp As New ADODB.Recordset
On Error Resume Next
Cancel = True
Select Case ColIndex
Case 1 '书号
sqlstring = "select * from BookData where chrBookNo like '%" & Trim(tdbBook.Columns(1).Text) & "%'"
Case 2 '书名
sqlstring = "select * from BookData where chrBookNo like '%" & Trim(tdbBook.Columns(2).Text) & "%'"
Case 3, 4 '单价
Cancel = False
If tdbBook.Columns(3).Text <> "" And tdbBook.Columns(4).Text <> "" And tdbBook.Columns(8).Text <> "" Then
tdbBook.Update
'计算总数量、总码洋
For i = 0 To X.UpperBound(1)
dblTotal = X(i, 8) + dblTotal '来单总数
dblTotalMoney = X(i, 8) * X(i, 3) + dblTotalMoney '来单码洋
dblTotalFactMoney = X(i, 8) * X(i, 4) * X(i, 3) + dblTotalFactMoney '来单实洋
Next
txtFields(5).Text = Format(dblTotal, "#,##0")
txtFields(6).Text = Format(dblTotalMoney, "#,##0.00")
txtFields(7).Text = Format(dblTotalFactMoney, "#,##0.00")
End If
Cancel = False
Exit Sub
Case Else
Cancel = False
Exit Sub
End Select
rsNewTmp.Open sqlstring, cN, adOpenForwardOnly, adLockReadOnly
If rsNewTmp.Recordcount = 0 Then
MsgBox "图书资料表中没有该书的记录，请确认录入是否有误！", vbInformation
Cancel = True
SendKeys "%{Up}"
Exit Sub
End If
Cancel = False
End Sub
Private Sub tdbBook_ButtonClick(ByVal ColIndex As Integer)
On Error Resume Next
Dim sqlstring As String
Dim arrQuery
blnIsModified = True
Select Case tdbBook.Col
Case 1
Call g_CommonSelect(" 书号 | 书名 | 单价 | 折扣 | 供货商 | 出版社 | 出版日期 ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
" from BookData where chrBookNo like '%" & tdbBook.Columns(1).Text & "%'", "0,1,2,3,6", , , , -1, arrQuery)
If TypeName(arrQuery) = "Variant()" Then
tdbBook.Columns(1) = arrQuery(0, 0)
tdbBook.Columns(2) = arrQuery(0, 1)
tdbBook.Columns(3) = arrQuery(0, 2)
tdbBook.Columns(4) = arrQuery(0, 3)
End If
Case 2
Call g_CommonSelect(" 书号 | 书名 | 单价 | 折扣 | 供货商 | 出版社 | 出版日期 ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
" from BookData where chrBookName like '%" & tdbBook.Columns(2).Text & "%'", "0,1,2,3,6", , , , -1, arrQuery)
If TypeName(arrQuery) = "Variant()" Then
tdbBook.Columns(1) = arrQuery(0, 0)
tdbBook.Columns(2) = arrQuery(0, 1)
tdbBook.Columns(3) = arrQuery(0, 2)
tdbBook.Columns(4) = arrQuery(0, 3)
End If
Case Else
Exit Sub
End Select
End Sub
Private Sub tdbBook_KeyPress(KeyAscii As Integer)
'限制输入条件必须为数字或某些特殊字符
Select Case tdbBook.Col
Case 1 '书号
KeyAscii = ValiText(KeyAscii, vbExpChar, "0123456789", tdbBook.Columns(tdbBook.Col).Text, 13)
Case 6, 7, 8 '数量
KeyAscii = ValiText(KeyAscii, vbExpInteger, "", tdbBook.Columns(tdbBook.Col).Text)
Case 3, 4 '金额
KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", tdbBook.Columns(tdbBook.Col).Text)
Case Else
Exit Sub
End Select
End Sub
Private Sub tdbBook_BeforeUpdate(Cancel As Integer)
Dim i As Integer
If Not tdbBook.DataChanged Then
Exit Sub
End If
'------------判断一行是否为空,如果是则自动删除-------------------
Dim intRowCount As Integer
If intFormState = modadd Or intFormState = modEdit Then
intRowCount = 0
For i = 0 To X.UpperBound(2) - 1 '检验每一列数据,该Max_x_col是 X的最大列值,而(Max_x_col-1)是Grddetail控件的最大列值
If Not IsVacancy(tdbBook.Columns(i).Value) Then
Exit For
End If
intRowCount = intRowCount + 1
Next i
If intRowCount = X.UpperBound(2) Then
tdbBook.ReBind
Exit Sub
End If
End If
End Sub
Private Sub tdbBook_Change()
blnIsModified = True
End Sub
Private Sub tdbBook_Error(ByVal DataError As Integer, response As Integer)
response = 0
End Sub
Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
If Index = 0 Then
KeyAscii = ValiText(KeyAscii, vbExpInteger, "", txtFields(Index).Text, 13)
ElseIf Index = 2 Then
KeyAscii = ValiText(KeyAscii, vbExpDecimal, "", txtFields(Index).Text)
End If
End Sub
'--------------------------------------------------------------------------------
'功能： 设置TDBGRID列的属性 如对齐方式、是否锁定、背景色等
'参数说明：
' intCol 列号
' intAlignment 对齐方式 0 左对齐 1 右对齐 2 居中（默认为2）
' blnLock 是否锁定列 TRUE 锁定 FALSE 可编辑 （默认为FALSE）
' strBackColor 列背景色 默认为白色
' blnVisible 是否可见
'返回值： ()
'--------------------------------------------------------------------------------
Private Sub SetTdbGridStatus(ByVal intCol As Integer, Optional intAlignment = 2, _
Optional blnlock = False, Optional strBackColor = vbWhite, Optional blnVisible = True)
On Error Resume Next
tdbBook.Columns(intCol).Locked = blnlock
tdbBook.Columns(intCol).Alignment = intAlignment
tdbBook.Columns(intCol).BackColor = strBackColor
tdbBook.Columns(intCol).Visible = blnVisible
End Sub
Private Sub setFormState(intState As Integer) '设置窗体的不同状态
intFormState = intState
Select Case intState
Case ModNormal
Me.Caption = "出库单管理"
setTxtWritable ("10000000")
setCmbWritable ("000")
setDtpWritable ("0")
tdbBook.AllowAddNew = False
tdbBook.AllowUpdate = False
tdbBook.AllowDelete = False
SetToolBar ("1100X10X101X111X1")
Case modBrowsing
Me.Caption = "出库单管理----浏览"
setTxtWritable ("10000000")
setCmbWritable ("000")
setDtpWritable ("0")
tdbBook.AllowAddNew = False
tdbBook.AllowUpdate = False
tdbBook.AllowDelete = False
SetToolBar ("1100X10X101X111X1")
Case modadd
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?