Point of Sale Tutorial Part 6 – Code in Product Category and POS Transaction

Option Explicit
'CODE FOR COMMAND BUTTON EXIT
Private Sub cmdExit_Click()
Unload Me
End Sub

'CODE FOR COMMAND BUTTON SAVE
Private Sub cmdSave_Click()
If txtCategory.Text = vbNullString Then
MsgBox "Please fill the text field.", vbCritical, "Error"
txtCategory.Text = vbNullString
Exit Sub
Else
Set rs = New ADODB.Recordset
rs.Open "Select * from Category", cn, adOpenKeyset, adLockPessimistic
With rs
.AddNew
.Fields("Category") = txtCategory.Text
.Fields("Description") = txtDescription.Text
.Fields("Remarks") = txtRemarks.Text
.Update
.Close
End With
Set rs = Nothing
MsgBox "Record Successfully Saved!", vbInformation, "Success Saved!"
txtCategory.Text = vbNullString
txtDescription.Text = vbNullString
txtRemarks.Text = vbNullString
txtCategory.SetFocus
End If
End Sub

'CODE FOR FORM LOAD
Private Sub Form_Load()
Call Module2.Connect
End Sub

'CODE FOR TEXTBOX CATEGORY KEYPRESS
Private Sub txtCategory_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase$(Chr$(KeyAscii)))
End Sub

Code in frmPOS

Option Explicit
Dim SRC_ITEM As ListItem
Dim QTY As Integer
Dim x As Long
Dim a As Long
Dim TOTAL_AMOUNT As Double
Dim SRC_RECORD As String
Dim SRC_PRODUCTCD As Variant

Private Sub cmdCashTend_Click()
frmCashTend.Show vbModal
End Sub

Private Sub cmdClose_Click()
Dim Reply As String
Reply = MsgBox("Are you sure you want to exit POS?", vbQuestion + vbOKCancel, Me.Caption)
If Reply = vbOK Then
lblInvoiceNo.Caption = vbNullString
lblTotal.Caption = "0.00"
lblTotalAmount.Caption = "0.00"
lblCashTend.Caption = "0.00"
lblChange.Caption = "0.00"
txtProductCD.Locked = True
cmdTransaction.Enabled = True
lvList.ListItems.Clear
ClearTextBox frmPOS
Unload Me
ElseIf Reply = vbCancel Then
Exit Sub
End If
End Sub

Private Sub cmdItemVoid_Click()
Dim ctr As Variant
Dim TOTAL_AMOUNT1 As Double

If lvList.ListItems.Count < 1 Then
MsgBox "No item(s) found in the list.Please check!", vbExclamation, Me.Caption
Exit Sub
End If

If Trim(SRC_PRODUCTCD) = vbNullString Then
MsgBox "Invalid selection.Can't proceed to this operation!", vbExclamation, Me.Caption
Exit Sub
End If

If MsgBox("Are you sure you want to void" & Space(1) & lvList.SelectedItem.SubItems(1) & "?", vbCritical + vbYesNo, Me.Caption) = vbYes Then
lvList.ListItems.Remove (SRC_PRODUCTCD)

For ctr = 1 To lvList.ListItems.Count
TOTAL_AMOUNT1 = Val(TOTAL_AMOUNT1) + lvList.ListItems(ctr).SubItems(4)
Next ctr

lblTotal.Caption = Format(TOTAL_AMOUNT1, "###,###,##0.00")

MsgBox "Selected item successfully voided!", vbInformation, Me.Caption
Else
Exit Sub
End If
End Sub

Private Sub cmdLock_Click()
frmLock.Show 1
End Sub

Private Sub cmdLookUp_Click()
frmLookUp.Show 1
End Sub

Private Sub cmdPrint_Click()
If lblChange.Caption = "0.00" Then
MsgBox "Pay the Item before printing..", vbCritical, "Error"
Exit Sub
ElseIf lblChange < 0 Then
MsgBox "Not enough cash..", vbExclamation, "Warning"
Exit Sub
Else
Dim strPath As String
strPath = "C:\Users\harvey\Desktop\SUBJECT (2ND SEM)\CS A2\printreceipt.txt"

Dim OpenExe As String
Open strPath For Output As #1

