frmtransaction.frm

中小型图书会员制租赁管理系统,采用ACCESS数据库。

' Start Calculate DateDue
For loop1 = 1 To Lines
    ReDim Preserve DateDue(loop1)
    DateDue(loop1) = vr_engine.Transaction_GetDateDue(MSFlexGrid1.TextMatrix(loop1, 1), Format(Now, "mm/dd/yyyy"))
Next loop1

' End Calculate DateDue
 'Start - Rcpt Header
  Printer.Print ""
  Printer.Print "" ' You can put your company name here.
  Printer.Print Tab(LeftMargin); "______________________________________________________________________________________________"
  Printer.Print Tab(LeftMargin); "INVOICE No.   : " & UCase(Trim(txtInvoiceNumber.Text))
  Printer.Print Tab(LeftMargin); "NAME          : " & UCase(txtName.Text) & "  __________"
  Printer.Print Tab(LeftMargin); "DATE          : " & UCase(txtDate.Text)
  Printer.Print Tab(LeftMargin); "CASHIER       : " & UCase(Mid(gVarFirstName, 1, 1)) & ". " & UCase(gVarFamilyName) & "  __________"
  Printer.Print Tab(LeftMargin); "=============================================================================================="
  Printer.Print Tab(LeftMargin); "Date Due        Item Code       Film Title                                     Amount      "
 'End - Rcpt Header
 'Detailed Section
  For loop2 = 1 To Lines
    ''Printer.Print Tab(LeftMargin); "FEB. 25, 2002"; Tab(LeftMargin + 16); "VHS-0001"; Tab(LeftMargin + 32); "FErdies' Wave Fage"; Tab(LeftMargin + 85 - Len("50.45")); "50.45"
    Printer.Print Tab(LeftMargin); UCase(Format(DateDue(loop2), "mmm. dd, yyyy")); Tab(LeftMargin + 16); MSFlexGrid1.TextMatrix(loop2, 1); Tab(LeftMargin + 32); MSFlexGrid1.TextMatrix(loop2, 2); Tab(LeftMargin + 85 - Len(MSFlexGrid1.TextMatrix(loop2, 3))); MSFlexGrid1.TextMatrix(loop2, 3)
    If loop2 = Lines Then
    Printer.Print Tab(LeftMargin); "----------------------------------------------------------------------------------------------"
    Printer.Print Tab(LeftMargin); "TOTAL         : "; Tab(LeftMargin + 34); Trim(str(Lines)) & " - Item(s)"; Tab(LeftMargin + 85 - Len("P  " & Trim(txtTotalAmountDue.Text))); "P  " & Trim(txtTotalAmountDue.Text)
    Printer.Print Tab(LeftMargin); "______________________________________________________________________________________________"
    End If
  Next loop2
 'End Detiled Section
 Printer.EndDoc
 MSFlexGrid1.SetFocus
 MousePointer = vbDefault
End Sub
Private Sub cmdRefreshList_Click()
    Dim vr_engine As VRENTAL_ENGINE
    Set vr_engine = New VRENTAL_ENGINE
    Call vr_engine.Transaction_LoadNameOfMembers(lstMembers, ArrayOFNamesAndID(), MembersID())
    lblDisplay2.Caption = "从名单列表里选择租借者： "
    If lstMembers.Enabled = True Then lstMembers.SetFocus
End Sub
Private Sub cmdSave_Click()
'--------------------------------------------
Dim MsgResponse
MsgResponse = MsgBox("是否要打印收据？", vbYesNoCancel, App.Title)
If MsgResponse = vbCancel Then
       MSFlexGrid1.SetFocus
       Exit Sub
End If
If MsgResponse = vbYes Then
    Call cmdPrint_Click
End If
'--------------------------------------------
    Dim vr_engine As VRENTAL_ENGINE
    Set vr_engine = New VRENTAL_ENGINE
Select Case PrevTransMode
Case False
    Call vr_engine.CheckIfTransactionDBExistIfNotCreate   '检查Transaction数据库文件是否存在
    Call vr_engine.Transaction_ChkForMembersFIleDBFolderIfNotCreate   '检查MembersRecords文件夹是否存在
    Call vr_engine.Transaction_ChkIfBorrowedItemsHistoryDBExistIfNotCreate    '检查BIH数据库文件是否存在
