frmtransaction.frm

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

            Height          =   255
            Index           =   1
            Left            =   8640
            TabIndex        =   26
            Top             =   240
            Width           =   615
         End
         Begin VB.Label Label3 
            Caption         =   "发票流水号："
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   9.75
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   0
            Left            =   2880
            TabIndex        =   25
            Top             =   240
            Width           =   1215
         End
      End
      Begin VB.Frame FrameDisplay 
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1815
         Left            =   240
         TabIndex        =   21
         Top             =   120
         Width           =   11415
         Begin VB.Label lblDisplay1 
            BackColor       =   &H00000000&
            Caption         =   "所租项目金额："
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   20.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H0000C0C0&
            Height          =   495
            Left            =   240
            TabIndex        =   23
            Top             =   240
            Width           =   10935
         End
         Begin VB.Label lblDisplay2 
            Alignment       =   1  'Right Justify
            BackColor       =   &H00000000&
            Caption         =   "0.00"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   36
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            ForeColor       =   &H0000C0C0&
            Height          =   810
            Left            =   240
            TabIndex        =   22
            Top             =   840
            Width           =   10935
         End
      End
   End
End
Attribute VB_Name = "frmTransaction"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ArrayOFNamesAndID(), MembersID(), MemberID_FindMode As String
Dim PrevTransItems() As String  'List of PrevTransaction items
Dim DeletedItems() As String
Dim PrevTransMode As Boolean
Private Sub cboDeleteRow_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then Call cmdDeleteRow_Click
End Sub
Private Sub cboItemCode_KeyPress(KeyAscii As Integer)
   If KeyAscii = vbKeyReturn Then Call cmdAddItem_Click