Print #1, Space(17) & "HB STORE"
Print #1, Space(8) & "Quezon St., Masbate City"
Print #1, Space(8) & "TIN: 0000-0123-4567-8910"
Print #1, Space(11) & "OR#: " & lblInvoiceNo.Caption
Print #1, "------------------------------------------"
Print #1, "ITEM QTY COST "
Print #1, "------------------------------------------"
For x = 1 To lvList.ListItems.Count
Print #1, lvList.ListItems(x).SubItems(1) & Space(12) & lvList.ListItems(x).SubItems(3) & Space(10) & lvList.ListItems(x).SubItems(2)
a = a + lvList.ListItems(x).SubItems(3)
Next x
Print #1, "------------------------------------------"
Print #1, "Total Items Sold : " & Space(16) & a
Print #1, "Sub Total : " & Space(22) '& Label9.Caption & vbCrLf
Print #1, "VAT (12%) : " & Space(23) '& Label7.Caption
Print #1, "Discount : " & Space(25) '& Label8.Caption
Print #1, "TOTAL AMOUNT : " & Space(19) & lblTotalAmount.Caption
Print #1, "------------------------------------------" & vbCrLf
Print #1, "Cash : " & Space(27) & lblCashTend.Caption
Print #1, "Change: " & Space(26) & lblChange.Caption & vbCrLf & vbCrLf
Print #1, "Date: " & Date & Space(9) & "Time: " & Time & vbCrLf
Print #1, Space(2) & "THANK YOU FOR SHOPPING @ HB Store!"
Close #1
OpenExe = Shell("Notepad " + strPath, vbNormalFocus)
End If
End Sub

Private Sub cmdSave_Click()
If lblChange < lblCashTend Then
MsgBox "Not enough cash!", vbExclamation, "Warning"
Exit Sub
Else
Dim i As Variant

For i = 1 To lvList.ListItems.Count '<--- begin for loop

Set rs = New ADODB.Recordset
If rs.State = adStateOpen Then rs.Close

If lvList.ListItems.Count < 1 Then
MsgBox "No active transaction detected.Can proceed ot this operation!", vbExclamation, Me.Caption
Exit Sub
End If

rs.Open "Select * From [Transaction]", cn, adOpenKeyset, adLockPessimistic
rs.AddNew
rs.Fields("ORNo") = lblInvoiceNo.Caption
rs.Fields("BarCode") = lvList.ListItems(i).Text
rs.Fields("Product") = lvList.ListItems(i).SubItems(1)
rs.Fields("UnitPrice") = lvList.ListItems(i).SubItems(2)
rs.Fields("Qty") = lvList.ListItems(i).SubItems(3)
rs.Fields("SubTotal") = lvList.ListItems(i).SubItems(4)
rs.Fields("CashTend") = lblCashTend.Caption
rs.Fields("CashChange") = lblChange.Caption
rs.Fields("TransDate") = Now
rs.Fields("Cashier") = Label9.Caption
rs.Update
rs.Close

Next i
MsgBox "Transaction: " & lblInvoiceNo.Caption & vbNewLine & " Successfully Saved!", vbInformation, Me.Caption
Exit Sub
Set rs = Nothing
End If

End Sub

Private Sub cmdTransaction_Click()
cmdTransaction.Enabled = False
lblInvoiceNo.Caption = vbNullString

