frmbooksxujie.frm

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

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1320
      TabIndex        =   11
      Top             =   6000
      Width           =   975
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      BackColor       =   &H00E0E0E0&
      Caption         =   "书名"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   7440
      TabIndex        =   10
      Top             =   5520
      Width           =   975
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      BackColor       =   &H00E0E0E0&
      Caption         =   "书号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   4440
      TabIndex        =   9
      Top             =   5520
      Width           =   975
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackColor       =   &H00E0E0E0&
      Caption         =   "会员卡号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   1320
      TabIndex        =   8
      Top             =   5520
      Width           =   975
   End
   Begin VB.Line Line4 
      X1              =   10560
      X2              =   10560
      Y1              =   5280
      Y2              =   6840
   End
   Begin VB.Line Line3 
      X1              =   1200
      X2              =   10560
      Y1              =   6840
      Y2              =   6840
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000009&
      X1              =   1200
      X2              =   10560
      Y1              =   5280
      Y2              =   5280
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000009&
      X1              =   1200
      X2              =   1200
      Y1              =   5280
      Y2              =   6840
   End
End
Attribute VB_Name = "frmBooksXuJie"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private adoQueryRs As New ADODB.Recordset
Private Curmode As ModifyMode
Private bkmsave As Double
Public bookstate As Integer
Dim sqlstring As String

Public Sub cmdAddNew_Click()
   Curmode = modadd
   If adoQueryRs.Recordcount > 0 Then
        bkmsave = adoQueryRs.Bookmark
   End If
   Call setmodify(True)

   adoQueryRs.AddNew
   Txt(0).Text = ""
End Sub

Public Sub cmdCancel_Click()
  Unload Me
End Sub

Public Sub CmdDelete_Click()
    On Error Resume Next
    With adoQueryRs
        If .Recordcount < 1 Then
            MsgBox "没有记录可以删除！", vbInformation
        Else
            If MsgBox("确定删除该条记录吗？", vbExclamation + vbYesNo) = vbYes Then
                .Delete
                .UpdateBatch adAffectAllChapters
                .Requery        '必须用requery，否则bookmark定位会出问题。
            End If
        End If
    End With
End Sub


Public Sub CmdSave_Click()
    Dim i As Integer
    On Error GoTo err
    For i = 0 To 6
        If Txt(i).Text = "" Then
            MsgBox "数据输入不完整。"
            Exit Sub
        End If
    Next

'    If Curmode = modadd Then
'        If Chkrcexit Then
'            MsgBox "此图书已借出，请修改。", vbInformation + vbOKOnly
'            Call setselect(Txt(0))
'            Exit Sub
'        End If
'    End If
    
    bkmsave = 0
    Select Case Curmode
      Case modadd
        sqlstring = "Insert into BooksXuJie " _
                    & " (IntMemberNo,ChrBookNo,ChrBookName,DatXJDate,DatXHSDate,ChrOperator,DatDate) values" _
                    & "(" & CLng(Txt(0).Text) & " ,'" & Txt(1) & "','" & Txt(2) & "','" & Txt(3) & "','" & Txt(4) & "','" & Txt(5) & "','" & Txt(6) & "')"
        cN.Execute (sqlstring)
      Case modEdit
        adoQueryRs.UpdateBatch adAffectAllChapters
      Case Else
        Exit Sub
    End Select
    
    Curmode = ModNormal
    Call setmodify(False)
    
    
    Call Openrs
    Exit Sub
err:
    MsgBox "保存数据时失败:" & err.Description
End Sub

Public Sub cmdUndo_Click()
   On Error GoTo err
    Curmode = ModNormal
    adoQueryRs.CancelBatch
    Call setmodify(False)
    Call locktxt(True, Txt)
    If adoQueryRs.Recordcount < 1 Then  '避免无效书签引用（无记录时，书签为0)
        adoQueryRs.Requery
    Else
        adoQueryRs.Bookmark = bkmsave
    End If
    bkmsave = 0             '用完后清零
    Exit Sub
err:
    adoQueryRs.Close
    Call Openrs
    If bkmsave > 0 Then
        adoQueryRs.Bookmark = bkmsave
    End If
    SetToolBar ("1100X10X000X111X1")
    bkmsave = 0
End Sub

