frmborrowbooks.frm

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

Private Sub tdbBookBorrow_Validate(Index As Integer, Cancel As Boolean)
    Dim sqlstring As String
    Dim arrQuery As Variant
    Dim rstmp As New ADODB.Recordset
    
    Select Case Index:
        Case 0:
            Debug.Print "validate" & tdbBookBorrow(0).Columns(0).Text

            If tdbBookBorrow(0).Columns(0).Text <> "" Then
                sqlstring = "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate " & _
                               " from BookData where chrBookNo = '" & tdbBookBorrow(0).Columns(0).Text & "'"
                Set rstmp = New ADODB.Recordset
                rstmp.Open sqlstring, cN, adOpenStatic, adLockReadOnly
                If rstmp.Recordcount = 0 Then
                    MsgBox "书号不存在！"
                    Cancel = True
                    Set rstmp = Nothing
'                    Call clearAll
                    Exit Sub
                Else
                    If rstmp.Recordcount > 1 Then
                         strSQL = "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                                " from BookData where chrBookNo like '%" & tdbBookBorrow(0).Columns(0).Text & "%' order by ChrBookNo"
                        g_CommonSelect " 书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", strSQL, "0,1,2", , , , , arrQuery

                        If TypeName(arrQuery) = "Variant()" Then
                             tdbBookBorrow(0).Columns(0).Text = IIf(IsNull(arrQuery(0, 0)), "", arrQuery(0, 0))
                             tdbBookBorrow(0).Columns(1).Text = IIf(IsNull(arrQuery(0, 1)), "", arrQuery(0, 1))
                             tdbBookBorrow(0).Columns(2).Text = IIf(IsNull(arrQuery(0, 2)), "", arrQuery(0, 2))
                            
                        End If
                        Exit Sub
                    End If
                
                End If
                tdbBookBorrow(0).Columns(1).Text = rstmp.Fields("ChrbookName")
                tdbBookBorrow(0).Columns(2).Text = rstmp.Fields("decprice")

                              
                Set rstmp = Nothing
      End If
      End Select
End Sub


Private Sub txtFields_KeyPress(Index As Integer, KeyAscii As Integer)
  If Index = 0 Then
     KeyAscii = ValiText(KeyAscii, vbExpInteger, "", txtFields(Index).Text, 6)
   End If
End Sub




Private Sub setFormState(intState As Integer)   '设置窗体的不同状态
    
    intFormState = intState
    Select Case intState
        Case ModNormal
            Me.Caption = "图书外借"
            setTxtWritable ("1000000")
           
            
            tdbBookBorrow(0).AllowAddNew = False
            tdbBookBorrow(0).AllowUpdate = False
            tdbBookBorrow(0).AllowDelete = False
            SetToolBar ("1000X10X101X111X1")
    
    
        Case modBrowsing
            Me.Caption = "图书外借----浏览"
            setTxtWritable ("1000000")
            
            tdbBookBorrow(0).AllowAddNew = False
            tdbBookBorrow(0).AllowUpdate = False
            tdbBookBorrow(0).AllowDelete = False
            SetToolBar ("1000X10X101X111X1")
        Case modadd
            Me.Caption = "图书外借----新增"
            setTxtWritable ("1000000")
            
            tdbBookBorrow(0).AllowAddNew = True
            tdbBookBorrow(0).AllowUpdate = True
            tdbBookBorrow(0).AllowDelete = True
            SetToolBar ("0011X00X001X111X1")
        Case modEdit
            Me.Caption = "图书外借----修改"
            setTxtWritable ("1000000")
            tdbBookBorrow(0).AllowAddNew = False
            tdbBookBorrow(0).AllowUpdate = True
            tdbBookBorrow(0).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, 2
    tdbBookBorrow(0).ReBind
    

    
End Sub


Private Sub txtFields_Validate(Index As Integer, Cancel As Boolean)
  Dim sqlstring As String
  Dim rsNewTmp As New ADODB.Recordset
  
  If Trim(txtFields(0)) = "" Then Exit Sub
  
  Cancel = True
  
  If intFormState = modadd Then
     sqlstring = "select t1.*,t2.ChrPhoneCode from MemberData t1 left join ClientData t2 on t1.chrClientNo=t2.chrClientNo " & _
                 "  where intMemberNo=" & CInt(txtFields(0).Text)
     rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
     If Not rsNewTmp.EOF Then
        If rsNewTmp.Fields("chrState").Value = "正常" Then
           txtFields(1).Text = rsNewTmp.Fields("chrName").Value
           txtFields(2).Text = rsNewTmp.Fields("chrType").Value
           txtFields(3).Text = rsNewTmp.Fields("DatDQDate").Value
           txtFields(4).Text = rsNewTmp.Fields("IntMaxBorrow").Value
           txtFields(6).Text = rsNewTmp.Fields("IntMaxDay").Value
           txtFields(7).Text = IIf(IsNull(rsNewTmp.Fields("ChrPhoneCode").Value), "", rsNewTmp.Fields("ChrPhoneCode").Value)
           
           sqlstring = "select count(*) as intNo from BooksBorrow where IntMemberNo=" & CInt(txtFields(0).Text) & " and DatTSGHDate is null"
           Set rsNewTmp = New ADODB.Recordset
           rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
           If Not rsNewTmp.EOF Then
              txtFields(5).Text = rsNewTmp.Fields("intNO").Value
           Else
              txtFields(5).Text = 0
           End If
           sqlstring = "select * from BooksBorrow where intMemberNo=" & CInt(txtFields(0)) & " and DatTSGHDate is null order by DatJSDate"
           Set rsNewTmp = New ADODB.Recordset
           rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
           
           Set tdbBookBorrow(1).DataSource = rsNewTmp
        Else
           MsgBox "该会员卡已挂失或已作废！", , "警告"
           Cancel = True
           Exit Sub
        End If
     End If
  End If
  Cancel = False
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


