frmreturnitems.frm

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

            
      'Start - Print Receipt
      If Trim(FlexOverdue.TextMatrix(1, 0)) <> "" Then 'Print Rcpt
      '--------------------------------------------
            If MsgBox("请插入8 1/2"" by 13""纸张", vbOKCancel, "插入纸张") = vbCancel Then
                        'Start - Clear Flex
                            TDM = DoEvents
                            FlexOverdue.Rows = 2
                            FlexOverdue.TextMatrix(1, 0) = ""
                            FlexOverdue.TextMatrix(1, 1) = ""
                            TDM = DoEvents
                        'End - Clear Flex
                            txtTotal.Text = "0.00"
                            txtAmountPaid.Text = ""
                            txtChange.Text = ""
                            MsgBox "项目已成功回收！ ", vbInformation, "数据更新！ "
                            Call cmdRefresh_Click
                            MousePointer = vbDefault
                            MSFlexGrid1.SetFocus
                            Exit Sub
            End If
      'End If
     '--------------------------------------------
            Printer.Font = "Lucida Console"
            Printer.PaperSize = vbPRPSLegal ' 8.5 by 14 inc
            Printer.FontSize = 9
            Printer.Orientation = 1 'Portrait
      'Start - Rcpt Header
            Dim LeftMargin As Integer
            LeftMargin = 10
            Printer.Print ""
            Printer.Print "" ' You can put your company name here.
            Printer.Print Tab(LeftMargin); "______________________________________________________________________________________________"
            Printer.Print Tab(LeftMargin); "INVOICE No.   : " & UCase(Trim(strInvNum))
            Printer.Print Tab(LeftMargin); "NAME          : " & UCase("***** Member *****") & "  __________"
            Printer.Print Tab(LeftMargin); "DATE          : " & UCase(Format(Now, "mmm. dd, yyyy"))
            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 loop1 = 1 To FlexOverdue.Rows - 1
                ''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); "*********"; Tab(LeftMargin + 16); "*********"; Tab(LeftMargin + 32); "Overdue : " & FlexOverdue.TextMatrix(loop1, 0); Tab(LeftMargin + 85 - Len(Trim(FlexOverdue.TextMatrix(loop1, 1)))); Trim(FlexOverdue.TextMatrix(loop1, 1)); ""
                If loop1 = FlexOverdue.Rows - 1 Then
                    Printer.Print Tab(LeftMargin); "----------------------------------------------------------------------------------------------"
                    Printer.Print Tab(LeftMargin); "TOTAL         : "; Tab(LeftMargin + 34); Trim(str(FlexOverdue.Rows - 1)) & " - Item(s)"; Tab(LeftMargin + 85 - Len("P  " & Trim(txtTotal))); "P  " & Trim(txtTotal)
                    Printer.Print Tab(LeftMargin); "______________________________________________________________________________________________"
                End If
            Next loop1
            'End Detiled Section
            Printer.EndDoc
            'End - Print Receipt
        End If 'Print Rcpt
     '--------------------------------------------
      End If 'ReturnSuccess
      'Start - Clear Flex
            TDM = DoEvents
            FlexOverdue.Rows = 2
            FlexOverdue.TextMatrix(1, 0) = ""
            FlexOverdue.TextMatrix(1, 1) = ""
            TDM = DoEvents
            'End - Clear Flex
            txtTotal.Text = "0.00"
            txtAmountPaid.Text = ""
            txtChange.Text = ""
      MsgBox "项目已成功回收！", vbInformation, "数据更新"
      Call cmdRefresh_Click
      MousePointer = vbDefault
      MSFlexGrid1.SetFocus
   End If
End Sub
Private Sub cmdFlexToExcel_Click()
MousePointer = vbHourglass
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Call vr_engine.CopyFlexDataToExcel(MSFlexGrid1)
MousePointer = vbDefault
MSFlexGrid1.SetFocus
End Sub
Private Sub cmdRefresh_Click()
    MousePointer = vbHourglass
    Dim vr_engine As VRENTAL_ENGINE
    Set vr_engine = New VRENTAL_ENGINE
    Call vr_engine.Report_LoadUnreturnedItems(MSFlexGrid1, cboUnreturnedItemsSortBy, UnreturnedItems_SQL(), Opt1.Value, Check1.Value, cboUnreturnedItemsSortBy)
    Call LoadUnreturnedItemcodesToListBox '往lst1里添加条目
    Call vr_engine.Report_Loaditemcodecob(cboUnreturnedItemsSortBy) '往下拉框里添加数据
    lst2.Clear
    MSFlexGrid1.SetFocus
    MousePointer = vbDefault
