frmsalesreceiptsbatch.frm

Inventory control system

         Object.Width           =   4304
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "City"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "RefNo"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   3
         Text            =   "Agent"
         Object.Width           =   4304
      EndProperty
      BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   4
         Text            =   "Date Of Delivery"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   5
         Text            =   "Status"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   6
         Text            =   "Deducted"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   7
         Text            =   "Printed"
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.Label lblTitle 
      BackStyle       =   0  'Transparent
      Caption         =   "Receipts"
      BeginProperty Font 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000014&
      Height          =   210
      Left            =   75
      TabIndex        =   11
      Top             =   120
      Width           =   4815
   End
   Begin VB.Shape shpBar 
      BackColor       =   &H80000010&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H80000010&
      Height          =   240
      Left            =   0
      Top             =   120
      Width           =   6915
   End
End
Attribute VB_Name = "frmSalesReceiptsBatch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim CURR_COL            As Integer
Dim RSReceiptsBatch     As New Recordset
Dim RSReceipts          As New Recordset
Dim RecordPageBatch     As New clsPaging
Dim SQLParserBatch      As New clsSQLSelectParser
Dim RecordPage          As New clsPaging
Dim SQLParser           As New clsSQLSelectParser
Dim intRoute            As Integer

'Procedure used to filter records
Public Sub FilterRecord(ByVal srcCondition As String)
    SQLParserBatch.RestoreStatement
    SQLParserBatch.wCondition = srcCondition
    
    ReloadRecords1 SQLParserBatch.SQLStatement
End Sub

Public Sub CommandPass(ByVal srcPerformWhat As String)
    On Error GoTo err
    Select Case srcPerformWhat
        Case "New"
            frmSalesReceiptsBatchAE.State = adStateAddMode
            frmSalesReceiptsBatchAE.show vbModal
        Case "Edit"
            If lvList.ListItems.Count > 0 Then
                If isRecordExist("Receipts_Batch", "ReceiptBatchID", CLng(LeftSplitUF(lvList.SelectedItem.Tag))) = False Then
                    MsgBox "This record has been removed by other user. Click 'OK' button to refresh the records.", vbExclamation
                    RefreshRecords1
                    Exit Sub
                Else
                    With frmSalesReceiptsBatchAE
                        .State = adStateEditMode
                        .PK = CLng(LeftSplitUF(lvList.SelectedItem.Tag))
                        .show vbModal
                        RefreshRecords1
                    End With
                End If
            End If
        Case "Search"
            With frmSearch
                Set .srcForm = Me
                Set .srcColumnHeaders = lvList.ColumnHeaders
                .show vbModal
            End With
        Case "Delete"
            If lvList.ListItems.Count > 0 Then
                If isRecordExist("Receipts_Batch", "ReceiptBatchID", CLng(LeftSplitUF(lvList.SelectedItem.Tag))) = False Then
                    MsgBox "This record has been removed by other user.Click 'OK' button to refresh the records.", vbExclamation
                    RefreshRecords1
                    Exit Sub
                Else
                    Dim ANS As Integer
                    ANS = MsgBox("Are you sure you want to void the selected record?" & vbCrLf & vbCrLf & "WARNING: You cannot undo this operation. This will permanently remove the record.", vbCritical + vbYesNo, "Confirm Record")
                    Me.MousePointer = vbHourglass
                    If ANS = vbYes Then
                        'Remove
                        DelRecwSQL "Receipts_Batch", "ReceiptBatchID", "", True, CLng(LeftSplitUF(lvList.SelectedItem.Tag))
                        'Refresh the records
                        RefreshRecords1
                        MsgBox "Record has been successfully removed.", vbInformation, "Confirm"
                    End If
                    ANS = 0
                    Me.MousePointer = vbDefault
                End If
            Else
                MsgBox "No record to void.", vbExclamation
            End If
        Case "Refresh"
            RefreshRecords1
        Case "Print"
        Case "Close"
            Unload Me
    End Select
    Exit Sub
    'Trap the error
err:
    If err.Number = -2147467259 Then
        MsgBox "You cannot delete this record because it was used by other records! If you want to delete this record" & vbCrLf & _
               "you will first have to delete or change the records that currenly used this record as shown bellow." & vbCrLf & vbCrLf & _
               err.Description, , "Delete Operation Failed!"
        Me.MousePointer = vbDefault
    Else
        MsgBox err.Description, vbInformation
        Me.MousePointer = vbDefault
    End If
End Sub

Public Sub RefreshRecords1()
    SQLParserBatch.RestoreStatement
    ReloadRecords1 SQLParserBatch.SQLStatement
End Sub

Public Sub RefreshRecords2()
    SQLParser.RestoreStatement
    ReloadRecords2 SQLParser.SQLStatement
End Sub

'Procedure for reloadingrecords
Public Sub ReloadRecords1(ByVal srcSQL As String)
    '-In this case I used SQL because it is faster than Filter function of VB
    '-when hundling millions of records.
    On Error GoTo err
    With RSReceiptsBatch
        If .State = adStateOpen Then .Close
        .Open srcSQL
    End With
    RecordPageBatch.Refresh
    FillList1 1
    Exit Sub