End Sub
Private Sub cmdAddItem_Click()
    Dim strMembersFile As String
    Dim loop1 As Long
    Dim TotalAmountDue As Double
    Dim vr_engine As VRENTAL_ENGINE
    Set vr_engine = New VRENTAL_ENGINE
    If Trim(cboItemCode.Text) = "" Then
        cboItemCode.SetFocus
        Exit Sub
    End If
    
  'Start - Chk if item has been borrowed already.检查此项目文籍是否被借出！
  If PrevTransMode = False Then
     strMembersFile = txtName.Text & " ID - " & MembersID(lstMembers.ListIndex + 1)
  Else
     strMembersFile = txtName.Text & " ID - " & MemberID_FindMode
  End If
  
   If vr_engine.Transaction_ChkIfItemHasBeenBorrowed(App.Path & "\Transaction\MembersRecords\" & strMembersFile & ".mdb", cboItemCode.Text) = True Then
     cboItemCode.Text = ""
     cboItemCode.SetFocus
     Exit Sub
   End If
  
  'Start - Chk if item code is already selected   检查项目是否已添加，加入库存的概念后这个已经失效
'    For loop1 = 1 To MSFlexGrid1.Rows
'     If loop1 <= MSFlexGrid1.Rows - 1 Then
'        If cboItemCode.Text = MSFlexGrid1.TextMatrix(loop1, 1) Then
'            MsgBox "项目编号已在列表！", vbInformation, "注意素质！."
'            cboItemCode.SetFocus
'            Exit Sub
'        End If
'     End If
'    Next

    Call vr_engine.Transaction_AddItem(MSFlexGrid1, cboItemCode, txtsl)
    '' caculate Total Amnt.
    For loop1 = 1 To MSFlexGrid1.Rows - 1
        TotalAmountDue = TotalAmountDue + Val(MSFlexGrid1.TextMatrix(loop1, 3)) * Val(MSFlexGrid1.TextMatrix(loop1, 4))
    Next
     If MSFlexGrid1.Rows = 1 Then MSFlexGrid1.AddItem ""
     If Trim(MSFlexGrid1.TextMatrix(1, 0)) = "" And Trim(MSFlexGrid1.TextMatrix(1, 1)) = "" And Trim(MSFlexGrid1.TextMatrix(1, 2)) = "" And Trim(MSFlexGrid1.TextMatrix(1, 3)) = "" Then
        cmdDeleteRow.Enabled = False
        cboDeleteRow.Enabled = False
        cboDeleteRow.Clear
     Else
        cmdDeleteRow.Enabled = True
        cboDeleteRow.Enabled = True
        cboDeleteRow.Clear
        For loop1 = 1 To MSFlexGrid1.Rows - 1
            cboDeleteRow.AddItem str(loop1)
        Next
     End If
        txtTotalAmountDue.Text = str(TotalAmountDue)
        cboItemCode.Text = ""
        cboItemCode.SetFocus
End Sub
Private Sub cmdCancel_Click()
    txtcxid.Locked = True             '关闭查询ID的输入
    cmdCancel.Enabled = False
    txtName.Text = ""
    txtInvoiceNumber.Text = ""
    txtDate.Text = ""
    cmdRefreshList.Enabled = False
    lstMembers.Clear
    lstMembers.Enabled = False
    cboItemCode.Clear
    cboItemCode.Enabled = False
    cmdAddItem.Enabled = False
    cmdDeleteRow.Enabled = False
    cboDeleteRow.Clear
    cboDeleteRow.Enabled = False
    txtTotalAmountDue.Text = ""
    txtAmountPaid.Text = ""
    txtChange.Text = ""
    MSFlexGrid1.Rows = 2
    MSFlexGrid1.TextMatrix(1, 0) = ""
    MSFlexGrid1.TextMatrix(1, 1) = ""
    MSFlexGrid1.TextMatrix(1, 2) = ""
    MSFlexGrid1.TextMatrix(1, 3) = ""
    lblDisplay2.Caption = "0.00"
    cmdNew.Enabled = True
    cmdFind.Enabled = True
    If cmdEdit.Enabled = True Then cmdEdit.Enabled = False
    If cmdDelete.Enabled = True Then cmdDelete.Enabled = False
    If cmdPrint.Enabled = True Then cmdPrint.Enabled = False
    Call cmdNew_Click
End Sub
Private Sub cmdDelete_Click()
    Dim vr_engine As VRENTAL_ENGINE
    Set vr_engine = New VRENTAL_ENGINE
    Dim X
    X = MsgBox("确定要删除此交易吗？", vbYesNo, "删除确认")
    If X = vbNo Then
       MSFlexGrid1.SetFocus
       Exit Sub
    End If
    Call vr_engine.Transaction_DeletePrevTransaction(Trim(txtInvoiceNumber.Text), Trim(txtName.Text) & " ID - " & MemberID_FindMode & ".mdb", Trim(txtName.Text))
    Call cmdCancel_Click
End Sub
Private Sub cmdDeleteRow_Click()
Dim loop1 As Integer
Dim FlagFORone As Boolean
Dim TotalAmountDue As Double
FlagFORone = False
   If IsNumeric(cboDeleteRow.Text) = True Then
       If Int(cboDeleteRow.Text) + 1 = MSFlexGrid1.Rows Then
            MSFlexGrid1.Rows = MSFlexGrid1.Rows - 1
            cboDeleteRow.RemoveItem (cboDeleteRow.ListCount - 1)
            For loop1 = 1 To MSFlexGrid1.Rows - 1
                TotalAmountDue = TotalAmountDue + Val(MSFlexGrid1.TextMatrix(loop1, 3)) * Val(MSFlexGrid1.TextMatrix(loop1, 4))
            Next
                txtTotalAmountDue.Text = str(TotalAmountDue)
                cboItemCode.Text = ""
                cboItemCode.SetFocus
   Else
                If Int(cboDeleteRow.Text) = 1 Then FlagFORone = True
            For loop1 = Int(cboDeleteRow.Text) + 1 To cboDeleteRow.ListCount
                If FlagFORone = True Then loop1 = 2
                FlagFORone = False
                MSFlexGrid1.TextMatrix(loop1 - 1, 1) = MSFlexGrid1.TextMatrix(loop1, 1)
                MSFlexGrid1.TextMatrix(loop1 - 1, 2) = MSFlexGrid1.TextMatrix(loop1, 2)
                MSFlexGrid1.TextMatrix(loop1 - 1, 3) = MSFlexGrid1.TextMatrix(loop1, 3)
                
            Next
                MSFlexGrid1.Rows = MSFlexGrid1.Rows - 1
                For loop1 = 1 To MSFlexGrid1.Rows - 1
                    TotalAmountDue = TotalAmountDue + Val(MSFlexGrid1.TextMatrix(loop1, 3)) * Val(MSFlexGrid1.TextMatrix(loop1, 4))
                Next
                cboDeleteRow.RemoveItem (cboDeleteRow.ListCount - 1)
                txtTotalAmountDue.Text = str(TotalAmountDue)
                cboItemCode.Text = ""
                cboItemCode.SetFocus
       End If
   End If
   cboItemCode.SetFocus
End Sub
Private Sub cmdEdit_Click()
  Dim vr_engine As VRENTAL_ENGINE
  Set vr_engine = New VRENTAL_ENGINE
  Dim loop1 As Long
  cmdEdit.Enabled = False
  cmdSave.Enabled = True
  cmdPrint.Enabled = True
  Call vr_engine.Transaction_LoadItemCodes(cboItemCode)
  cboItemCode.Enabled = True
  cmdAddItem.Enabled = True
  '' Load cboRow Number
     If MSFlexGrid1.Rows = 1 Then MSFlexGrid1.AddItem ""
     If Trim(MSFlexGrid1.TextMatrix(1, 0)) = "" And Trim(MSFlexGrid1.TextMatrix(1, 1)) = "" And Trim(MSFlexGrid1.TextMatrix(1, 2)) = "" And Trim(MSFlexGrid1.TextMatrix(1, 3)) = "" Then
        cmdDeleteRow.Enabled = False
        cboDeleteRow.Enabled = False
        cboDeleteRow.Clear
     Else
        cmdDeleteRow.Enabled = True
        cboDeleteRow.Enabled = True
        cboDeleteRow.Clear
        For loop1 = 1 To MSFlexGrid1.Rows - 1
            cboDeleteRow.AddItem str(loop1)
        Next
     End If
  '' End cboLoad Row Number
  
  '' START -- Store Prev Borrowed items to Memory
     ReDim PrevTransItems(MSFlexGrid1.Rows - 1)
     For loop1 = 1 To MSFlexGrid1.Rows - 1
         'Stores Item Code
         PrevTransItems(loop1) = MSFlexGrid1.TextMatrix(loop1, 1)
         ''Debug.Print PrevTransItems(loop1)
     Next
  '' END -- Store Prev Borrowed items to Memory
End Sub
Private Sub cmdFind_Click()          '查找以往的交易记录。。。
  Dim vr_engine As VRENTAL_ENGINE
  Set vr_engine = New VRENTAL_ENGINE
  Dim InvoiceNumber As String
  InvoiceNumber = InputBox("请输入所要查询的发票连号:", "Find Previous Transaction")
  If Trim(InvoiceNumber) <> "" Then
     txtInvoiceNumber.Text = InvoiceNumber
  Else
     MSFlexGrid1.SetFocus
     Exit Sub
  End If
  
  If vr_engine.Transaction_LoadPrevTransaction(MSFlexGrid1, txtTotalAmountDue, txtAmountPaid, txtChange, txtDate, txtInvoiceNumber, txtName, MemberID_FindMode) = True Then
    txtAmountPaid.Locked = True
    cmdFind.Enabled = False
    cmdNew.Enabled = False
    cmdEdit.Enabled = True
    cmdCancel.Enabled = True
    cmdDelete.Enabled = True
    PrevTransMode = True                    '这里把他赋予真值了，继续关注。
  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 [ID NUMBER] = " & Val(Mid(Trim(txtName.Text), 3, 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 cmdNew_Click()
  cmdNew.Enabled = False
  Dim vr_engine As VRENTAL_ENGINE
  Set vr_engine = New VRENTAL_ENGINE
  '' SetFlag
    PrevTransMode = False
  '' Load ItemCodes
      Call vr_engine.Transaction_LoadItemCodes(cboItemCode)
  '' Load Members ' Once
      Call vr_engine.Transaction_LoadNameOfMembers(lstMembers, ArrayOFNamesAndID(), MembersID())
      'MsgBox (MembersID(1) & MembersID(2) & MembersID(3) & MembersID(4) & MembersID(5))  'NEW按钮显示处理
      cmdRefreshList.Enabled = True
      cmdFind.Enabled = False
      cmdCancel.Enabled = True
      lstMembers.Enabled = True
      lblDisplay1.Caption = "新交易项"
      lblDisplay2.Caption = "从名单列表里选择租借者： "
      If lstMembers.Enabled = True Then lstMembers.SetFocus
      txtcxid.Locked = False
End Sub
Private Sub cmdPrint_Click()
'--------------------------------------------
If MsgBox("请插入 8 1/2"" by 13"" 纸张！", vbOKCancel, "插入纸张 ") = vbCancel Then
       MSFlexGrid1.SetFocus
       Exit Sub
End If
'--------------------------------------------
MousePointer = vbHourglass
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Printer.Font = "Lucida Console"
Printer.PaperSize = vbPRPSLegal ' 8.5 by 14 inc
Printer.FontSize = 9
Printer.Orientation = 1 'Portrait
    
Dim LeftMargin, PageCount, BlankLines As Integer
Dim DateDue() As String
Dim loop1, loop2, Lines, Flag As Long
LeftMargin = 10
Lines = MSFlexGrid1.Rows - 1