frmstorageinput.frm
来自「通用书店管理系统」· FRM 代码 · 共 851 行 · 第 1/3 页
FRM
851 行
_StyleDefs(29) = "Splits(0).FilterBarStyle:id=24,.parent=12"
_StyleDefs(30) = "Splits(0).Columns(0).Style:id=28,.parent=13"
_StyleDefs(31) = "Splits(0).Columns(0).HeadingStyle:id=25,.parent=14"
_StyleDefs(32) = "Splits(0).Columns(0).FooterStyle:id=26,.parent=15"
_StyleDefs(33) = "Splits(0).Columns(0).EditorStyle:id=27,.parent=17"
_StyleDefs(34) = "Splits(0).Columns(1).Style:id=32,.parent=13"
_StyleDefs(35) = "Splits(0).Columns(1).HeadingStyle:id=29,.parent=14"
_StyleDefs(36) = "Splits(0).Columns(1).FooterStyle:id=30,.parent=15"
_StyleDefs(37) = "Splits(0).Columns(1).EditorStyle:id=31,.parent=17"
_StyleDefs(38) = "Splits(0).Columns(2).Style:id=46,.parent=13"
_StyleDefs(39) = "Splits(0).Columns(2).HeadingStyle:id=43,.parent=14"
_StyleDefs(40) = "Splits(0).Columns(2).FooterStyle:id=44,.parent=15"
_StyleDefs(41) = "Splits(0).Columns(2).EditorStyle:id=45,.parent=17"
_StyleDefs(42) = "Splits(0).Columns(3).Style:id=50,.parent=13"
_StyleDefs(43) = "Splits(0).Columns(3).HeadingStyle:id=47,.parent=14"
_StyleDefs(44) = "Splits(0).Columns(3).FooterStyle:id=48,.parent=15"
_StyleDefs(45) = "Splits(0).Columns(3).EditorStyle:id=49,.parent=17"
_StyleDefs(46) = "Splits(0).Columns(4).Style:id=54,.parent=13"
_StyleDefs(47) = "Splits(0).Columns(4).HeadingStyle:id=51,.parent=14"
_StyleDefs(48) = "Splits(0).Columns(4).FooterStyle:id=52,.parent=15"
_StyleDefs(49) = "Splits(0).Columns(4).EditorStyle:id=53,.parent=17"
_StyleDefs(50) = "Splits(0).Columns(5).Style:id=66,.parent=13"
_StyleDefs(51) = "Splits(0).Columns(5).HeadingStyle:id=63,.parent=14"
_StyleDefs(52) = "Splits(0).Columns(5).FooterStyle:id=64,.parent=15"
_StyleDefs(53) = "Splits(0).Columns(5).EditorStyle:id=65,.parent=17"
_StyleDefs(54) = "Splits(0).Columns(6).Style:id=70,.parent=13"
_StyleDefs(55) = "Splits(0).Columns(6).HeadingStyle:id=67,.parent=14"
_StyleDefs(56) = "Splits(0).Columns(6).FooterStyle:id=68,.parent=15"
_StyleDefs(57) = "Splits(0).Columns(6).EditorStyle:id=69,.parent=17"
_StyleDefs(58) = "Splits(0).Columns(7).Style:id=74,.parent=13"
_StyleDefs(59) = "Splits(0).Columns(7).HeadingStyle:id=71,.parent=14"
_StyleDefs(60) = "Splits(0).Columns(7).FooterStyle:id=72,.parent=15"
_StyleDefs(61) = "Splits(0).Columns(7).EditorStyle:id=73,.parent=17"
_StyleDefs(62) = "Named:id=33:Normal"
_StyleDefs(63) = ":id=33,.parent=0"
_StyleDefs(64) = "Named:id=34:Heading"
_StyleDefs(65) = ":id=34,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
_StyleDefs(66) = ":id=34,.wraptext=-1"
_StyleDefs(67) = "Named:id=35:Footing"
_StyleDefs(68) = ":id=35,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
_StyleDefs(69) = "Named:id=36:Selected"
_StyleDefs(70) = ":id=36,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
_StyleDefs(71) = "Named:id=37:Caption"
_StyleDefs(72) = ":id=37,.parent=34,.alignment=2"
_StyleDefs(73) = "Named:id=38:HighlightRow"
_StyleDefs(74) = ":id=38,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
_StyleDefs(75) = "Named:id=39:EvenRow"
_StyleDefs(76) = ":id=39,.parent=33,.bgcolor=&HFFFF00&"
_StyleDefs(77) = "Named:id=40:OddRow"
_StyleDefs(78) = ":id=40,.parent=33"
_StyleDefs(79) = "Named:id=41:RecordSelector"
_StyleDefs(80) = ":id=41,.parent=34"
_StyleDefs(81) = "Named:id=42:FilterBar"
_StyleDefs(82) = ":id=42,.parent=33"
End
End
Attribute VB_Name = "frmStorageInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim x As New XArrayDB '从表1
Dim intFormState As Integer '标示窗体的状态，“正常/浏览/新增/编辑”
Dim blnIsModified As Boolean '是否有输入或修改数据 True for changed
Dim strOldBookNo As String
Dim blnOrder(7) As Boolean
Public Sub cmdAddnew_Click()
Dim sqlstring As String
Dim rstmp As New ADODB.Recordset
Dim rsNewTmp As New ADODB.Recordset
Dim i As Integer
On Error GoTo err
If Not checkpermission("书店管理系统", strUserName, , "库存管理.盘存信息录入.新增") Then
Exit Sub
End If
If Trim(txtFields(0).Text) = "" Then
MsgBox "请输入库区号！", , "警告"
Exit Sub
ElseIf Trim(txtFields(1).Text) = "" Then
MsgBox "库区表中没有该库区号的信息，不能执行下步操作！", , "警告"
Exit Sub
Else
If Trim(txtFields(1).Text) <> GetStorageName(txtFields(0).Text) Then
MsgBox "该库区号与库区名称不对应，不能执行下步操作！", , "警告"
Exit Sub
End If
End If
If chkBookType.Value Then
If Trim(cmbBookType.Text) = "" Then
MsgBox "请输入图书类型！", , "警告"
Exit Sub
End If
End If
SetTdbGridStatus 1, , True, gColor_LockedText
SetTdbGridStatus 2, , True, gColor_LockedText
SetTdbGridStatus 3, , True, gColor_LockedText
SetTdbGridStatus 5, , True, gColor_LockedText
SetTdbGridStatus 6, , True, gColor_LockedText
SetTdbGridStatus 7, , True, gColor_LockedText
sqlstring = "select * from StorageInput where chrStorageNo='" & Trim(txtFields(0).Text) & "'"
rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
If Not rstmp.EOF Then
sqlstring = "delete from StorageInput where chrStorageNo='" & Trim(txtFields(0).Text) & "'"
cN.Execute sqlstring
End If
If chkBookType.Value Then
sqlstring = "select * from BookData where ChrBookType='" & Trim(cmbBookType.Text) & "'"
Else
sqlstring = "select * from BookData order by chrBookType"
End If
Set rstmp = New ADODB.Recordset
rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
x.ReDim 0, rstmp.Recordcount - 1, 0, 7
If rstmp.Recordcount = 0 Then
frmMain.prgBar.Max = 1
Else
frmMain.prgBar.Max = rstmp.Recordcount - 1
End If
i = 0
Do While Not rstmp.EOF
x(i, 0) = -1
x(i, 1) = rstmp.Fields("chrBookNo").Value
x(i, 2) = rstmp.Fields("chrBookName").Value
x(i, 3) = Trim(txtFields(0).Text)
x(i, 4) = 2
x(i, 5) = rstmp.Fields("ChrBookType").Value
x(i, 6) = rstmp.Fields("Chrbookconcern").Value
x(i, 7) = rstmp.Fields("ChrGHS").Value
rstmp.MoveNext
i = i + 1
Call ShowBar(i, True)
Loop
Call ShowBar(1, False)
tdbStorageInput.ReBind
setFormState (modadd)
blnIsModified = False
Exit Sub
err:
MsgBox "新增记录失败：" & err.Description, vbInformation
End Sub
Public Sub cmdAudit_Click()
On Error GoTo err
Dim sqlstring As String
Dim rstmp As New ADODB.Recordset
Dim rsNewTmp As New ADODB.Recordset
Dim i As Integer
If Not checkpermission("书店管理系统", strUserName, , "库存管理.盘存信息录入.审核") Then
Exit Sub
End If
cN.BeginTrans
tdbStorageInput.Update
For i = 0 To x.UpperBound(1)
If x(i, 0) Then
sqlstring = "select * from BookStorage where chrBookNo='" & x(i, 1) & "' and chrBookName='" & x(i, 2) & _
"' and chrStorageNo='" & x(i, 3) & "'"
Set rstmp = New ADODB.Recordset
rstmp.Open sqlstring, cN, adOpenKeyset, adLockBatchOptimistic
If rstmp.EOF Then
rstmp.AddNew
rstmp.Fields("chrBookNo").Value = x(i, 1)
rstmp.Fields("chrBookName").Value = x(i, 2)
rstmp.Fields("chrStorageNo").Value = x(i, 3)
rstmp.Fields("intAmount").Value = x(i, 4)
rstmp.Fields("IntKCLimit").Value = 0
rstmp.Fields("IntYXKC").Value = 0
Else
rstmp.Fields("intAmount").Value = x(i, 4)
End If
rstmp.UpdateBatch adAffectAllChapters
End If
Next
cN.CommitTrans
Call clearAll
setFormState (modBrowsing)
Exit Sub
err:
cN.RollbackTrans
MsgBox "审批失败：" & err.Description, vbInformation
End Sub
Public Sub cmdCancel_Click()
Unload Me
SetToolBar ("0000X00X001X111")
End Sub
Public Sub cmdEdit_Click()
If Not checkpermission("书店管理系统", strUserName, , "库存管理.盘存信息录入.修改") Then
Exit Sub
End If
SetTdbGridStatus 1, , True, gColor_LockedText
SetTdbGridStatus 2, , True, gColor_LockedText
SetTdbGridStatus 3, , True, gColor_LockedText
SetTdbGridStatus 5, , True, gColor_LockedText
SetTdbGridStatus 6, , True, gColor_LockedText
SetTdbGridStatus 7, , True, gColor_LockedText
setFormState (modEdit)
blnIsModified = False '初始状态，没做任何修改
End Sub
Public Sub cmdQuery_Click()
Dim i As Integer
Dim sqlstring As String
Dim rstmp As New ADODB.Recordset
On Error GoTo err
sqlstring = "select t1.*,ChrBookType,Chrbookconcern,ChrGHS from StorageInput t1 left join BookData t2 " & _
" on t1.chrBookNo=t2.chrBookNo and t1.chrBookName=t2.chrBookName "
rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
x.ReDim 0, rstmp.Recordcount - 1, 0, 7
If rstmp.EOF Then
MsgBox "盘存信息录入表中没有任何盘存录入记录！"
tdbStorageInput.ReBind
Exit Sub
End If
i = 0
Do While Not rstmp.EOF
x(i, 0) = -1
x(i, 1) = rstmp.Fields("chrBookNo").Value
x(i, 2) = rstmp.Fields("chrBookName").Value
x(i, 3) = rstmp.Fields("chrStorageNo").Value
x(i, 4) = rstmp.Fields("intAmount").Value
x(i, 5) = rstmp.Fields("ChrBookType").Value
x(i, 6) = rstmp.Fields("Chrbookconcern").Value
x(i, 7) = rstmp.Fields("ChrGHS").Value
rstmp.MoveNext
i = i + 1
Loop
tdbStorageInput.ReBind
setFormState (modBrowsing)
Exit Sub
err:
MsgBox "查询记录出错：" & err.Description, vbInformation
End Sub
Public Sub CmdSave_Click()
On Error GoTo SaveErr
Dim i As Integer
Dim sqlstring As String
Dim rsNewTmp As New ADODB.Recordset
tdbStorageInput.Update
sqlstring = "delete From StorageInput "
cN.BeginTrans
'删除所有盘存记录
cN.Execute sqlstring
'保存打勾的盘存记录
For i = 0 To x.UpperBound(1)
If x(i, 0) Then
If IsVacancy(x(i, 4)) Then
sqlstring = "Insert into StorageInput (chrBookNo,chrBookName,chrStorageNo,intAmount) values " & _
"('" & x(i, 1) & "','" & x(i, 2) & "','" & x(i, 3) & "',0)"
Else
sqlstring = "Insert into StorageInput (chrBookNo,chrBookName,chrStorageNo,intAmount) values " & _
"('" & x(i, 1) & "','" & x(i, 2) & "','" & x(i, 3) & "'," & x(i, 4) & ")"
End If
cN.Execute sqlstring
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?