Randomize
lblInvoiceNo.Caption = "ORN-" & Round(Rnd() * 9999999999#) & lblInvoiceNo.Caption + Chr(Round(Rnd() * 25) + 65)

txtProductCD.Locked = False
txtProductCD.SetFocus
ClearTextBox frmPOS

End Sub

Private Sub Form_Load()
Call FillListviewHeader
Call Module2.Connect

On Error GoTo ERR_LOAD

Set lvList.SmallIcons = MDIMain.i16x16
Set lvList.Icons = MDIMain.i16x16

Set cmdTransaction.Picture = i32x32.ListImages(1).Picture
Set cmdItemVoid.Picture = i32x32.ListImages(2).Picture
Set cmdLookUp.Picture = i32x32.ListImages(3).Picture
Set cmdCashTend.Picture = i32x32.ListImages(4).Picture
Set cmdPrint.Picture = i32x32.ListImages(5).Picture
Set cmdSave.Picture = i32x32.ListImages(6).Picture
Set cmdClose.Picture = i32x32.ListImages(7).Picture

Set cmdItemDetail.Picture = img32.ListImages(6).Picture
Set cmdStockMonitor.Picture = img32.ListImages(26).Picture
Set cmdReports.Picture = img32.ListImages(15).Picture
Set cmdHelp.Picture = img32.ListImages(20).Picture
Set cmdLock.Picture = img32.ListImages(21).Picture

Label9.Caption = MDIMain.MDIStatus.Panels(3).Text

Call FillListviewHeader

Exit Sub
ERR_LOAD:
MsgBox "Error Number:" & Err.Number & vbNewLine & "Description:" & Err.Description, vbExclamation, "Error Loading"
End Sub

Private Sub lblTotal_Change()
lblTotalAmount.Caption = lblTotal.Caption
End Sub

Public Sub FillListviewHeader()
On Error Resume Next
With lvList
.View = lvwReport
.ColumnHeaders.Clear
.ColumnHeaders.Add , , "ProductCD", txtProductCD.Width
.ColumnHeaders.Add , , "Description", txtDescription.Width
.ColumnHeaders.Add , , "UnitPrice", txtUnitPrice.Width
.ColumnHeaders.Add , , "Quantity", txtQuantity.Width
.ColumnHeaders.Add , , "Sub-Total", txtSubTotal.Width
End With
End Sub

Private Sub lvList_ItemClick(ByVal Item As MSComctlLib.ListItem)
On Error Resume Next
SRC_PRODUCTCD = lvList.SelectedItem.Index
SRC_RECORD = lvList.ListItems(SRC_PRODUCTCD).Text
End Sub

Private Sub Timer1_Timer()
If Label9.Visible = True Then
Label9.Visible = False
Else
Label9.Visible = True
End If

End Sub

Private Sub txtProductCD_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode

Case vbKeyF1
cmdTransaction_Click
Case vbKeyF2
cmdItemVoid_Click
Case vbKeyF3
' cmdLookUp_Click
Case vbKeyF4
cmdCashTend_Click
Case vbKeyF10
cmdPrint_Click
Case vbKeyF11
cmdSave_Click
Case vbKeyF12
cmdClose_Click
Case vbKeyEscape
cmdClose_Click
End Select
End Sub

Private Sub txtProductCD_KeyPress(KeyAscii As Integer)
Dim SRC_SQL As String
On Error Resume Next
If KeyAscii = 13 Then

SRC_SQL = "SELECT StockIn.* " & _
"FROM StockIn " & _
"WHERE StockIn.BarCode = '" & txtProductCD.Text & "'"

Set rs = New ADODB.Recordset
If rs.State = adStateOpen Then rs.Close
rs.Open SRC_SQL, cn, adOpenDynamic, adLockPessimistic

If isExistinLV(lvList, txtProductCD.Text, True) = True Then
MsgBox "Product/Item already added in the list.Please check it!", vbExclamation, Me.Caption
Exit Sub
End If

If rs.RecordCount < 1 Then
MsgBox "Product/Item not found!", vbExclamation, Me.Caption
txtProductCD.SetFocus
Exit Sub
Else
txtDescription.Text = rs.Fields("Product")
txtUnitPrice.Text = Format(rs.Fields("UnitPrice"), "###,###,##0.00")
txtQuantity.SetFocus
End If
End If
End Sub


'FUNCTIONS
Public Sub Highlight(ByRef srcText)
On Error Resume Next
With srcText
.SelStart = 0
.SelLength = Len(srcText.Text)
End With
End Sub
Public Function isExistinLV(ByRef srcLV As ListView, ByVal strFind As String, ByVal inFirst As Boolean, Optional numCol As Byte) As Boolean
If srcLV.ListItems.Count < 1 Then Exit Function
Dim i As Long
For i = 1 To srcLV.ListItems.Count
srcLV.ListItems(i).Selected = True
If inFirst = True Then
If srcLV.SelectedItem = strFind Then isExistinLV = True: Exit For
Else
If srcLV.SelectedItem.ListSubItems(numCol) = strFind Then isExistinLV = True: Exit For
End If
Next i
i = 0
End Function

Public Sub FillListview()

QTY = Val(txtQuantity.Text)

Set SRC_ITEM = lvList.FindItem(txtProductCD.Text, , , lvwPartial)
If SRC_ITEM Is Nothing Then
Set SRC_ITEM = lvList.ListItems.Add(, , txtProductCD.Text, 9, 9)
With SRC_ITEM
.SubItems(1) = txtDescription.Text
.SubItems(2) = txtUnitPrice.Text
.SubItems(3) = txtQuantity.Text
.SubItems(4) = Format(.SubItems(3) * .SubItems(2), "###,###,##0.00")
End With
Else
MsgBox "Product/Item already added in the list.Please check it!", vbExclamation, Me.Caption
Exit Sub
End If
End Sub

Private Sub txtQuantity_Change()
On Error Resume Next
txtSubTotal.Text = Format((txtQuantity.Text) * (txtUnitPrice.Text), "###,###0.00")
End Sub

Private Sub txtQuantity_GotFocus()
Highlight txtQuantity
End Sub

Private Sub txtQuantity_KeyPress(KeyAscii As Integer)
On Error Resume Next

If KeyAscii = 13 Then

If Not IsNumeric(txtQuantity.Text) = True Then
MsgBox "Sorry you have entered invalid input.Please enter numeric character only!", vbExclamation, Me.Caption
Exit Sub
End If

If txtQuantity.Text = vbNullString Then
MsgBox "Quantity shoud be greater than zero!", vbInformation, Me.Caption
Exit Sub
Else

Call FillListview

For x = 1 To lvList.ListItems.Count
TOTAL_AMOUNT = TOTAL_AMOUNT + lvList.ListItems(x).SubItems(4)
Next x

lblTotal.Caption = Format(TOTAL_AMOUNT, "###,###,##0.00")
TOTAL_AMOUNT = 0
ClearTextBox frmPOS
txtProductCD.SetFocus
End If
End If
End Sub