End Sub
Sub UnreturnedItems_initializeFLEXGRID(Flex As MSFlexGrid)
MousePointer = vbHourglass
Dim vr_engine As VRENTAL_ENGINE
Set vr_engine = New VRENTAL_ENGINE
Dim mySQL As String
      
With Flex
     .ColWidth(0) = 600 'No.
     .ColWidth(1) = 1000 'Item Code
     .ColWidth(2) = 3000 'Title
     .ColWidth(3) = 1200 'Date Borrowed
     .ColWidth(4) = 1200 'Date Due
     .ColWidth(5) = 1300 'Overdue (Days)
     .ColWidth(6) = 1400 'Overdue Charges
     .ColWidth(7) = 800
     .ColWidth(8) = 3000 'Additional Info
     .ColAlignment(0) = 5 'No.
     .ColAlignment(1) = 5 'Item Code
     .ColAlignment(2) = 5 'Title
     .ColAlignment(3) = 5 'Date Borrowed
     .ColAlignment(4) = 5
     .ColAlignment(5) = 5 'Overdue (Days)
     .ColAlignment(6) = 5 'Overdue Charges
     .ColAlignment(7) = 5
     '.ColAlignment(4) = 5 'Additional Info      '如此设置居中模式
     .TextMatrix(0, 0) = " No. "
     .TextMatrix(0, 1) = "项目编号"
     .TextMatrix(0, 2) = "标题"
     .TextMatrix(0, 3) = "租借日期"
     .TextMatrix(0, 4) = "到期时间"
     .TextMatrix(0, 5) = "过期天数为"
     .TextMatrix(0, 6) = "过期需支付金额"
     .TextMatrix(0, 7) = "交易数量"
     .TextMatrix(0, 8) = "             补充说明"
End With
     'mySQL = "SELECT * FROM [CD TAPES TABLE] WHERE Available = 'No' ORDER BY LastDateBorrowed "
     Call vr_engine.Report_LoadUnreturnedItems(MSFlexGrid1, cboUnreturnedItemsSortBy, UnreturnedItems_SQL(), Opt1.Value, Check1.Value, cboUnreturnedItemsSortBy)
     Call vr_engine.Report_Loaditemcodecob(cboUnreturnedItemsSortBy)
     ' Start - Count Unreturned Items
     If MSFlexGrid1.Rows > 1 Then
        If Trim(MSFlexGrid1.TextMatrix(1, 0)) <> "" Then
         If Opt1.Value = True Then
            frmReturnItems1.Caption = "过期未返还项目数 " & str(MSFlexGrid1.Rows - 1) & " "
        ElseIf MSFlexGrid1.Rows > 1 Then
            frmReturnItems1.Caption = "未返还项目总数  " & str(MSFlexGrid1.Rows - 1)
        End If
      End If
    End If
     'End - Count Unreturned Items
     Call LoadUnreturnedItemcodesToListBox
MousePointer = vbDefault
End Sub
Function UnreturnedItems_SQL() As String
  If OptUnreturnedItemsAsc = True Then
    UnreturnedItems_SQL = "SELECT * FROM [CD TAPES TABLE] WHERE [Item Code] = 'No' ORDER BY [" & Trim(cboUnreturnedItemsSortBy.Text) & "]"
  Else
    UnreturnedItems_SQL = "SELECT * FROM [CD TAPES TABLE] WHERE [Item Code] = 'No' ORDER BY [" & Trim(cboUnreturnedItemsSortBy.Text) & "] Desc"
  End If
End Function
Private Sub cmdTransferToLeft_Click()
   On Error GoTo ErrorHandler
   Dim Char, tmpString As String
   Dim tmpLst2text As String
   Dim counter As Integer
   Dim loop1 As Long
   Dim Str1, str2 As String
   counter = 0
   Char = "A"
   tmpString = ""
   If Trim(lst2.Text <> "") Then
     tmpLst2text = lst2.Text
     
     Do While Char <> " "
        counter = counter + 1
        Char = Mid(Trim(lst2.Text), counter, 1)
        tmpString = tmpString & Char
     Loop
     lst1.AddItem Trim(tmpString)
     lst1.Text = Trim(tmpString)
     lst2.RemoveItem lst2.ListIndex
     txtfhsl.Text = ""
   End If
   ' Start Remove items from FlexOverdue
        For loop1 = 1 To FlexOverdue.Rows - 1
            Str1 = Trim(FlexOverdue.TextMatrix(loop1, 0))
            str2 = Trim(Mid(tmpLst2text, Len(tmpString), Len(tmpLst2text) + 1 - Len(tmpString)))
            If Len(Trim(Str1)) > 0 Then
                If Str1 = str2 Then
                    If FlexOverdue.Rows = 2 Then
                        FlexOverdue.TextMatrix(1, 0) = ""
                        FlexOverdue.TextMatrix(1, 1) = ""
                    Else
                        FlexOverdue.RemoveItem (loop1)
                    End If
                    Exit For
                End If
            End If
        Next loop1
    ' End Remove items from FlexOverdue
   If lst2.ListCount = 0 Then FlexOverdue.Clear
