rl_borrow.frm

图书管理软件,基本功能已具备

         Caption         =   "被借次数"
         Height          =   240
         Left            =   6135
         TabIndex        =   17
         Top             =   315
         Width           =   1155
      End
      Begin VB.Label lbl_Publishing 
         Caption         =   "出版社"
         Height          =   210
         Left            =   3195
         TabIndex        =   16
         Top             =   1335
         Width           =   705
      End
      Begin VB.Label lbl_Writer 
         Caption         =   "作者"
         Height          =   210
         Left            =   3195
         TabIndex        =   15
         Top             =   810
         Width           =   870
      End
      Begin VB.Label lbl_BooksName 
         Caption         =   "图书名称"
         Height          =   255
         Left            =   3195
         TabIndex        =   14
         Top             =   315
         Width           =   840
      End
      Begin VB.Label lbl_Barcode 
         Caption         =   "条形码(&B)"
         Height          =   270
         Left            =   180
         TabIndex        =   5
         Top             =   810
         Width           =   1095
      End
      Begin VB.Label lbl_BooksID 
         Caption         =   "图书编号(&N)"
         Height          =   225
         Left            =   180
         TabIndex        =   3
         Top             =   315
         Width           =   1380
      End
   End
   Begin MSComCtl2.DTPicker dtp_Now 
      Height          =   300
      Left            =   9000
      TabIndex        =   59
      Top             =   6240
      Width           =   1995
      _ExtentX        =   3519
      _ExtentY        =   529
      _Version        =   393216
      Enabled         =   0   'False
      Format          =   24641537
      CurrentDate     =   38422
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid msh_Borrow 
      Height          =   2205
      Left            =   120
      TabIndex        =   60
      Top             =   3840
      Width           =   10890
      _ExtentX        =   19209
      _ExtentY        =   3889
      _Version        =   393216
      AllowBigSelection=   0   'False
      SelectionMode   =   1
      AllowUserResizing=   1
      Appearance      =   0
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
      _Band(0).GridLinesBand=   1
      _Band(0).TextStyleBand=   0
      _Band(0).TextStyleHeader=   0
   End
   Begin VB.Label Label9 
      Caption         =   "当前日期"
      Height          =   210
      Left            =   7725
      TabIndex        =   58
      Top             =   6300
      Width           =   1005
   End
   Begin VB.Label Label8 
      Caption         =   "操作时间"
      Height          =   300
      Left            =   2820
      TabIndex        =   56
      Top             =   6825
      Width           =   1020
   End
   Begin VB.Label Label7 
      Caption         =   "操作员"
      Height          =   255
      Left            =   165
      TabIndex        =   54
      Top             =   6840
      Width           =   795
   End
   Begin VB.Label lbl_ReturnDay 
      Caption         =   "约定还书日期"
      Height          =   180
      Left            =   3660
      TabIndex        =   53
      Top             =   6300
      Width           =   1410
   End
   Begin VB.Label lbl_BorrowDay 
      Caption         =   "借书日期"
      Height          =   195
      Left            =   150
      TabIndex        =   51
      Top             =   6285
      Width           =   1095
   End
End
Attribute VB_Name = "RL_Borrow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***************************************************************
'*公司名：华夏学院晨光网络公司
'*系统名：红杉图书信息管理系统
'*程序名：借书/还书操作
'*程序ID：RL_Borrow
'*版本：2.0.0
'*最后修改时间：2005/4/18
'*修改人：cuitianlong
'*
'*-------------------------------------------------------------
'*  [年月日]        [制造者]
'*-------------------------------------------------------------
'*  2005/3/25       cuitianlong
'*
'***************************************************************
Option Explicit

Dim rc         As New ADODB.Recordset  '定义记录集
Dim C_UserName As String               '登陆的用户名
Dim M_Where    As Boolean              '操作条件

'***************************************************************
'*  窗体加载
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub Form_Load()
    On Error GoTo Form_Load
    
    '--- 窗体居中设置
    Call Cmn_Form_Center(Me)
    Me.Top = 500
    '--- 设置各个控件初始值
    Call Item_Clear
    '---表格控件加载数据
    
    Exit Sub
