frmborrowbooks.frm

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

            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Index           =   1
         Left            =   4080
         TabIndex        =   11
         Top             =   300
         Width           =   1620
      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          =   375
         Index           =   0
         Left            =   180
         TabIndex        =   10
         Top             =   315
         Width           =   1620
      End
   End
End
Attribute VB_Name = "frmBorrowBooks"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
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 Not checkpermission("书店管理系统", strUserName, , "客户管理.借书管理.图书外借.新增") Then
       Exit Sub
    End If
    tdbBookBorrow(0).Columns(0).Locked = False
    tdbBookBorrow(0).Columns(0).BackColor = gColor_NormalText
    tdbBookBorrow(0).Columns(1).Locked = False
    tdbBookBorrow(0).Columns(1).BackColor = gColor_NormalText
    tdbBookBorrow(0).Columns(2).Locked = True
    tdbBookBorrow(0).Columns(2).BackColor = gColor_LockedText
    
    tdbBookBorrow(0).Columns(2).Caption = "单价"
    
    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 cmdEdit_Click()
    If Not checkpermission("书店管理系统", strUserName, , "客户管理.借书管理.图书外借.修改") Then
       Exit Sub
    End If
    tdbBookBorrow(0).Columns(0).Locked = True
    tdbBookBorrow(0).Columns(0).BackColor = gColor_LockedText
    tdbBookBorrow(0).Columns(1).Locked = True
    tdbBookBorrow(0).Columns(1).BackColor = gColor_LockedText
    tdbBookBorrow(0).Columns(2).Locked = False
    tdbBookBorrow(0).Columns(2).BackColor = gColor_NormalText
    
    tdbBookBorrow(0).Columns(2).Caption = "借书日期"
    setFormState (modEdit)
    blnIsModified = False           '初始状态，没做任何修改
End Sub


Public Sub cmdCancel_Click()
   Unload Me
End Sub

Public Sub CmdDelete_Click()
   On Error GoTo DelErr
   Dim sqlstring As String
   Dim rsNewTmp As New ADODB.Recordset
   
   If Not checkpermission("书店管理系统", strUserName, , "客户管理.借书管理.图书外借.删除") Then
       Exit Sub
   End If
   If MsgBox("真的要删除会员：'" & txtFields(1) & "'在" & tdbBookBorrow(0).Columns(2).Value & vbLf & _
             "的借书记录吗？", vbYesNo) = vbYes Then
        cN.BeginTrans
        '删除主表
        sqlstring = "delete from BooksBorrow where intMemberNo=" & CInt(txtFields(0).Text) & _
                    " and chrBookNo='" & tdbBookBorrow(0).Columns(0).Value & "' and " & _
                    " chrBookName='" & tdbBookBorrow(0).Columns(1).Value & "' and " & _
                    " DatJSDate=#" & tdbBookBorrow(0).Columns(2).Value & "#"
        cN.Execute sqlstring
        cN.CommitTrans
        tdbBookBorrow(0).Delete
   Else
     Exit Sub
   End If
   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
  
  tdbBookBorrow(0).Columns(0).Locked = True
  tdbBookBorrow(0).Columns(0).BackColor = gColor_LockedText
  tdbBookBorrow(0).Columns(1).Locked = True
  tdbBookBorrow(0).Columns(1).BackColor = gColor_LockedText
  tdbBookBorrow(0).Columns(2).Locked = False
  tdbBookBorrow(0).Columns(2).BackColor = gColor_NormalText
  tdbBookBorrow(0).Columns(2).Caption = "借书日期"
  
  If txtFields(0).Text = "" Then
     MsgBox "请输入要查询的会员卡号！", vbInformation
  Else
     If Not ShowRecorder Then
        MsgBox "会员：'" & txtFields(1) & "'目前没有借书", vbInformation
        Exit Sub
     End If
  End If
  Exit Sub
err:
   MsgBox "查询数据失败：" & err.Description, vbInformation
End Sub


Private Sub Form_Activate()
   SetToolBar ("1000X10X101X111X1")
   
'  If intFormState = modadd Then
'    SetToolBar ("0011X00X001X111X1")
'  End If
  
  
'  If intFormState = modEdit Then
'    SetToolBar ("0011X00X001X111X1")
'  End If
End Sub

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

Private Sub Form_Load()



  X.ReDim 0, -1, 0, 2
  Set tdbBookBorrow(0).Array = X
  tdbBookBorrow(0).ReBind
  
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 tdbBookBorrow_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
  Dim strQuery As String
  Dim arrQuery
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  
  '按F2键弹出选择框
  If KeyCode = vbKeyF2 And intFormState = modadd Then
     Select Case tdbBookBorrow(0).Col
       Case 0
           Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & tdbBookBorrow(0).Columns(0).Text & "%'", "0,1,2", , , , -1, arrQuery)
           If TypeName(arrQuery) = "Variant()" Then
              tdbBookBorrow(0).Columns(0) = arrQuery(0, 0)
              tdbBookBorrow(0).Columns(1) = arrQuery(0, 1)
              tdbBookBorrow(0).Columns(2) = arrQuery(0, 2)
           End If
           

       Case 1
           Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookName like '%" & tdbBookBorrow(0).Columns(1).Text & "%'", "0,1,2", , , , -1, arrQuery)
           If TypeName(arrQuery) = "Variant()" Then
              tdbBookBorrow(0).Columns(0) = arrQuery(0, 0)
              tdbBookBorrow(0).Columns(1) = arrQuery(0, 1)
              tdbBookBorrow(0).Columns(2) = arrQuery(0, 2)
           End If
       Case Else
         Exit Sub
     End Select
  End If
  

  
End Sub