err:
        If err.Number = -2147217913 Then
            srcSQL = Replace(srcSQL, "'", "", , , vbTextCompare)
            Resume
        ElseIf err.Number = -2147217900 Then
            MsgBox "Invalid search operation.", vbExclamation
            SQLParserBatch.RestoreStatement
            srcSQL = SQLParserBatch.SQLStatement
            Resume
        Else
            prompt_err err, Name, "ReloadRecords1"
        End If
End Sub

'Procedure for reloadingrecords
Public Sub ReloadRecords2(ByVal srcSQL As String)
    '-In this case I used SQL because it is faster than Filter function of VB
    '-when hundling millions of records.
    On Error GoTo err
    With RSReceipts
        If .State = adStateOpen Then .Close
        .Open srcSQL
    End With
    RecordPage.Refresh
    FillList2 1
    Exit Sub
err:
        If err.Number = -2147217913 Then
            srcSQL = Replace(srcSQL, "'", "", , , vbTextCompare)
            Resume
        ElseIf err.Number = -2147217900 Then
            MsgBox "Invalid search operation.", vbExclamation
            SQLParser.RestoreStatement
            srcSQL = SQLParser.SQLStatement
            Resume
        Else
            prompt_err err, Name, "ReloadRecords2"
        End If
End Sub

Private Sub btnClose_Click()
    Unload Me
End Sub

Private Sub btnFirst1_Click()
    If RecordPageBatch.PAGE_CURRENT <> 1 Then FillList1 1
End Sub

Private Sub btnLast1_Click()
    If RecordPageBatch.PAGE_CURRENT <> RecordPageBatch.PAGE_TOTAL Then FillList1 RecordPageBatch.PAGE_TOTAL
End Sub

Private Sub btnNext1_Click()
    If RecordPageBatch.PAGE_CURRENT <> RecordPageBatch.PAGE_TOTAL Then FillList1 RecordPageBatch.PAGE_NEXT
End Sub

Private Sub btnPrev1_Click()
    If RecordPageBatch.PAGE_CURRENT <> 1 Then FillList1 RecordPageBatch.PAGE_PREVIOUS
End Sub

Private Sub CmdAddReceipt_Click()
    With frmSalesReceiptsAE
        .State = adStateAddMode
        .ReceiptBatchPK = LeftSplitUF(lvList.SelectedItem.Tag)
        .dtpDeliveryDate = lvList.SelectedItem.SubItems(4)
        .dcAgent = lvList.SelectedItem.SubItems(2)
        .show vbModal
        
        RefreshRecords1
    End With
End Sub

Private Sub cmdDelete_Click()
    If lvList.ListItems.Count > 0 Then
        If isRecordExist("Receipts", "ReceiptID", CLng(LeftSplitUF(lvList2.SelectedItem.Tag))) = False Then
            MsgBox "This record has been removed by other user.Click 'OK' button to refresh the records.", vbExclamation
            RefreshRecords1
            Exit Sub
        Else
            Dim ANS As Integer
            ANS = MsgBox("Are you sure you want to void the selected record?" & vbCrLf & vbCrLf & "WARNING: You cannot undo this operation. This will permanently remove the record.", vbCritical + vbYesNo, "Confirm Record")
            Me.MousePointer = vbHourglass
            If ANS = vbYes Then
                'Remove
                DelRecwSQL "Receipts", "ReceiptID", "", True, CLng(LeftSplitUF(lvList2.SelectedItem.Tag))
                'Refresh the records
                RefreshRecords2
                MsgBox "Record has been successfully removed.", vbInformation, "Confirm"
            End If
            ANS = 0
            Me.MousePointer = vbDefault
        End If
    Else
        MsgBox "No record to void.", vbExclamation
    End If
End Sub

Private Sub cmdPrint_Click()
    PopupMenu MAIN.mnu_ReceiptsBatch
End Sub

Private Sub cmdReturn_Click()
    Dim RSSalesReturn As New Recordset
    Dim ReceiptPK As Integer
    
    ReceiptPK = CLng(LeftSplitUF(lvList2.SelectedItem.Tag))
    
    RSSalesReturn.CursorLocation = adUseClient
    RSSalesReturn.Open "SELECT SalesReturnID FROM Sales_Return WHERE ReceiptID=" & ReceiptPK, CN, adOpenStatic, adLockOptimistic
    
    With frmSalesReturnAE
        If RSSalesReturn.RecordCount > 0 Then 'if record exist then edit record
            Dim blnStatus As Boolean
            
            blnStatus = getValueAt("SELECT SalesReturnID,Status FROM Sales_Return WHERE SalesReturnID=" & RSSalesReturn!SalesReturnID, "Status")
            
            If blnStatus Then 'true
                .State = adStateViewMode
            Else
                .State = adStateEditMode
            End If
            
            .PK = RSSalesReturn!SalesReturnID
        Else
            .State = adStateAddMode
            .ReceiptPK = ReceiptPK
        End If
        
        .show vbModal
    End With
End Sub