' '  Call vr_engine.Transaction_CheckForMembersRecordsIfNotExistsCreate(App.Path & "\Transaction\MembersRecords\", "Decastro.mdb")
    Call vr_engine.Transaction_SaveNewTransaction(MSFlexGrid1, txtDate, gVarFirstName & " " & Mid(gVarMiddleName, 1, 1) & ". " & gVarFamilyName, gVarUserID, txtInvoiceNumber, txtName, txtTotalAmountDue, txtAmountPaid, txtChange, ArrayOFNamesAndID(lstMembers.ListIndex + 1) & ".mdb", MembersID(lstMembers.ListIndex + 1), txtsl)
    Call cmdCancel_Click
Case True
    ' Start -- Chk 4 deleted prv itemcodes
      Dim delcount As Integer
      Dim loop1, loop2 As Integer
      Dim DelFlag As Boolean
      delcount = 0
      For loop1 = 1 To UBound(PrevTransItems())
        DelFlag = True
        For loop2 = 1 To MSFlexGrid1.Rows - 1
          If Trim(MSFlexGrid1.TextMatrix(loop2, 1)) = Trim(PrevTransItems(loop1)) Then
             DelFlag = False
          End If
        Next loop2
        If DelFlag = True Then
             delcount = delcount + 1
             ReDim Preserve DeletedItems(delcount)
             DeletedItems(delcount) = PrevTransItems(loop1)
             '' Stores deleted items in array -- not used
             ''Debug.Print DeletedItems(delcount)
        End If
      Next loop1
    ' End -- Chk 4 deleted prv itemcodes
    'Save Edited Previous Transaction
    Call vr_engine.Transaction_UpdatePrevTrasaction(MSFlexGrid1, txtDate, gVarFirstName & " " & Mid(gVarMiddleName, 1, 1) & ". " & gVarFamilyName, gVarUserID, txtInvoiceNumber, txtName, txtTotalAmountDue, txtAmountPaid, txtChange, Trim(txtName.Text) & " ID - " & MemberID_FindMode & ".mdb", MemberID_FindMode, PrevTransItems(), DeletedItems())
    Call cmdCancel_Click
End Select
MsgBox PrevTransMode                 '作用未明，标记以观后变
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF9 Then
  If txtAmountPaid.Enabled = True Then txtAmountPaid.SetFocus
End If
If KeyCode = vbKeyF1 Then
   If cmdNew.Enabled = True Then Call cmdNew_Click
End If

If KeyCode = vbKeyF2 Then
   If cmdFind.Enabled = True Then Call cmdFind_Click
End If

If KeyCode = vbKeyF3 Then
   If cmdEdit.Enabled = True Then Call cmdEdit_Click
End If

If KeyCode = vbKeyF4 Then
   If cmdSave.Enabled = True Then Call cmdSave_Click
End If

If KeyCode = vbKeyF5 Then
   If cmdCancel.Enabled = True Then Call cmdCancel_Click
End If

If KeyCode = vbKeyF6 Then
   If cmdDelete.Enabled = True Then Call cmdDelete_Click
End If

If KeyCode = vbKeyF7 Then
   If cmdPrint.Enabled = True Then Call cmdPrint_Click
End If

End Sub
Private Sub Form_Load()
  MSFlexGrid1.ColAlignment(0) = 5
  MSFlexGrid1.ColAlignment(1) = 5
  MSFlexGrid1.ColAlignment(2) = 5
  MSFlexGrid1.ColAlignment(3) = 5
  MSFlexGrid1.ColAlignment(4) = 5
  MSFlexGrid1.Rows = 2
  MSFlexGrid1.ColWidth(0) = 800
  MSFlexGrid1.ColWidth(1) = 1250
  MSFlexGrid1.ColWidth(2) = 3200
  MSFlexGrid1.ColWidth(3) = 1100
  MSFlexGrid1.TextMatrix(0, 0) = "No."
  MSFlexGrid1.TextMatrix(0, 1) = "项目编号"
  MSFlexGrid1.TextMatrix(0, 2) = "标题"
  MSFlexGrid1.TextMatrix(0, 3) = "租金额"
  MSFlexGrid1.TextMatrix(0, 4) = "租借数目"
End Sub
Private Sub lblDisplay2_Change()
If IsNumeric(lblDisplay2.Caption) = True Then lblDisplay2.Caption = Format(lblDisplay2.Caption, "##,##0.00")
End Sub
Private Sub lstMembers_Click()
  If Trim(lstMembers.Text) <> "" Then lblDisplay2.Caption = lstMembers.Text
  ''MsgBox ArrayOFNamesAndID(lstMembers.ListIndex + 1)
End Sub
Private Sub lstMembers_DblClick()        '双击选择租借者
Dim vr_rental As VRENTAL_ENGINE
Set vr_rental = New VRENTAL_ENGINE
Dim InvNum As String
Dim intInvNum As Long

'' Start -- Chk if Members has Unreturned Items
   Call vr_rental.Transaction_CheckIfMemberHasUnreturnedItems(App.Path & "\Transaction\MembersRecords\" & ArrayOFNamesAndID(lstMembers.ListIndex + 1) & ".mdb")
'' End -- Chk if Members has Unreturned Items

           txtDate.Text = Format(Now, "mmm. dd, yyyy")
            '' Load Invoice Number
        If vr_rental.ReportFileStatus(App.Path & "\InvoiceNumber.txt") = True Then
               Open App.Path & "\InvoiceNumber.txt" For Input As #1
               Line Input #1, InvNum
               Close #1
                 If IsNumeric(InvNum) = True Then
                    intInvNum = Int(Val(InvNum)) + 1
                 Else
                    Open App.Path & "\InvoiceNumber.txt" For Output As #1
                    Print #1, "1"
                    Close #1
                    intInvNum = 1
                 End If
               
        Else
                Open App.Path & "\InvoiceNumber.txt" For Output As #1
                Print #1, "1"
                Close #1
                intInvNum = 1
        End If
            txtInvoiceNumber.Text = str(intInvNum)
            '' End Load Invoice Number
            
            lblDisplay1.Caption = "总金额为："
            lblDisplay2.Caption = "0.00"
            txtName.Text = lstMembers.Text
            lstMembers.Enabled = False
            cmdRefreshList.Enabled = False
            cboItemCode.Enabled = True
            cmdAddItem.Enabled = True
            cboItemCode.SetFocus
    Dim mySQL As String    '用以搜索折扣价================================================
    Dim adoConnection As ADODB.Connection
    Dim adoRecordset As ADODB.Recordset
    Dim connectString As String
    Set adoConnection = New ADODB.Connection
    Set adoRecordset = New ADODB.Recordset
    connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\MembersDB.mdb" & ";Persist Security Info=False;Jet OLEDB:Database password=AdmiN"
        adoConnection.Open connectString
        If lstMembers.ListIndex >= 9 Then
        mySQL = "Select * FROM [MembersInfo] WHERE [ID NUMBER] = " & Val(Mid(Trim(lstMembers.Text), 3, 2))
        Else: mySQL = "Select * FROM [MembersInfo] WHERE [ID NUMBER] = " & Val(Mid(Trim(lstMembers.Text), 3, 1))
        End If
        adoRecordset.Open mySQL, adoConnection, adOpenStatic, adLockOptimistic, adCmdText
        If adoRecordset.RecordCount <> 0 Then
            txtzksp.Text = Format(str(1 - 0.1 * Val(adoRecordset.Fields("会员等级"))), "0.00")
            Else
            Set adoRecordset = Nothing
            Set adoConnection = Nothing
            Exit Sub
        End If                         '======================================================
End Sub
Private Sub lstMembers_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn And Trim(lstMembers.Text) <> "" Then
Dim vr_rental As VRENTAL_ENGINE
Set vr_rental = New VRENTAL_ENGINE
Dim InvNum As String
Dim intInvNum As Long

'' Start -- Chk if Members has Unreturned Items
   Call vr_rental.Transaction_CheckIfMemberHasUnreturnedItems(App.Path & "\Transaction\MembersRecords\" & ArrayOFNamesAndID(lstMembers.ListIndex) & ".mdb")
'' End -- Chk if Members has Unreturned Items
           txtDate.Text = Format(Now, "mmm. dd, yyyy")
            '' Load Invoice Number
        If vr_rental.ReportFileStatus(App.Path & "\InvoiceNumber.txt") = True Then
               Open App.Path & "\InvoiceNumber.txt" For Input As #1
               Line Input #1, InvNum
               Close #1
                 If IsNumeric(InvNum) = True Then
                    intInvNum = Int(Val(InvNum)) + 1
                 Else
                    Open App.Path & "\InvoiceNumber.txt" For Output As #1
                    Print #1, "1"
                    Close #1
                    intInvNum = 1
                 End If
               
        Else
                Open App.Path & "\InvoiceNumber.txt" For Output As #1
                Print #1, "1"
                Close #1
                intInvNum = 1
        End If
            txtInvoiceNumber.Text = str(intInvNum)
            '' End Load Invoice Number
            
            lblDisplay1.Caption = "总金额为："
            lblDisplay2.Caption = "0.00"
            txtName.Text = lstMembers.Text
            lstMembers.Enabled = False
            cmdRefreshList.Enabled = False
            cboItemCode.Enabled = True
            cmdAddItem.Enabled = True
            cboItemCode.SetFocus
End If

Dim mySQL As String    '用以搜索折扣价================================================
    Dim adoConnection As ADODB.Connection
    Dim adoRecordset As ADODB.Recordset
    Dim connectString As String
    Set adoConnection = New ADODB.Connection
    Set adoRecordset = New ADODB.Recordset
    connectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DataBase\MembersDB.mdb" & ";Persist Security Info=False;Jet OLEDB:Database password=AdmiN"
        adoConnection.Open connectString
        mySQL = "Select * FROM [MembersInfo] WHERE 姓氏 = '" & Mid(Trim(txtName.Text), 1, 1) & "'"
        adoRecordset.Open mySQL, adoConnection, adOpenStatic, adLockOptimistic, adCmdText
        If adoRecordset.RecordCount <> 0 Then
            txtzksp.Text = Format(str(1 - 0.1 * Val(adoRecordset.Fields("会员等级"))), "0.00")
            txtzhekou.Text = Format(Val(txtTotalAmountDue.Text) * Val(txtzksp.Text), "0.00")
            Else
            Set adoRecordset = Nothing
            Set adoConnection = Nothing
            Exit Sub
        End If                         '======================================================
        
End Sub
Private Sub txtAmountPaid_KeyPress(KeyAscii As Integer)
  If KeyAscii = vbKeyReturn Then Call txtAmountPaid_LostFocus
End Sub
Private Sub txtAmountPaid_LostFocus()
    If Trim(txtAmountPaid.Text) = "" Then
        txtChange.Text = ""
    Else
       If IsNumeric(Trim(txtAmountPaid.Text)) Then
          txtAmountPaid.Text = Format(txtAmountPaid.Text, "0.00")
          If IsNumeric(txtTotalAmountDue.Text) Then
             txtChange.Text = str(Val(Val(txtAmountPaid.Text) - Val(txtzhekou)))
             txtChange.Text = Format(txtChange.Text, "0.00")
          End If
       Else
          MsgBox "非法输入！", vbInformation, "Amount paid is invalid. "
          txtAmountPaid.Text = ""
          txtChange.Text = ""
          txtAmountPaid.SetFocus
       End If
    End If
End Sub
Private Sub txtChange_Change()
    txtChange.Text = Format(txtChange.Text, "0.00")
    If Val(txtChange.Text) < 0 Or Trim(txtChange.Text) = "" Then
        cmdSave.Enabled = False
        cmdPrint.Enabled = False
        lblDisplay1.Caption = "总金额为："
    Else
       If Val(txtTotalAmountDue.Text) > 0 Then
          If cboItemCode.Enabled = True Then
             cmdSave.Enabled = True
             cmdPrint.Enabled = True
          End If
          lblDisplay1.Caption = "找零："
          lblDisplay2.Caption = txtChange.Text
       Else
          cmdSave.Enabled = False
          cmdPrint.Enabled = False
          lblDisplay1.Caption = "总金额为："
       End If
    End If
End Sub
Private Sub txtcxid_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
 If (Val(txtcxid.Text) - 1) < lstMembers.ListCount Then
   lstMembers.ListIndex = Val(txtcxid.Text) - 1
   txtcxid.Locked = True
   Else: MsgBox "对不起，你输入的ID不存在，请重新输入！", , "输入无效！"
   txtcxid.Locked = False
 End If
End If
End Sub
Private Sub txtsl_LostFocus()
 If IsNumeric(Trim(txtsl.Text)) Then
    If Val(txtsl.Text) > 50 Then
        MsgBox "租借数目项的最大数目为50,请重新返回输入！ ", vbInformation, "注意！"
        txtsl.SetFocus
    End If
Else: MsgBox "非法输入文本！,请返回检查后输入！"
    txtsl.Text = ""
    txtsl.SetFocus
End If
End Sub
Private Sub txtTotalAmountDue_Change()
lblDisplay2.Caption = txtTotalAmountDue.Text
 txtTotalAmountDue.Text = Format(txtTotalAmountDue.Text, "0.00")
If IsNumeric(txtTotalAmountDue.Text) Then
    txtAmountPaid.Locked = False
Else
    txtAmountPaid.Locked = True
End If
If IsNumeric(txtTotalAmountDue.Text) = True And IsNumeric(txtAmountPaid.Text) = True Then
     txtChange.Text = str(Val(Val(txtAmountPaid.Text) - Val(txtTotalAmountDue.Text)))
     txtTotalAmountDue.Text = Format(txtTotalAmountDue.Text, "0.00")
End If
txtzhekou.Text = Format(str(Val(txtTotalAmountDue) * Val(txtzksp.Text)), "0.00")
End Sub