frmreturnbooks.frm

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

         _StyleDefs(26)  =   "Splits(0).EvenRowStyle:id=20,.parent=9"
         _StyleDefs(27)  =   "Splits(0).OddRowStyle:id=21,.parent=10"
         _StyleDefs(28)  =   "Splits(0).RecordSelectorStyle:id=23,.parent=11"
         _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)  =   "Named:id=33:Normal"
         _StyleDefs(43)  =   ":id=33,.parent=0"
         _StyleDefs(44)  =   "Named:id=34:Heading"
         _StyleDefs(45)  =   ":id=34,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
         _StyleDefs(46)  =   ":id=34,.wraptext=-1"
         _StyleDefs(47)  =   "Named:id=35:Footing"
         _StyleDefs(48)  =   ":id=35,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
         _StyleDefs(49)  =   "Named:id=36:Selected"
         _StyleDefs(50)  =   ":id=36,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
         _StyleDefs(51)  =   "Named:id=37:Caption"
         _StyleDefs(52)  =   ":id=37,.parent=34,.alignment=2"
         _StyleDefs(53)  =   "Named:id=38:HighlightRow"
         _StyleDefs(54)  =   ":id=38,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
         _StyleDefs(55)  =   "Named:id=39:EvenRow"
         _StyleDefs(56)  =   ":id=39,.parent=33,.bgcolor=&HFFFF00&"
         _StyleDefs(57)  =   "Named:id=40:OddRow"
         _StyleDefs(58)  =   ":id=40,.parent=33"
         _StyleDefs(59)  =   "Named:id=41:RecordSelector"
         _StyleDefs(60)  =   ":id=41,.parent=34"
         _StyleDefs(61)  =   "Named:id=42:FilterBar"
         _StyleDefs(62)  =   ":id=42,.parent=33"
      End
   End
End
Attribute VB_Name = "frmReturnBooks"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strWindowCaption As String

Dim rstmp As New ADODB.Recordset

Dim X As New XArrayDB          '从表1

Dim intFormState As Integer     '标示窗体的状态，“正常/浏览/新增/编辑”
Dim blnIsModified As Boolean   '是否有输入或修改数据     True for changed


Public Sub cmdAddNew_Click()
    Dim i As Integer
    
   
    
    If blnIsModified And intFormState = modEdit Then
        If MsgBox("当前内容有修改，要放弃吗？", vbOKCancel, "警告") <> vbOK Then
            Exit Sub
        End If
    End If
    
    setFormState (modadd)
    
    clearAll
    
    blnIsModified = False
End Sub
Public Sub cmdCancel_Click()
   Unload Me
End Sub

Public Sub CmdDelete_Click()
   On Error GoTo DelErr
   Dim i As Integer
   Dim sqlstring As String
   Dim rsNewTmp As New ADODB.Recordset
   
   Select Case strWindowCaption
     Case "续借"
       If MsgBox("真的要删除会员：'" & txtFields(1) & "'在" & tdbBookBorrow(0).Columns(2).Value & vbLf & _
             "的续借记录吗？", vbYesNo) = vbYes Then
             cN.BeginTrans
             '删除主表
             tdbBookBorrow(0).Update
             For i = 0 To X.UpperBound(1)
                If X(i, 0) Then
                     sqlstring = "update BooksBorrow set DatTSGHDate=Null,chrReturnType=null" & _
                                 " where intMemberNo=" & CInt(txtFields(0).Text) & _
                                 " and chrBookNo='" & X(i, 1) & "' and " & _
                                 " chrBookName='" & X(i, 2) & "' and " & _
                                 " DatTSGHDate=#" & X(i, 3) & "# and chrReturnType='续借'"
                     cN.Execute sqlstring
                     
                     sqlstring = "Delete From BooksBorrow  where intMemberNo=" & CInt(txtFields(0).Text) & _
                                 " and chrBookNo='" & X(i, 1) & "' and " & _
                                 " chrBookName='" & X(i, 2) & "' and " & _
                                 " ChrType='续借' and DatJSDate=#" & X(i, 3) & "#"
                     cN.Execute sqlstring
                     
                     
                End If
             Next i
             cN.CommitTrans
             tdbBookBorrow(0).Delete
        Else
          Exit Sub
        End If
     
     Case "还书"
       If MsgBox("真的要删除会员：'" & txtFields(1) & "'在" & tdbBookBorrow(0).Columns(2).Value & vbLf & _
             "的还书记录吗？", vbYesNo) = vbYes Then
             cN.BeginTrans
             '删除主表
             tdbBookBorrow(0).Update
             For i = 0 To X.UpperBound(1)
                If X(i, 0) Then
                     sqlstring = "update BooksBorrow set DatTSGHDate=Null,chrReturnType=null" & _
                                 " where intMemberNo=" & CInt(txtFields(0).Text) & _
                                 " and chrBookNo='" & X(i, 1) & "' and " & _
                                 " chrBookName='" & X(i, 2) & "' and " & _
                                 " DatJSDate=#" & X(i, 3) & "# and chrReturnType='还书'"
                     cN.Execute sqlstring
                End If
             Next i
             cN.CommitTrans
             tdbBookBorrow(0).Delete
        Else
          Exit Sub
        End If
   End Select
   
   
   setFormState (ModNormal)
