frmreturnitems.frm

一个关于DVD租赁管理的程序源码,充分调动了VB的各项开发功能.不可多得

            '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 "Item(s) has been sucessfully returned.  ", vbInformation, "Database Updated. "
      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, UnreturnedItems_SQL())
    Call LoadUnreturnedItemcodesToListBox
    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) = 1600 'Item Code
     .ColWidth(2) = 3000 'Title
     .ColWidth(3) = 1600 'Date Borrowed
     
     .ColWidth(4) = 1600 'Date Due
     
     .ColWidth(5) = 1600 'Overdue (Days)
     .ColWidth(6) = 1600 'Overdue Charges
     .ColWidth(7) = 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(4) = 5 'Additional Info
     
     .TextMatrix(0, 0) = " No. "
     .TextMatrix(0, 1) = "Item Code"
     .TextMatrix(0, 2) = "Title"
     .TextMatrix(0, 3) = "Date Borrowed"
     
     .TextMatrix(0, 4) = "Date Due"
     
     .TextMatrix(0, 5) = "Overdue (Days)"
     .TextMatrix(0, 6) = "Overdue Charges"
     .TextMatrix(0, 7) = "                      Additional Info"
End With
     'mySQL = "SELECT * FROM [CD TAPES TABLE] WHERE Available = 'No' ORDER BY LastDateBorrowed "
     Call vr_engine.Report_LoadUnreturnedItems(MSFlexGrid1, UnreturnedItems_SQL())
     ' Start - Count Unreturned Items
     If MSFlexGrid1.Rows > 1 Then
        If Trim(MSFlexGrid1.TextMatrix(1, 0)) <> "" Then
            frmReturnItems1.Caption = "Unreturneditem(s) " & str(MSFlexGrid1.Rows - 1) & " "
        Else
            frmReturnItems1.Caption = "Unreturneditem(s) 0 "
        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 Available = 'No' ORDER BY [" & Trim(cboUnreturnedItemsSortBy.Text) & "]"
  Else
    UnreturnedItems_SQL = "SELECT * FROM [CD TAPES TABLE] WHERE Available = '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
   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
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 Trim(MSFlexGrid1.TextMatrix(loop1, 1)) = Trim(lst1.Text) Then
            lst2.AddItem lst1.Text & "  " & Trim(MSFlexGrid1.TextMatrix(loop1, 2))
            lst2.Text = lst1.Text & "  " & Trim(MSFlexGrid1.TextMatrix(loop1, 2))
            Exit For
         End If
     Next
     
   '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) = 2270
    FlexOverdue.ColWidth(1) = 950
    FlexOverdue.TextMatrix(0, 0) = "Title"
    FlexOverdue.TextMatrix(0, 1) = "Amount    "
    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, 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
   If MSFlexGrid1.Rows > 1 Then lst1.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.RowSel, 1)
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
        frmReturnItems1.Caption = "Unreturneditem(s) " & str(MSFlexGrid1.Rows - 1) & " "
     Else
        frmReturnItems1.Caption = "Unreturneditem(s) 0 "
   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, "Invalid input.  "
          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