POS code in Visual Basic

[fraijyia]

Anyone, please help me to make a program that has something to do with POS in Visual Basic ... Please! Thank you . You can email it at email removed

[monarchmk]

This is simple sales... now show us that you are willing to participate in development of your homework so we can help you further

For codedown you need only a Form and CommandButton (named Command button 1)

Private Sub Command1_Click()
Dim qty As Double
Dim partno As String
Dim price As Double

partno = InputBox("Which partno do you want to sale", "Sales", 0)
qty = InputBox("Please Enter quantity for partno " & partno, "Sales", 0)
price = InputBox("Please Enter Sales price for " & qty & " pcs of " & partno, "SAles", 0)

MsgBox "You bill is " & Chr(13) & partno & " " & qty & " x  " & price & Chr(13) & _
"                    " & Round(qty * price), vbOKOnly, "Sales"

End Sub

[satti]

Sending u a POS form code,u better understand and make it according to ur requirement

Option Explicit
Dim gSlno, gItemCode, gItemname, gQty, gRate, gTotal, Inti
Dim Indx
Private Sub cmbItmcode_Change()
MsfBill.Text = cmbItmcode.Text
End Sub

Private Sub cmbItmcode_KeyPress(KeyAscii As Integer)
On Error GoTo Err_Handler
If KeyAscii = 13 Then
   cmbItmcode.Visible = False
   MsfBill.TextMatrix(Indx, 1) = cmbItmcode.Text
   If Rs.State = 1 Then Rs.Close
   Rs.Open "select itmname,Rate from itemmaster where itmcode='" & cmbItmcode.Text & "'"
      If Not Rs.EOF Then
         MsfBill.TextMatrix(Indx, 2) = Rs!Itmname & ""
         MsfBill.TextMatrix(Indx, 3) = Rs!Rate & ""
         MsfBill.Col = 4
         ArrangeTextbox txtEnter
      Else
         MsgBox "Invalid Item code Please Check it ", vbCritical
         MsfBill.Col = 1
         ArrangeTextbox cmbItmcode
      End If
End If
Exit Sub
Err_Handler:
If Err.Number > 0 Then
  MsgBox Err.Description, vbCritical
End If
End Sub

Private Sub Form_Activate()
On Error GoTo Err_Handler
MsfBill.SetFocus
MsfBill.Row = 1
MsfBill.Col = 1
ArrangeTextbox cmbItmcode
Indx = 1
MsfBill.TextMatrix(Indx, 0) = Indx
txtInvoiceNo.Text = GetNewNo("select max(invoiceNo)+1 from sales")
Exit Sub
Err_Handler:
If Err.Number > 0 Then
  MsgBox Err.Description, vbCritical
End If
End Sub

Private Sub Form_Load()
MsfRefresh
FillCombo cmbItmcode, "select itmcode from ItemMaster"
End Sub
Private Sub MsfRefresh()
With MsfBill
      .Clear
      .Cols = 5
      .Rows = 2
      .FormatString = "^SL No | Item Code | Item Name | Rate  | Qty  | Total "
       gSlno = 0
       gItemCode = 1
       gItemname = 2
       gQty = 3
       gRate = 4
       gTotal = 5
       .Row = 0
       For Inti = 0 To .Cols - 1
          .Col = Inti
          .CellFontBold = True
       Next
       .ColWidth(gSlno) = 10 * 100
       .ColWidth(gItemCode) = 26 * 100
       .ColWidth(gItemname) = 26 * 100
       .ColWidth(gRate) = 15 * 100
       .ColWidth(gQty) = 15 * 100
       .ColWidth(gTotal) = 15 * 100
       .RowHeight(0) = 350
       .RowHeightMin = 350
End With
End Sub

Private Sub ArrangeTextbox(ctrl As Control)
  ctrl.Left = MsfBill.Left + MsfBill.CellLeft
  ctrl.Top = MsfBill.Top + MsfBill.CellTop
  ctrl.Text = MsfBill.Text
  ctrl.Width = MsfBill.ColWidth(MsfBill.Col) - 10
  If TypeOf ctrl Is TextBox Then
  ctrl.Height = MsfBill.RowHeight(MsfBill.Row) - 10
  End If
  ctrl.Visible = True
  ctrl.Text = ""
  ctrl.SetFocus
  ctrl.SelStart = 0
  ctrl.SelLength = Len(ctrl.Text)
End Sub

Private Sub ImgCancel_Click()
Me.Hide
frmMaster.Show
End Sub

Private Sub ImgNew_Click()
Clear frmsalesbill
txtInvoiceNo.Text = GetNewNo("select max(invoiceNo)+1 from sales")
MsfRefresh
MsfBill.SetFocus
MsfBill.Row = 1
MsfBill.Col = 1
ArrangeTextbox cmbItmcode
Indx = 1
MsfBill.TextMatrix(Indx, 0) = Indx
End Sub

