frmstoragefirstinput.frm

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

   
   On Error GoTo Err
   
   If Not checkpermission("书店管理系统", strUserName, , "基础设置.初期建帐管理.库存首次录入.查询") Then
     Exit Sub
   End If
   
   sqlstring = "select t1.*,ChrBookType,Chrbookconcern,ChrGHS from StorageFirstInput t1 left join BookData t2 " & _
               " on t1.chrBookNo=t2.chrBookNo and t1.chrBookName=t2.chrBookName where t1.chrStorageNo='" & Trim(txtFields(0).Text) & "'"
   rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   
   x.ReDim 0, rstmp.Recordcount - 1, 0, 7
   If rstmp.EOF Then
      MsgBox "库存首次录入表中没有库区：" & txtFields(0).Text & " 的库存记录！"
      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 Long
    Dim sqlstring As String
    Dim rsNewTmp As New ADODB.Recordset
    Dim L
    
    tdbStorageInput.Update
    sqlstring = "delete From StorageFirstInput where chrStorageNo='" & Trim(txtFields(0).Text) & "'"
    cN.BeginTrans
    cN.Execute sqlstring
    
'    For Each L In U
'        i = L
'         If IsVacancy(x(i, 4)) Then
'            sqlstring = "Insert into StorageFirstInput (chrBookNo,chrBookName,chrStorageNo,intAmount) values " & _
'                        "('" & x(i, 1) & "','" & x(i, 2) & "','" & x(i, 3) & "',0)"
'         Else
'            sqlstring = "Insert into StorageFirstInput (chrBookNo,chrBookName,chrStorageNo,intAmount) values " & _
'                        "('" & x(i, 1) & "','" & x(i, 2) & "','" & x(i, 3) & "'," & x(i, 4) & ")"
'         End If
'         Debug.Print sqlstring
'         cN.Execute sqlstring
'    Next

    For i = 0 To x.UpperBound(1)
      If x(i, 0) Then
         If IsVacancy(x(i, 4)) Then
            sqlstring = "Insert into StorageFirstInput (chrBookNo,chrBookName,chrStorageNo,intAmount) values " & _
                        "('" & x(i, 1) & "','" & x(i, 2) & "','" & x(i, 3) & "',0)"
         Else
            sqlstring = "Insert into StorageFirstInput (chrBookNo,chrBookName,chrStorageNo,intAmount) values " & _
                        "('" & x(i, 1) & "','" & x(i, 2) & "','" & x(i, 3) & "'," & x(i, 4) & ")"
         End If
         cN.Execute sqlstring
      End If
    Next
    cN.CommitTrans
    Call clearAll
    blnIsModified = False
    setFormState (modBrowsing)
    Exit Sub
SaveErr:
    cN.RollbackTrans
    MsgBox "保存记录出错：" & Err.Description, vbInformation
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  Dim arrQuery
  
  Select Case Index
    Case 0
' lzw 因库存区数量很少，故无必要增加过滤条件
'        Call g_CommonSelect("       库区号   |   库区名称   ", "select ChrStorageNo,ChrStorageName  from StorageSection  " & _
'                                 " where ChrStorageNo like '%" & txtFields(0).Text & "%'", "0,1", , , , -1, arrQuery)
        Call g_CommonSelect("       库区号   |   库区名称   ", "select ChrStorageNo,ChrStorageName  from StorageSection  " & _
                                 " ", "0,1", , , , -1, arrQuery)
        
        If TypeName(arrQuery) = "Variant()" Then
             txtFields(0).Text = arrQuery(0, 0)
             txtFields(1).Text = arrQuery(0, 1)
        End If
    
  End Select
End Sub

Public Sub cmdUndo_Click()
   '询问是否放弃当前内容
    If blnIsModified Then
        If MsgBox("当前修改的内容会丢失。确认要取消吗？", vbOKCancel, "询问") <> vbOK Then Exit Sub
    End If
    clearAll
    setFormState (ModNormal)
    blnIsModified = False
End Sub

Private Sub Form_Activate()
  Call ChangeToolBar(frmMain, 7, "审批", 14, "Audit")
  SetToolBar ("1100X01X101X111X1")
End Sub

