frmstoragefirstinput.frm

来自「通用书店管理系统」· FRM 代码 · 共 820 行 · 第 1/3 页

         Width           =   2190
      End
      Begin VB.Label Label1 
         Caption         =   "库区："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   345
         Index           =   1
         Left            =   4980
         TabIndex        =   4
         Top             =   315
         Width           =   1260
      End
      Begin VB.Label Label1 
         Caption         =   "库区号："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   11.25
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   345
         Index           =   0
         Left            =   720
         TabIndex        =   2
         Top             =   360
         Width           =   900
      End
   End
End
Attribute VB_Name = "frmStorageFirstInput"
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 U As Collection
Dim uu As Variant

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
  
  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 StorageFirstInput where chrStorageNo='" & Trim(txtFields(0).Text) & "'"
  'rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  'If Not rstmp.EOF Then
  If 1 = 1 Then
'     If MsgBox("是否清空重新录入？", vbYesNo) = vbYes Then
'          sqlstring = "delete from StorageFirstInput where chrStorageNo='" & Trim(txtFields(0).Text) & "'"
'          cN.Execute sqlstring
'     Else


'          sqlstring = "select * from BookData order by ChrBookType"
   ' sqlstring = "select * from v_bookfirstinput where chrStorageNo='" & Trim(txtFields(0).Text) & "'"
    sqlstring = "SELECT t1.chrbookno, t1.chrbookname, t1.ChrBookType, t1.Chrbookconcern," _
        & "t1.ChrGHS, (select intamount from storagefirstinput where " _
        & "t1.chrbookno=chrbookno and t1.chrbookname=chrbookname and " _
        & "chrStorageNo='" & Trim(txtFields(0).Text) & "'" & ") AS intamount " _
        & "FROM bookdata AS t1"

          Set rsNewTmp = New ADODB.Recordset
          rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
              
          x.ReDim 0, rsNewTmp.Recordcount - 1, 0, 7
          Do While Not rsNewTmp.EOF
            x(i, 0) = -1
            x(i, 1) = rsNewTmp.Fields("chrBookNo").Value
            x(i, 2) = rsNewTmp.Fields("chrBookName").Value
            x(i, 3) = Trim(txtFields(0).Text)
            x(i, 4) = IIf(IsNull(rsNewTmp.Fields("intAmount").Value), 0, rsNewTmp.Fields("intAmount").Value)
            x(i, 5) = IIf(IsNull(rsNewTmp.Fields("ChrBookType").Value), "", rsNewTmp.Fields("ChrBookType").Value)
            x(i, 6) = IIf(IsNull(rsNewTmp.Fields("Chrbookconcern").Value), "", rsNewTmp.Fields("Chrbookconcern").Value)
            x(i, 7) = IIf(IsNull(rsNewTmp.Fields("ChrGHS").Value), "", rsNewTmp.Fields("ChrGHS").Value)
            
            i = i + 1
            rsNewTmp.MoveNext
        Loop
        
        Set rsNewTmp = Nothing
'          i = 0
'          Do While Not rstmp.EOF
'                sqlstring = "select * from StorageFirstInput where chrBookNo='" & rstmp.Fields("chrBookNo").Value & _
'                          "' and chrBookName='" & rstmp.Fields("chrBookName").Value & "' and chrStorageNo='" & _
'                          Trim(txtFields(0).Text) & "'"
'                Set rsNewTmp = New ADODB.Recordset
'                rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
'                If rsNewTmp.EOF Then
'                    x(i, 0) = 0
'                    x(i, 1) = rstmp.Fields("chrBookNo").Value
'                    x(i, 2) = rstmp.Fields("chrBookName").Value
'                    x(i, 3) = Trim(txtFields(0).Text)
'                    x(i, 4) = 0
'                    x(i, 5) = rstmp.Fields("ChrBookType").Value
'                    x(i, 6) = rstmp.Fields("Chrbookconcern").Value
'                    x(i, 7) = rstmp.Fields("ChrGHS").Value
'                Else
'                    x(i, 0) = -1
'                    x(i, 1) = rsNewTmp.Fields("chrBookNo").Value
'                    x(i, 2) = rsNewTmp.Fields("chrBookName").Value
'                    x(i, 3) = Trim(txtFields(0).Text)
'                    x(i, 4) = rsNewTmp.Fields("intAmount").Value
'                    x(i, 5) = rstmp.Fields("ChrBookType").Value
'                    x(i, 6) = rstmp.Fields("Chrbookconcern").Value
'                    x(i, 7) = rstmp.Fields("ChrGHS").Value
'                  End If
'
'                rstmp.MoveNext
'                i = i + 1
'          Loop
          tdbStorageInput.ReBind
          setFormState (modadd)
    
          blnIsModified = False
          Exit Sub
'     End If
  End If
    
'  sqlstring = "select * from BookData order by ChrBookType"
'  Set rstmp = New ADODB.Recordset
'  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
'
'  x.ReDim 0, rstmp.Recordcount - 1, 0, 7
'  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) = 0
'          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 (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
  
  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
   
   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

   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