'   Call clearAll
   Exit Sub
DelErr:
   cN.RollbackTrans
   MsgBox "删除记录失败：" & err.Description, vbInformation
End Sub

Public Sub CmdSave_Click()
    On Error GoTo SaveErr
    Dim i As Integer
    Dim intIsCancel As Integer
    Dim sqlstring As String
    Dim rsNewTmp As New ADODB.Recordset

    tdbBookBorrow(0).Update
    If X.UpperBound(1) < 0 Then
        MsgBox "借书数据不能为空", vbOKOnly, "警告"
        Exit Sub
    End If
    
    If txtFields(0).Text = "" Then
          MsgBox "会员卡号不能为空！", , "警告"
          Exit Sub
    End If
    
    
    Select Case intFormState
        Case modadd
            If SaveAddingNew Then
                setFormState modBrowsing       '如果保存成功
                blnIsModified = False
            Else
                Exit Sub
            End If
'        Case modEdit
'            If SaveUpdate Then
'                setFormState modBrowsing         '如果更新成功
'                blnIsModified = False
'            Else
'                Exit Sub
'            End If
        Case Else
            Exit Sub
    End Select
    
    Call clearAll
    blnIsModified = False
    Exit Sub
SaveErr:

    MsgBox "保存记录出错：" & err.Description, vbInformation
End Sub

Public Sub cmdUndo_Click()
   Dim rstmp As New ADODB.Recordset
   '询问是否放弃当前内容
    If blnIsModified Then
        If MsgBox("当前修改的内容会丢失。确认要取消吗？", vbOKCancel, "询问") <> vbOK Then Exit Sub
    End If
    clearAll

    setFormState (ModNormal)
    blnIsModified = False
End Sub


Public Sub cmdQuery_Click()
  On Error GoTo err
  Dim sqlstring As String
  Dim rsNewTmp As New ADODB.Recordset
  
  
  If txtFields(0).Text = "" Then
     MsgBox "请输入要查询的会员卡号！", vbInformation
  Else
     Select Case strWindowCaption
       Case "续借"
            If Not ShowRecorder(3) Then
               MsgBox "会员：'" & txtFields(1) & "'目前没有任何续借记录", vbInformation
               Exit Sub
            End If
       Case "还书"
            If Not ShowRecorder(2) Then
               MsgBox "会员：'" & txtFields(1) & "'目前没有任何还书记录", vbInformation
               Exit Sub
            End If
     End Select
     
  End If
  Exit Sub
err:
   MsgBox "查询数据失败：" & err.Description, vbInformation
End Sub



Private Sub Form_Activate()
   SetToolBar ("1000X10X101X111X1")
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  Call autoreturn(KeyCode)
End Sub

Private Sub Form_Load()
  Select Case strWindowCaption
    Case "续借"
      Me.Caption = "图书续借管理"
    Case "还书"
      Me.Caption = "还书管理"
  End Select
 
  X.ReDim 0, -1, 0, 3
  Set tdbBookBorrow(0).Array = X
  tdbBookBorrow(0).ReBind
  
  tdbBookBorrow(0).Columns(1).Locked = True
  tdbBookBorrow(0).Columns(2).Locked = True
  tdbBookBorrow(0).Columns(3).Locked = True
  tdbBookBorrow(0).Columns(1).BackColor = gColor_LockedText
  tdbBookBorrow(0).Columns(2).BackColor = gColor_LockedText
  tdbBookBorrow(0).Columns(3).BackColor = gColor_LockedText
End Sub

Private Sub Form_Unload(Cancel As Integer)
  SetToolBar ("0000X00X001X111X1")
End Sub


Private Sub tdbBookBorrow_Change(Index As Integer)
  On Error Resume Next
  Select Case Index
    Case 0
      blnIsModified = True
  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
            Select Case strWindowCaption
              Case "续借"