Private Sub Form_Load()
  x.ReDim 0, -1, 0, 7
  Set tdbStorageInput.Array = x
  tdbStorageInput.ReBind
  Me.tdbStorageInput.MarqueeUnique = True
  
  Set U = New Collection
End Sub


Private Sub setFormState(intState As Integer)   '设置窗体的不同状态
    
    intFormState = intState
    Select Case intState
        Case ModNormal
            Me.Caption = "库存首次录入"
            setTxtWritable ("10")
    
            tdbStorageInput.AllowAddNew = False
            tdbStorageInput.AllowUpdate = False
            tdbStorageInput.AllowDelete = False
            SetToolBar ("1100X01X111X111X1")
    
    
        Case modBrowsing
            Me.Caption = "库存首次录入——浏览"
            setTxtWritable ("10")
    
            tdbStorageInput.AllowAddNew = False
            tdbStorageInput.AllowUpdate = False
            tdbStorageInput.AllowDelete = False
            SetToolBar ("1100X01X111X111X1")
        Case modadd
            Me.Caption = "库存首次录入——新增"
    
            setTxtWritable ("10")
    
            tdbStorageInput.AllowAddNew = False
            tdbStorageInput.AllowUpdate = True
            tdbStorageInput.AllowDelete = False
            SetToolBar ("0011X00X001X111X1")
        Case modEdit
            Me.Caption = "库存首次录入——修改"
            setTxtWritable ("10")
    
            tdbStorageInput.AllowAddNew = False
            tdbStorageInput.AllowUpdate = True
            tdbStorageInput.AllowDelete = False
            SetToolBar ("0011X00X001X111X1")
    End Select

End Sub

Private Sub clearAll()          '清除所有可填数据的位置
    Dim i As Integer
    
    For i = 0 To txtFields.UBound
        txtFields(i).Text = ""
    Next i
    
    x.ReDim 0, -1, 0, 7
    tdbStorageInput.ReBind

End Sub

Private Sub setTxtWritable(strIn As String)     '设置各文本框的可写属性
    Dim i As Integer
    
    For i = 0 To txtFields.UBound
        If Mid(strIn, i + 1, 1) = 1 Then
            txtFields(i).Locked = False
            txtFields(i).BackColor = RGB(255, 255, 255)
        Else
            txtFields(i).Locked = True
            txtFields(i).BackColor = gColor_LockedText
        End If
    Next i
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

    
  tdbStorageInput.Columns(intCol).Locked = blnlock
  tdbStorageInput.Columns(intCol).Alignment = intAlignment
  tdbStorageInput.Columns(intCol).BackColor = strBackColor
  tdbStorageInput.Columns(intCol).Visible = blnVisible
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call ChangeToolBar(frmMain, 7, "刷新", 6, "Refresh")
  SetToolBar ("0000X00X001X111X1")
  Set U = Nothing
End Sub

Private Sub tdbStorageInput_AfterUpdate()
    Dim lngE As Long
    On Error GoTo Err
    
    U.Add Me.tdbStorageInput.GetBookmark(0), CStr(tdbStorageInput.GetBookmark(0))
    
Err:
    lngE = Err.Number
    If lngE = 457 Then lngE = 0         ' 集合的关键字重复
    If lngE <> 0 Then
        Debug.Print "发生了错误！"
    End If
    
End Sub

Private Sub tdbStorageInput_KeyPress(KeyAscii As Integer)
  '限制输入条件必须为数字或某些特殊字符
    Select Case tdbStorageInput.Col
      Case 4 '书号
        KeyAscii = ValiText(KeyAscii, vbExpInteger, "", tdbStorageInput.Columns(tdbStorageInput.Col).Text)
      Case Else
        Exit Sub
    End Select
End Sub

Private Sub TxtFields_Change(Index As Integer)
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  
  Select Case Index
    Case 0
      sqlstring = "select ChrStorageName from StorageSection where chrStorageNO ='" & Trim(txtFields(0)) & "'"
      rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      If Not rstmp.EOF Then
        txtFields(1).Text = rstmp.Fields("chrStorageName").Value
      Else
        txtFields(1).Text = ""
      End If
  End Select
End Sub