frmsignout.frm

用VB制作的图书管理系统

         Width           =   2895
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "Beta 1.0"
         Height          =   255
         Left            =   960
         TabIndex        =   28
         Top             =   840
         Width           =   1695
      End
      Begin VB.Image imgLogo 
         Height          =   1635
         Left            =   120
         Picture         =   "frmSignout.frx":0C28
         Stretch         =   -1  'True
         Top             =   240
         Width           =   1620
      End
   End
   Begin VB.Label lblRed 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "RED"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   120
      TabIndex        =   46
      Top             =   120
      Width           =   2175
   End
End
Attribute VB_Name = "frmSignout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim KeySection As String
Dim KeyKey As String
Dim KeyValue As String
Dim RstQuery As Recordset
Dim StrSQL As String
Dim StrAvail As String
Dim txtStringVal As String
Dim EntryLength As Integer
Dim bookTitle(12)
Dim bookBarcode(12)
Dim bookTopic(12)
Dim bookDateDue(12)
Dim signout As Recordset
Dim dbBooks As Recordset


Private Sub loadini()

Dim lngResult As Long
Dim strFileName
Dim strResult As String * 50
strFileName = App.Path & "\bookkeeper.ini" 'Declare your ini file !
lngResult = GetPrivateProfileString(KeySection, _
KeyKey, strFileName, strResult, Len(strResult), _
strFileName)
If lngResult = 0 Then
'An error has occurred
Call MsgBox("An error has occurred while calling the API function", vbExclamation)
Else
KeyValue = Trim(strResult)
End If

End Sub

Private Sub cmdNext_Click()
c = c + 4
Call vsb_Change
End Sub

Private Sub cmdPrev_Click()
c = c - 4
Call vsb_Change
End Sub

Private Sub Command1_Click()
Me.Hide
End Sub

Private Sub Form_Load()
KeySection = "Database Properties"
KeyKey = "Database"
loadini
Books.DatabaseName = KeyValue
Patrons.DatabaseName = KeyValue
End Sub

Private Sub lblBookSelect_DblClick(Index As Integer)
    StrSQL = "SELECT * FROM [Books]"
    StrSQL = StrSQL & " WHERE [Barcode] LIKE '" & Barcode(Index).Caption & "'"
    SearchSTR = StrSQL
    frmBooks.Show
End Sub

Private Sub txtInput_Click()
cmdPrev.Visible = False
If Len(txtInput) = 0 Then
Else
If Len(txtInput) < 10 Then
If Left(txtInput, 1) = "?" Then
If Left(txtInput, 4) = "? A " Then
InputBox ("Authors Name")
ElseIf Left(txtInput, 4) = "? A:" Then
EntryLength = Len(txtInput) - 4
txtStringVal = Right(txtInput, EntryLength)
MsgBox ("Your Selected Authour is " & txtStringVal)
ElseIf Left(txtInput, 4) = "? T " Then
InputBox ("Title?")
ElseIf Left(txtInput, 4) = "? T:" Then
EntryLength = Len(txtInput) - 4
txtStringVal = Right(txtInput, EntryLength)
MsgBox ("You Want The Title " & txtStringVal)
End If
Else
   Set RstQuery = Nothing