ErrorHandler:
   Call TotalOverDue
   lst1.SetFocus
End Sub
Private Sub cmdTransferToRight_Click()
  Dim FlexRow, loop1 As Long
  If Trim(lst1.Text <> "") Then
     For loop1 = 1 To MSFlexGrid1.Rows - 1
       If lst1.ListIndex + 1 > 99 Then
        If Trim(MSFlexGrid1.TextMatrix(loop1, 0)) = Mid(Trim(lst1.Text), 1, 3) Then
            lst2.AddItem lst1.Text & " " & Trim(MSFlexGrid1.TextMatrix(loop1, 2)) & " " & "*" & Mid(Trim(MSFlexGrid1.TextMatrix(loop1, 8)), 5) & "*" & " " & Trim(MSFlexGrid1.TextMatrix(loop1, 7))
            txtfhsl.Text = Trim(MSFlexGrid1.TextMatrix(loop1, 7))
            Exit For
        End If
       ElseIf lst1.ListIndex + 1 > 9 Then
        If Trim(MSFlexGrid1.TextMatrix(loop1, 0)) = Mid(Trim(lst1.Text), 1, 2) Then
            lst2.AddItem lst1.Text & " " & Trim(MSFlexGrid1.TextMatrix(loop1, 2)) & " " & "*" & Mid(Trim(MSFlexGrid1.TextMatrix(loop1, 8)), 5) & "*" & " " & Trim(MSFlexGrid1.TextMatrix(loop1, 7))
            txtfhsl.Text = Trim(MSFlexGrid1.TextMatrix(loop1, 7))
            Exit For
        End If
       ElseIf lst1.ListIndex + 1 > 0 Then
        If Trim(MSFlexGrid1.TextMatrix(loop1, 0)) = Mid(Trim(lst1.Text), 1, 1) Then
            lst2.AddItem lst1.Text & " " & Trim(MSFlexGrid1.TextMatrix(loop1, 2)) & " " & "*" & Mid(Trim(MSFlexGrid1.TextMatrix(loop1, 8)), 5) & "*" & " " & Trim(MSFlexGrid1.TextMatrix(loop1, 7))
            txtfhsl.Text = Trim(MSFlexGrid1.TextMatrix(loop1, 7))
            Exit For
        End If
       End If
     Next loop1
   'Start - Add Overdue items
    If Trim(MSFlexGrid1.TextMatrix(loop1, 6)) <> "0.00" Then
       If Trim(FlexOverdue.TextMatrix(1, 0)) = "" And FlexOverdue.Rows = 2 Then
          ' Do Nothing
       Else
          FlexOverdue.AddItem ""
       End If
       
       'Title Col
       FlexOverdue.TextMatrix(FlexOverdue.Rows - 1, 0) = MSFlexGrid1.TextMatrix(loop1, 2)
       'Overdue Amount Col
       FlexOverdue.TextMatrix(FlexOverdue.Rows - 1, 1) = MSFlexGrid1.TextMatrix(loop1, 6) & "   "
    End If
   'End - Add Overdue items
     lst1.RemoveItem lst1.ListIndex
  End If
  Call TotalOverDue
  lst1.SetFocus
End Sub
Private Sub FlexOverdue_Click()
'On Error Resume Next
 Dim loop1, counter As Long
 Dim Char As String
 
  For loop1 = 1 To lst2.ListCount
   If FlexOverdue.Rows > 1 Then
      counter = 0
      Char = "a" ' initialize to some values not equal to SPACE
      Do While Char <> " "
        counter = counter + 1
        Char = Mid(Trim(lst2.List(loop1 - 1)), counter, 1)
      Loop
        If Trim(Mid(lst2.List(loop1 - 1), counter, Len(lst2.List(loop1 - 1)) + 1 - counter)) = Trim(FlexOverdue.TextMatrix(FlexOverdue.RowSel, 0)) Then
           lst2.Text = lst2.List(loop1 - 1)
        End If
   End If
  Next
End Sub
Private Sub FlexOverdue_SelChange()
   Call FlexOverdue_Click