Form_Load:
    MsgBox "Form_Load()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  窗体退出 [QueryUnload]
'*
'*  [参数]
'*      1：系统参数
'*      2：系统参数
'*  [返回]
'*      无
'***************************************************************
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    On Error GoTo Form_QueryUnload
    
    Dim YesNo As Integer
        
    '---执行前确认
    YesNo = MsgBox("真的要退出借书/还书操作吗？", vbYesNo + vbQuestion, "提示")
    If YesNo = vbYes Then
        Unload Me
    Else
        Cancel = 1
    End If
    
    Exit Sub
Form_QueryUnload:
    MsgBox "Form_QueryUnload()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  窗体卸载 [Unload]
'*
'*  [参数]
'*      1：系统参数
'*  [返回]
'*      无
'***************************************************************
Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo Form_Unload
    
    Call Cmn_Ado_DisRecordset(rc) '关闭记录集
    
    Exit Sub
Form_Unload:
    MsgBox "Form_Unload()---出错", vbCritical, "错误"
End Sub

'***************************************************************
'*  窗体项目清空
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'***************************************************************
Private Sub Item_Clear()
    On Error GoTo Item_Clear
    
    txt_Writer.text = ""
    txt_RestrictAmmount.text = ""
    txt_Remarks.text = ""
    txt_BooksID.text = ""
    txt_BarCode.text = ""
    txt_ReaderRemarks.text = ""
    txt_ReaderName.text = ""
    txt_ReaderID.text = ""
    txt_ReaderType.text = ""
    txt_Department.text = ""
    txt_Publishing.text = ""
    txt_Price.text = ""
    txt_Page.text = ""
    txt_NotReturned.text = ""
    txt_NonceHoldAmount.text = ""
    txt_BorrowedTime.text = ""
    txt_BooksType.text = ""
    txt_BooksName.text = ""
    dtp_BorrowDay.Value = Date
    dtp_FaithReturnDay.Value = Date + 15
    dtp_Now.Value = Date
    txt_Handler.text = C_LoginName
    txt_HandleDate.text = CStr(Format(Now, "yy-M-d H:m:s"))
    msh_Borrow.Enabled = False
    
    Exit Sub
Item_Clear:
    MsgBox "Item_Clear()---出错", vbCritical, "错误"
End Sub

'****************************************************************
'*  Form_KeyPress
'*
'*  [参数]
'*      1:系统参数
'*  [返回]
'*      无
'****************************************************************
Private Sub Form_KeyPress(KeyAscii As Integer)
    On Error GoTo Form_KeyPress

    Select Case KeyAscii
    Case vbKeyReturn
        KeyAscii = &H0
        If TypeOf ActiveControl Is CommandButton Then Exit Sub
        
        '--- 焦点移动
        Select Case ActiveControl.hWnd
        Case Else
            SendKeys "{TAB}", True
        End Select
        
    End Select
    
    Exit Sub
Form_KeyPress:
    MsgBox "Form_KeyPress()---出错", vbCritical, "错误"
End Sub

'****************************************************************
'*  项目检测
'*
'*  [参数]
'*      无
'*  [返回]
'*      True:成功
'*      False:失败
'****************************************************************
Private Function Item_Check() As Boolean
    On Error GoTo Item_Check

    '---返回值初始设置
    Item_Check = False
    
    Dim S_Check_BooksID  As String
    Dim S_Check_BarCode  As String
    Dim S_Check_ReaderID As String
    
    '---设置图书编号长度检测
    S_Check_BooksID = Check_Txt(txt_BooksID, 0, 10, "图书编号", "借书/还书操作")
    '---设置条形码长度检测
    S_Check_BarCode = Check_Txt(txt_BarCode, 0, 13, "条形码", "借书/还书操作")
    '---设置读者编号长度检测
    S_Check_ReaderID = Check_Txt(txt_ReaderID, 0, 10, "读者编号", "借书/还书操作")
       
    '[txt_BooksID]
    If (False = S_Check_BooksID) Then
        txt_BooksID.SetFocus
        Exit Function
    End If
    '[txt_Barcode]
    If (False = S_Check_BarCode) Then
        txt_BarCode.SetFocus
        Exit Function
    End If
    '[txt_ReaderID]
    If (False = S_Check_ReaderID) Then
        txt_ReaderID.SetFocus
        Exit Function
    End If
    
    '---返回值正确设置
    Item_Check = True

    Exit Function
