frmreturnbooks.frm

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

                Me.Caption = "图书续借管理"
              Case "还书"
                Me.Caption = "还书管理"
            End Select
            
            setTxtWritable ("1000000")
           
            
            tdbBookBorrow(0).AllowAddNew = False
            tdbBookBorrow(0).AllowUpdate = True
            tdbBookBorrow(0).AllowDelete = False
            SetToolBar ("1000X10X101X111X1")
    
    
        Case modBrowsing
            Select Case strWindowCaption
              Case "续借"
                Me.Caption = "图书续借管理——浏览"
              Case "还书"
                Me.Caption = "还书管理——浏览"
            End Select
            setTxtWritable ("1000000")
            
            tdbBookBorrow(0).AllowAddNew = False
            tdbBookBorrow(0).AllowUpdate = True
            tdbBookBorrow(0).AllowDelete = False
            SetToolBar ("1000X10X101X111X1")
        Case modadd
            Select Case strWindowCaption
              Case "续借"
                Me.Caption = "图书续借管理——新增"
              Case "还书"
                Me.Caption = "还书管理——新增"
            End Select
            setTxtWritable ("1000000")
            
            tdbBookBorrow(0).AllowAddNew = False
            tdbBookBorrow(0).AllowUpdate = True
            tdbBookBorrow(0).AllowDelete = False
            SetToolBar ("0011X00X001X111X1")
        Case modEdit
            Select Case strWindowCaption
              Case "续借"
                Me.Caption = "图书续借管理——修改"
              Case "还书"
                Me.Caption = "还书管理——修改"
            End Select
            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, 3
    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
           Call ShowRecorder(1)
        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 sqlstring As String
    Dim lngAffectedRow As Long
    
    SaveAddingNew = False
    
    cN.BeginTrans
    For i = 0 To X.UpperBound(1)
        If X(i, 0) Then
           Select Case strWindowCaption
             Case "续借"
               sqlstring = "update  BooksBorrow set DatTSGHDate=#" & Format(Date, "yyyy-mm-dd") & _
                    "#,chrReturnType='续借' where intMemberNo=" & CInt(txtFields(0).Text) & _
                    " and chrBookNo='" & X(i, 1) & "' and " & _
                    " chrBookName='" & X(i, 2) & "' and " & _
                    " DatJSDate=#" & X(i, 3) & "#"
               cN.Execute sqlstring, lngAffectedRow
               If lngAffectedRow <> 1 Then GoTo ToError
               
               sqlstring = "insert into BooksBorrow(IntMemberNo,ChrBookNo,ChrBookName,DatJSDate," & _
                             "DatHSDate,ChrOperator,ChrType ) values("
               sqlstring = sqlstring & _
                         CInt(txtFields(0)) & ",'" & _
                         X(i, 1) & "','" & _
                         X(i, 2) & "',#" & _
                         Format(Date, "yyyy-mm-dd") & "#,#" & _
                         DateAdd("d", CInt(txtFields(6)), Format(Date, "yyyy-mm-dd")) & "#,'" & _
                         strUserName & "','续借')"
               cN.Execute sqlstring, lngAffectedRow

             Case "还书"
               sqlstring = "update  BooksBorrow set DatTSGHDate=#" & Format(Date, "yyyy-mm-dd") & _
                    "#,chrReturnType='还书' where intMemberNo=" & CInt(txtFields(0).Text) & _
                    " and chrBookNo='" & X(i, 1) & "' and " & _
                    " chrBookName='" & X(i, 2) & "' and " & _
                    " DatJSDate=#" & X(i, 3) & "#"
               cN.Execute sqlstring, lngAffectedRow
           End Select
           
           If lngAffectedRow <> 1 Then GoTo ToError
        End If
    Next i
    
    cN.CommitTrans
    SaveAddingNew = True
    Exit Function

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


'显示还书记录

Private Function ShowRecorder(intFlag As Integer) 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, 3
       tdbBookBorrow(0).ReBind
       sqlstring = "select * from BooksBorrow where chrBookNo='0'"
       rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
       Set tdbBookBorrow(1).DataSource = rsNewTmp
       
       ShowRecorder = False
       
       MsgBox "没有该会员卡的相关信息，请确认录入是否有错！", , "警告"
       Exit Function
  End If
  
  Select Case intFlag
    Case 1
       '查询已还图书信息
       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
       
       Frame1(1).Caption = "会员借书信息"
       tdbBookBorrow(0).Columns(3).Caption = "借书日期"
    Case 2
       '查询在借图书信息
       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
       
       '查询已还图书信息
       sqlstring = "select * from BooksBorrow where IntMemberNo=" & CInt(txtFields(0).Text) & " and DatTSGHDate is  not null and chrReturnType='还书'"
       Frame1(1).Caption = "会员还书信息"
       tdbBookBorrow(0).Columns(3).Caption = "还书日期"
    Case 3
       '查询在借图书信息
       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
       
       '查询已还图书信息
       sqlstring = "select * from BooksBorrow where IntMemberNo=" & CInt(txtFields(0).Text) & " and DatTSGHDate is  not null and chrReturnType='续借'"
       Frame1(1).Caption = "会员还书信息"
       tdbBookBorrow(0).Columns(3).Caption = "还书日期"
  End Select
  
  Set rsNewTmp = New ADODB.Recordset
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  
     
  If rsNewTmp.EOF Then
    ShowRecorder = False
    X.ReDim 0, -1, 0, 3
    tdbBookBorrow(0).ReBind
    Exit Function
  End If
  
  
  X.ReDim 0, rsNewTmp.Recordcount - 1, 0, 3
  Set tdbBookBorrow(0).Array = X
  Do While Not rsNewTmp.EOF
     X(i, 1) = rsNewTmp.Fields("chrBookNo").Value
     X(i, 2) = rsNewTmp.Fields("chrBookName").Value
     Select Case intFlag
       Case 1
         X(i, 3) = rsNewTmp.Fields("DatJSDate").Value
       Case 2, 3
         X(i, 3) = rsNewTmp.Fields("DatTSGHDate").Value
     End Select
     
     rsNewTmp.MoveNext
     i = i + 1
  Loop
  
  tdbBookBorrow(0).ReBind

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

End Function