Private Sub ImgSave_Click()
On Error GoTo Err_Handler
Dim I
Dim TrxType
TrxType = "S"
If MsgBox("Do you want to Save Bill", vbQuestion + vbYesNo + vbDefaultButton1, "Save Items") = vbYes Then
    For I = 1 To MsfBill.Row
     If Len(Trim(MsfBill.TextMatrix(I, 1))) = 0 Then
           MsgBox "Item Code. is Empty Please Enter"
           MsfBill.Row = I
           MsfBill.Col = 1
           Exit Sub
        End If
        If Len(Trim(MsfBill.TextMatrix(I, 4))) = 0 Then
           MsgBox "Qty. is Empty Please Enter"
           MsfBill.Row = I
           MsfBill.Col = 41
           Exit Sub
        End If
        If Len(Trim(MsfBill.TextMatrix(I, 3))) = 0 Then
           MsgBox "Rate is Empty Please Enter"
           MsfBill.Row = I
           MsfBill.Col = 3
           Exit Sub
        End If
        If Val(MsfBill.TextMatrix(I, 3)) = 0 Then
           MsgBox "Cheque Amount is Empty Please Enter"
           MsfBill.Row = I
           MsfBill.Col = 3
           Exit Sub
        End If
    Next
    For I = 1 To MsfBill.Row
        Update1 "Stock", MsfBill.TextMatrix(I, 1), MsfBill.TextMatrix(I, 4) * -1, TrxType, MsfBill.TextMatrix(I, 3)
        Update1 "Sales", txtInvoiceNo.Text, Format(Date, "dd-mmm-yyyy"), MsfBill.TextMatrix(I, 1), MsfBill.TextMatrix(I, 4), TrxType, MsfBill.TextMatrix(I, 5), txtTotal
    Next
    MsgBox "New Bill  details sucessfully Updated", vbInformation
    txtInvoiceNo.Text = GetNewNo("select max(invoiceNo)+1from sales")
    ImgNew_Click
End If
Exit Sub
Err_Handler:
If Err.Number > 0 Then
  MsgBox Err.Description, vbCritical
End If
End Sub

Private Sub MsfBill_Click()
  If MsfBill.Col = 1 Then
     MsfBill.Col = 1
     ArrangeTextbox cmbItmcode
  ElseIf MsfBill.Col = 2 Then
     MsfBill.Col = 2
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 3 Then
     MsfBill.Col = 3
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 4 Then
     MsfBill.Col = 4
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 5 Then
     MsfBill.Col = 5
     ArrangeTextbox txtEnter
  End If
End Sub

Private Sub Timer1_Timer()
LblDateTime.Caption = Time & " " & Format(Date, "DDDD")
End Sub

Private Sub txtEnter_Change()
MsfBill.Text = txtEnter.Text
End Sub

Private Sub txtEnter_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
  If MsfBill.Col = 1 Then
     MsfBill.Col = 2
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 2 Then
     MsfBill.Col = 3
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 3 Then
     MsfBill.Col = 4
     ArrangeTextbox txtEnter
  ElseIf MsfBill.Col = 4 Then
      MsfBill.TextMatrix(Indx, 5) = Val(MsfBill.TextMatrix(Indx, 3)) * Val(MsfBill.TextMatrix(Indx, 4))
      FlexgridTotal
      If MsgBox("Do you want to add Additional Items", vbQuestion + vbYesNo + vbDefaultButton1, "Additional Items") = vbYes Then
           MsfBill.Rows = MsfBill.Rows + 1
           Indx = Indx + 1
           MsfBill.Col = 1
           MsfBill.Row = Indx
           MsfBill.TextMatrix(Indx, 0) = Indx
           txtEnter.Visible = False
           ArrangeTextbox cmbItmcode
      Else
          ImgSave_Click
  End If
End If
End If
End Sub
Private Sub FlexgridTotal()
Dim sTot
If Indx = 1 Then
sTot = Val(MsfBill.TextMatrix(Indx, 5))
End If
sTot = Val(txtTotal) + Val(MsfBill.TextMatrix(Indx, 5))
txtTotal.Text = sTot
End Sub
Private Function CalculateTotAmount()
 Dim ToTamt
        ToTamt = 0
         For Inti = 1 To MsfBill.Rows - 1
            ToTamt = ToTamt + Val(MsfBill.TextMatrix(Inti, 3))
        Next
        CalculateTotAmount = Val(ToTamt)
End Function

.

[monarchmk]

@satti

This user is obvious example why is this thread written. I really try to help anyone but this one does not even want to stay online to check solution.
http://www.daniweb.com/forums/announcement8-2.html

[satti]

@Monarchmk u r right, i think we should leave him ...

[WaltP]

@Monarchmk u r right, i think we should leave him ...

Not only that, but giving free code away is frowned upon. If they can't post their code, how can they understand your code?