icoBooks(0).Visible = False
hr(0).Visible = False
Barcode(0).Visible = False
Title(0).Visible = False
lblTopic(0).Visible = False
icoBooks(1).Visible = False
hr(1).Visible = False
Barcode(1).Visible = False
Title(1).Visible = False
lblTopic(1).Visible = False
icoBooks(2).Visible = False
hr(2).Visible = False
Barcode(2).Visible = False
Title(2).Visible = False
lblTopic(2).Visible = False
icoBooks(3).Visible = False
hr(3).Visible = False
Barcode(3).Visible = False
Title(3).Visible = False
lblTopic(3).Visible = False
lblDateDue(0).Visible = False
lblDateDue(1).Visible = False
lblDateDue(2).Visible = False
lblDateDue(3).Visible = False
A = 0
c = 0
Patrons.Recordset.MoveFirst
Patrons.Recordset.FindFirst ("PatronBarcode='" & txtInput & "'")
Label14.Caption = Format(Label14.Caption, "(###)-###-####")
' Find Books Already Signed Out
    StrSQL = "SELECT * FROM [Signout]"
    StrSQL = StrSQL & " WHERE [Patron] LIKE '" & txtInput.Text & "'"
    Set RstQuery = Db.OpenRecordset(StrSQL)
    If Not (RstQuery.BOF And RstQuery.EOF) Then
        RstQuery.MoveFirst
        Do While Not RstQuery.EOF
        Books.Recordset.MoveFirst
        Books.Recordset.FindFirst ("Barcode='" & RstQuery.Fields("Barcode").Value & "'")
        If A > 3 Then
        Topica = Books.Recordset.Fields("TopicID").Value
        Topics.Recordset.MoveFirst
        Topics.Recordset.FindFirst ("TopicID=" & Topica)
        Else
        icoBooks(A).Visible = True
        hr(A).Visible = True
        Barcode(A).Visible = True
        Title(A).Visible = True
        lblTopic(A).Visible = True
        lblDateDue(A).Visible = True
        Barcode(A).Caption = Books.Recordset.Fields("Barcode").Value
        Title(A).Caption = Books.Recordset.Fields("Title").Value
        Topics.Recordset.MoveFirst
        lblTopic(A).Caption = Books.Recordset.Fields("TopicID").Value
        Topics.Recordset.FindFirst ("TopicID=" & lblTopic(A).Caption)
        lblTopic(A).Caption = Topics.Recordset.Fields("TopicName").Value
        lblDateDue(A).Caption = RstQuery.Fields("DateDue").Value
       End If
        bookTitle(A) = Books.Recordset.Fields("Title").Value
        bookBarcode(A) = Books.Recordset.Fields("Barcode").Value
        bookTopic(A) = Topics.Recordset.Fields("TopicName").Value
        bookDateDue(A) = RstQuery.Fields("DateDue").Value
        A = A + 1
        RstQuery.MoveNext
        Loop
  
    End If



End If
Else
If Left(txtInput, 1) = "?" Then
If Left(txtInput, 4) = "? A " Then
InputBox ("Authors Name")
ElseIf Left(txtInput, 4) = "? A:" Then
EntryLength = Len(txtInput) - 4
txtStringVal = Right(txtInput, EntryLength)
MsgBox ("Your Selected Authour is " & txtStringVal)
ElseIf Left(txtInput, 4) = "? T " Then
InputBox ("Title?")
ElseIf Left(txtInput, 4) = "? T:" Then
EntryLength = Len(txtInput) - 4
txtStringVal = Right(txtInput, EntryLength)
MsgBox ("You Want The Title " & txtStringVal)
End If
Else
StrSQL = "SELECT * FROM [Books]"
StrSQL = StrSQL & " WHERE [Barcode] LIKE '" & txtInput.Text & "'"
Set dbBooks = Db.OpenRecordset(StrSQL)
If dbBooks.EOF And dbBooks.BOF Then
N = MsgBox("Barcode Not Found", vbOKOnly, "Not Found")
Else
        StrAvail = "Select * From [Signout] Where [Barcode] Like '" & txtInput.Text & "' AND [Available] Not Like True"
        Set signout = Db.OpenRecordset(StrAvail)
        If signout.BOF And signout.EOF Then
        Topica = dbBooks.Fields("TopicID").Value
        Topics.Recordset.MoveFirst
        Topics.Recordset.FindFirst ("TopicID=" & Topica)
        bookTitle(A) = dbBooks.Fields("Title").Value
        bookBarcode(A) = dbBooks.Fields("Barcode").Value
        bookTopic(A) = Topics.Recordset.Fields("TopicName").Value
        bookDateDue(A) = Left(DateAdd("d", 14, Now), 8)
        signout.AddNew
        signout.Fields("Barcode") = bookBarcode(A)
        signout.Fields("DateDue") = bookDateDue(A)
        signout.Fields("Patron") = lblPatronNumber.Caption
        signout.Update
        b = A - 3
        If A < 3 Then
        icoBooks(A).Visible = True
        hr(A).Visible = True
        Barcode(A).Visible = True
        Title(A).Visible = True
        lblTopic(A).Visible = True
        lblDateDue(A).Visible = True
        Call vsb_Change
        Else
        End If
        
        A = A + 1
        Call vsb_Change
        Else
        End If
        