Item_Check:
    MsgBox "Item_Check()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  表格控件加载数据
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'****************************************************************
Public Function Fr_Mshf()
    On Error GoTo err_Fr_Mshf
    
    Dim S_SQL       As String
    Dim S_BooksCode As String
    Dim S_BarCode   As String
    Dim S_ReaderID  As String
    
    S_BooksCode = Trim(txt_BooksID.text)
    S_BarCode = Trim(txt_BarCode.text)
    S_ReaderID = Trim(txt_ReaderID.text)
        
    '---查询语句
    S_SQL = ""
    S_SQL = S_SQL & " SELECT [T_BooksBorrow].[ReaderID] AS 读者编码,"
    S_SQL = S_SQL & " [T_Reader].[ReaderName] AS 读者姓名,"
    S_SQL = S_SQL & " [T_BooksBorrow].[BooksCode] AS 图书编码,"
    S_SQL = S_SQL & " [T_BooksBorrow].[BarCode] AS 条形码,"
    S_SQL = S_SQL & " [T_Books].[Title] AS 图书名称,"
    S_SQL = S_SQL & " [T_BooksBorrow].[BorrowDate] AS 借书日期,"
    S_SQL = S_SQL & " [T_BooksBorrow].[FaithReturnDate] AS 约定还书日期,"
    S_SQL = S_SQL & " [T_BooksBorrow].[ReturnDate] AS 还书日期,"
    S_SQL = S_SQL & " [T_Estate].[Estate] AS 状态"
    S_SQL = S_SQL & " FROM"
    S_SQL = S_SQL & " T_Reader INNER JOIN"
    S_SQL = S_SQL & " (T_Books INNER JOIN"
    S_SQL = S_SQL & " (T_Estate INNER JOIN"
    S_SQL = S_SQL & " T_BooksBorrow ON"
    S_SQL = S_SQL & " [T_Estate].[EstateID]=[T_BooksBorrow].[EstateID])"
    S_SQL = S_SQL & " ON [T_Books].[BooksCode]=[T_BooksBorrow].[BooksCode])"
    S_SQL = S_SQL & " ON [T_Reader].[ReaderID]=[T_BooksBorrow].[ReaderID]"
    S_SQL = S_SQL & " WHERE"
    S_SQL = S_SQL & " (T_BooksBorrow.ReaderID)='" & S_ReaderID & "'"
    S_SQL = S_SQL & " ORDER BY T_BooksBorrow.EstateID DESC"
    
    '---执行查询语句
    Call Cmn_Ado_Select_Nolock(S_SQL, rc)
    
    msh_Borrow.Redraw = False '不数据表格重绘
    
    If rc.RecordCount <> 0 Then
        
        '---有数据的情况
        Set msh_Borrow.DataSource = rc
        msh_Borrow.Row = 1
        msh_Borrow.TextMatrix(msh_Borrow.RowSel, 0) = " →" '标出表格控件最左边的选定当前行标志"→"
        msh_Borrow.Enabled = True
    Else
        '---没有数据的情况
        Set msh_Borrow.DataSource = rc
        msh_Borrow.Rows = 2
        msh_Borrow.Col = 0
        msh_Borrow.Enabled = False
    End If
    
    '---设置表格控件最左边的选定当前行标志"→"列的宽度
    msh_Borrow.ColWidth(0) = 400
    
    '---数据表格重绘
    msh_Borrow.Redraw = True
    msh_Borrow.Enabled = True
    Exit Function
err_Fr_Mshf:
    MsgBox "Fr_Mshf()---出错", vbCritical, "错误"
End Function

'****************************************************************
'*  msh_Borrow_Click 写当前行标记
'*
'*  [参数]
'*      无
'*  [返回]
'*      无
'****************************************************************
Private Sub msh_Borrow_Click()