End Sub
Private Sub Form_Activate()
If FlagPrevActivate = True Then
Else
  FlagPrevActivate = True
  Call UnreturnedItems_initializeFLEXGRID(MSFlexGrid1)
  ' Start - FlexOverdue initialize
    FlexOverdue.ColWidth(0) = 2670
    FlexOverdue.ColWidth(1) = 1150
    FlexOverdue.TextMatrix(0, 0) = "标题"
    FlexOverdue.TextMatrix(0, 1) = "金额数    "
    FlexOverdue.ColAlignment(0) = 5
    FlexOverdue.ColAlignment(1) = 6
  ' End - FlexOverdue initialize
End If
End Sub
Private Sub LoadUnreturnedItemcodesToListBox()
   Dim FlexRow, loop1 As Long
    lst1.Clear  ' Erase list
    FlexRow = MSFlexGrid1.Rows
    If FlexRow > 1 Then
        For loop1 = 1 To FlexRow - 1
            If Trim(MSFlexGrid1.TextMatrix(loop1, 1)) <> "" Then
               lst1.AddItem Trim(MSFlexGrid1.TextMatrix(loop1, 0)) & "%" & Trim(MSFlexGrid1.TextMatrix(loop1, 1))
            End If
        Next
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
FlagPrevActivate = False
End Sub
Private Sub lst1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
   Call cmdTransferToRight_Click
End If
End Sub
Private Sub lst2_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
   Call cmdTransferToLeft_Click
   lst2.SetFocus
End If
End Sub
Private Sub MSFlexGrid1_Click()
   On Error Resume Next
   Dim lst As String
   If MSFlexGrid1.Rows > 1 Then lst = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 0) & "%" & MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 1)
   lst1.Text = Trim(lst)
End Sub
Private Sub MSFlexGrid1_EnterCell()
MSFlexGrid1.CellBackColor = vbCyan
End Sub
Private Sub MSFlexGrid1_GotFocus()

If MSFlexGrid1.Rows > 1 Then
   If Trim(MSFlexGrid1.TextMatrix(1, 0)) <> "" Then
    If Opt1.Value = True Then
        frmReturnItems1.Caption = "过期未返还项目数 " & str(MSFlexGrid1.Rows - 1) & " "
     Else
        frmReturnItems1.Caption = "未返还项目总数 " & str(MSFlexGrid1.Rows - 1) & " "
   End If
  End If
End If

End Sub
Private Sub MSFlexGrid1_LeaveCell()
MSFlexGrid1.CellBackColor = vbWhite
End Sub
Private Sub MSFlexGrid1_LostFocus()
MSFlexGrid1.CellBackColor = vbWhite
End Sub
Private Sub MSFlexGrid1_SelChange()
   On Error Resume Next
   If MSFlexGrid1.Rows > 1 Then
      lst1.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 1)
      MSFlexGrid1.CellBackColor = vbCyan
   End If
End Sub
Sub TotalOverDue()
    Dim vr_engine As VRENTAL_ENGINE
    Set vr_engine = New VRENTAL_ENGINE
    Dim Total As Double
    Total = 0
    For loop1 = 1 To FlexOverdue.Rows - 1
       Total = Total + Val(FlexOverdue.TextMatrix(loop1, 1))
    Next
    Call vr_engine.Round(Total, 2)
    txtTotal.Text = Format(str(Total), "0.00")
    
End Sub
Private Sub OptUnreturnedItemsAsc_Click()
Call cmdRefresh_Click
End Sub
Private Sub OptUnreturnedItemsDesc_Click()
Call cmdRefresh_Click
End Sub
Private Sub txtAmountPaid_Change()
If Val(txtTotal.Text) > 0 And Val(txtAmountPaid.Text) < Val(txtTotal.Text) Then
     cmdExecute.Enabled = False
  Else
     cmdExecute.Enabled = True
  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(txtTotal.Text) Then
             txtChange.Text = str(Val(Val(txtAmountPaid.Text) - Val(txtTotal.Text)))
             txtChange.Text = Format(txtChange.Text, "0.00")
          End If
       Else
          MsgBox "Amount paid is invalid. ", vbInformation, "非法输入！  "
          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
        '
    Else
       If Val(txtTotal.Text) > 0 Then
          '
       Else
          '
       End If
    End If
End Sub
Private Sub txtTotal_Change()
  If Val(txtTotal.Text) > 0 And Val(txtAmountPaid.Text) < Val(txtTotal.Text) Then
     cmdExecute.Enabled = False
  Else
     cmdExecute.Enabled = True
  End If
  Call txtAmountPaid_LostFocus
End Sub