End If
End If
End If
txtInput.Text = ""
End If
End Sub

Private Sub txtInput_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Call txtInput_Click
End Sub

Private Sub vsb_Change()
lblTopic(0).Caption = bookTopic(c)
lblTopic(1).Caption = bookTopic(c + 1)
lblTopic(2).Caption = bookTopic(c + 2)
lblTopic(3).Caption = bookTopic(c + 3)
Barcode(0).Caption = bookBarcode(c)
Barcode(1).Caption = bookBarcode(c + 1)
Barcode(2).Caption = bookBarcode(c + 2)
Barcode(3).Caption = bookBarcode(c + 3)
Title(0).Caption = bookTitle(c)
Title(1).Caption = bookTitle(c + 1)
Title(2).Caption = bookTitle(c + 2)
Title(3).Caption = bookTitle(c + 3)
lblDateDue(0).Caption = bookDateDue(c)
lblDateDue(1).Caption = bookDateDue(c + 1)
lblDateDue(2).Caption = bookDateDue(c + 2)
lblDateDue(3).Caption = bookDateDue(c + 3)
If c = 0 Then
cmdPrev.Visible = False
Else
cmdPrev.Visible = True
End If
If A <= 4 Then cmdNext.Visible = False
If A > 4 Then cmdNext.Visible = True
If Barcode(1).Caption = "" Then
icoBooks(1).Visible = True
hr(1).Visible = True
Barcode(1).Visible = True
Title(1).Visible = True
lblTopic(1).Visible = True
lblDateDue(1).Visible = True
icoBooks(2).Visible = True
hr(2).Visible = True
Barcode(2).Visible = True
Title(2).Visible = True
lblTopic(2).Visible = True
lblDateDue(2).Visible = True
icoBooks(3).Visible = True
hr(3).Visible = True
Barcode(3).Visible = True
Title(3).Visible = True
lblTopic(3).Visible = True
lblDateDue(3).Visible = True
ElseIf Barcode(2).Caption = "" Then
icoBooks(2).Visible = True
hr(2).Visible = True
Barcode(2).Visible = True
Title(2).Visible = True
lblTopic(2).Visible = True
lblDateDue(2).Visible = True
icoBooks(3).Visible = True
hr(3).Visible = True
Barcode(3).Visible = True
Title(3).Visible = True
lblTopic(3).Visible = True
lblDateDue(3).Visible = True
ElseIf Barcode(3).Caption = "" Then
icoBooks(3).Visible = True
hr(3).Visible = True
Barcode(3).Visible = True
Title(3).Visible = True
lblTopic(3).Visible = True
lblDateDue(3).Visible = True
Else
icoBooks(0).Visible = True
hr(0).Visible = True
Barcode(0).Visible = True
Title(0).Visible = True
lblTopic(0).Visible = True
lblDateDue(0).Visible = True
icoBooks(1).Visible = True
hr(1).Visible = True
Barcode(1).Visible = True
Title(1).Visible = True
lblTopic(1).Visible = True
lblDateDue(1).Visible = True
icoBooks(2).Visible = True
hr(2).Visible = True
Barcode(2).Visible = True
Title(2).Visible = True
lblTopic(2).Visible = True
lblDateDue(2).Visible = True
icoBooks(3).Visible = True
hr(3).Visible = True
Barcode(3).Visible = True
Title(3).Visible = True
lblTopic(3).Visible = True
lblDateDue(3).Visible = True
End If

End Sub