Public Sub cmdEdit_Click()
   If adoQueryRs.Recordcount < 1 Then
        MsgBox "没有记录可以编辑。", vbInformation
    Else
        Curmode = modEdit
'        bkmsave = adoQueryRs.Bookmark
        Call setmodify(True)
    End If
End Sub

Private Sub Form_Activate()
  SetToolBar ("1100X10X000X111X1")
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    Call autoreturn(KeyAscii)
End Sub

Private Sub Form_Load()
    
    '显示已添加的记录数据
    Call Openrs

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set adoQueryRs = Nothing
     SetToolBar ("1111X11X111X111X1")
End Sub

Private Sub Txt_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
   If KeyCode = vbKeyLeft Then
    SendKeys "+{TAB}"
  End If
  
  If KeyCode = vbKeyRight Then
    SendKeys "{TAB}"
  End If
End Sub

Private Sub Txt_KeyPress(Index As Integer, KeyAscii As Integer)
    Select Case Index
      Case 0
        KeyAscii = ValiText(KeyAscii, vbExpInteger, "", Txt(Index).Text, 6)
     
    End Select
    
End Sub

Private Sub Openrs()        '打开主表
    Dim txttmp As TextBox
    Dim i As Integer
    On Error GoTo err
    
    Set adoQueryRs = New ADODB.Recordset
    adoQueryRs.Open "select * from BooksXuJie order by IntMemberNo,ChrBookNo,ChrBookName,DatDate", cN, adOpenStatic, adLockBatchOptimistic
    Set TDBGrid1.DataSource = adoQueryRs
    For Each txttmp In Txt
        Set txttmp.DataSource = adoQueryRs
        txttmp.Enabled = False
    Next
    Set txttmp = Nothing
  
    Exit Sub
err:
    MsgBox "打开数据库失败:" & err.Description
End Sub

Private Sub setmodify(blnmodify As Boolean)       '根据是否处于编辑状态，设置不同控件的状态
    '-----------------------------Datagrid
    TDBGrid1.AllowUpdate = False
  
'    '----------------------------按钕
    Select Case Curmode
      Case modadd
        SetToolBar ("0011X00X000X111X1")
      Case modEdit
        SetToolBar ("0011X00X000X111X1")
      Case Else
        SetToolBar ("1100X10X000X111X1")
    End Select

    '-----------------------------文本框
    Call locktxt(Not blnmodify, Txt)
    Select Case Curmode         '设置常用焦点
        Case 0  '正常
      '  Cmdaddnew.SetFocus
        Case 1  '增加
        Txt(0).SetFocus
        Case 2  '修改
        Txt(0).Enabled = False  '不给修改类别
        Txt(1).SetFocus
    End Select
End Sub

Private Function Chkrcexit() As Boolean     '检查某一工号的数据是否重复输入，返回TRRE表示重复
    Dim rstemp As New ADODB.Recordset
    On Error GoTo err
    sqlstring = "select * from BooksXuJie where IntMemberNo=" & CLng(Txt(0).Text) & ",and,ChrBookNo='" & _
                Txt(1).Text & "',and,ChrBookName='" & Txt(2).Text & "',and,DatDate='" & Txt(6).Text & "'"
    rstemp.Open sqlstring, cN, adOpenForwardOnly, adLockOptimistic
    If rstemp.EOF Then
        Chkrcexit = False
    Else
        Chkrcexit = True
    End If
    Set rstemp = Nothing
    Exit Function
err:
    MsgBox "错误:" & err.Description
    Set rstemp = Nothing
End Function

Private Sub Txt_Validate(Index As Integer, Cancel As Boolean)
  On Error GoTo err
  Cancel = True
'  Select Case Index
'    Case 0
'    Case 1
'    Case 2
'    Case 3
'      If Not IsVacancy(Txt(Index).Text) Then
'         If CDate(Txt(Index).Text) > CDate(Txt(4).Text) Then
'            MsgBox "借书日期不能早于还书日期！", vbInformation
'            Exit Sub
'         End If
'      End If
'    Case 4
'      If Not IsVacancy(Txt(Index).Text) Then
'
'         If CDate(Txt(Index).Text) < CDate(Txt(3).Text) Then
'            MsgBox "还书日期不能晚于借书日期！", vbInformation
'            Exit Sub
'         End If
'      End If
'  End Select
  Cancel = False
  Exit Sub
err:
End Sub