'保存新增的记录
Private Function SaveAddingNew() As Boolean     'True for success
    
    Dim i As Integer
    Dim strSQL As String
    Dim lngAffectedRow As Long
    
    SaveAddingNew = False
    
    cN.BeginTrans
    For i = 0 To X.UpperBound(1)
        strSQL = "insert into BooksBorrow(IntMemberNo,ChrBookNo,ChrBookName,DatJSDate," & _
                             "DatHSDate,ChrOperator,ChrType ) values("
        strSQL = strSQL & _
                 CInt(txtFields(0)) & ",'" & _
                 X(i, 0) & "','" & _
                 X(i, 1) & "',#" & _
                 Format(Date, "yyyy-mm-dd") & "#,#" & _
                 DateAdd("d", CInt(txtFields(6)), Format(Date, "yyyy-mm-dd")) & "#,'" & _
                 strUserName & "','借书')"
        cN.Execute strSQL, lngAffectedRow
        If lngAffectedRow <> 1 Then GoTo ToError
    Next i
    
    cN.CommitTrans
    SaveAddingNew = True
    Exit Function

ToError:
        cN.RollbackTrans
        MsgBox "保存记录出错:" & err.Description, vbInformation
        SaveAddingNew = False
End Function


'显示借书记录
Private Function ShowRecorder() As Boolean
  On Error GoTo err
  Dim i As Integer
  Dim sqlstring As String
  Dim rsNewTmp As New ADODB.Recordset
  
  '查询会员卡的资料
  sqlstring = "select t1.*,t2.ChrPhoneCode from MemberData t1 left join ClientData t2 on t1.chrClientNo=t2.chrClientNo " & _
                 "  where intMemberNo=" & CInt(txtFields(0).Text)
  
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  If Not rsNewTmp.EOF Then
       txtFields(1).Text = rsNewTmp.Fields("chrName").Value
       txtFields(2).Text = rsNewTmp.Fields("chrType").Value
       txtFields(3).Text = rsNewTmp.Fields("DatDQDate").Value
       txtFields(4).Text = rsNewTmp.Fields("IntMaxBorrow").Value
       txtFields(6).Text = rsNewTmp.Fields("IntMaxDay").Value
       txtFields(7).Text = IIf(IsNull(rsNewTmp.Fields("ChrPhoneCode").Value), "", rsNewTmp.Fields("ChrPhoneCode").Value)
       
       sqlstring = "select count(*) as intNo from BooksBorrow where IntMemberNo=" & CInt(txtFields(0).Text) & " and DatTSGHDate is null"
       Set rsNewTmp = New ADODB.Recordset
       rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
       If Not rsNewTmp.EOF Then
          txtFields(5).Text = rsNewTmp.Fields("intNO").Value
       Else
          txtFields(5).Text = 0
       End If
       
  Else
       For i = 0 To txtFields.UBound
         If i <> 0 Then
           txtFields(i).Text = ""
         End If
       Next i
       X.ReDim 0, -1, 0, 2
       tdbBookBorrow(0).ReBind
       
       Set tdbBookBorrow(1).DataSource = rsNewTmp
       
       ShowRecorder = False
       
       MsgBox "没有该会员卡的相关信息，请确认录入是否有错！", , "警告"
       Exit Function
  End If
  
  sqlstring = "select * from BooksBorrow where IntMemberNo=" & CInt(txtFields(0).Text) & " and DatTSGHDate is null"
  Set rsNewTmp = New ADODB.Recordset
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  Set tdbBookBorrow(1).DataSource = rsNewTmp
     
  If rsNewTmp.EOF Then
    ShowRecorder = False
    X.ReDim 0, -1, 0, 2
    tdbBookBorrow(0).ReBind
    Exit Function
  End If
  
  
  X.ReDim 0, rsNewTmp.Recordcount - 1, 0, 2
  Set tdbBookBorrow(0).Array = X
  Do While Not rsNewTmp.EOF
     X(i, 0) = rsNewTmp.Fields("chrBookNo").Value
     X(i, 1) = rsNewTmp.Fields("chrBookName").Value
     X(i, 2) = rsNewTmp.Fields("DatJSDate").Value
     rsNewTmp.MoveNext
     i = i + 1
  Loop
  
  tdbBookBorrow(0).ReBind

  ShowRecorder = True
  Exit Function
err:
  ShowRecorder = False
  MsgBox "查询记录失败：" & err.Description, vbInformation
  

End Function