frmsales.frm

this code helps u to understand the basic thing to connect visual basic with sqlserver. this ll be v

      Width           =   1215
   End
   Begin VB.Label lblInvoice 
      Height          =   255
      Left            =   1800
      TabIndex        =   1
      Top             =   240
      Width           =   1575
   End
   Begin VB.Label Label1 
      Caption         =   "Invoice number:"
      Height          =   255
      Left            =   360
      TabIndex        =   0
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "frmSales"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim total As Double
Dim fStr As String

Private Sub cmdCancel_Click()
empty_obj
lvwList.ListItems.Clear
disabled_obj
ctr = ctr - 1
If lvwList.ListItems.Count = 0 Then
    cmdEdit.Enabled = False
End If
cmdOk.Visible = True
End Sub

Private Sub cmdEdit_Click()
If lvwList.ListItems.Count = 0 Then
    MsgBox "No current record!", vbCritical, "User Info"
Else
    cInvent = Trim(lblInvoice.Caption)
    BEdt = True
    enabled_obj
    cmdFind.Enabled = False
    DTPicker1.Enabled = False
    cmdSave.Caption = "&Update"
    cmdSave.Enabled = True
    cmdOk.Visible = False
End If
End Sub

Private Sub cmdExit_Click()
If MsgBox("Close this window?", vbInformation + vbYesNo, "User Info") = vbYes Then
    Unload Me
    frmMenu.Show
End If
End Sub

Private Sub cmdFind_Click()
info = "bbb"
frmSearch.Show 1, Me
End Sub

Private Sub cmdFindR_Click()
info = "ccc"
frmSearch.Show 1, Me
End Sub

Private Sub cmdTransfer_Click()
' transfer of selected items which are to be edited by the user
If cmdTransfer.Caption = "<" Then
    With lvwList
        ' transfer
        fStr = .SelectedItem.SubItems(2)
        lblPcode.Caption = fStr
        lblInvoice.Caption = .SelectedItem
        DTPicker1.Value = .SelectedItem.SubItems(1)
        txtQuant.Text = .SelectedItem.SubItems(3)
        txtUnitP.Text = .SelectedItem.SubItems(4)
        txtTotal.Text = .SelectedItem.SubItems(5)
        '''''''''''''''' transfer of the decription, brand and unit of the
        '''''''''''''''' product to frmSales
        Call open_conn
        Set rs = cn.Execute("Select * from tblproduct where pcode='" + Trim(lblPcode.Caption) + "'")
        If Not rs.EOF Then
            txtDescrr.Text = rs!descrr
            txtBrand.Text = rs!brand
            txtUnit.Text = rs!unit
        End If
        Call close_conn
        '''''''''''''''' end transfer '''''''''''''''''''''''''''''''''''''
        n1 = 1
        Do While n1 <= .ListItems.Count
            If .ListItems(n1).SubItems(2) = fStr Then .ListItems.Remove (n1)
            n1 = n1 + 1
        Loop
    End With
    cmdTransfer.Caption = ">"
Else
    Set itmx = lvwList.ListItems.Add(, , lblInvoice.Caption)
        itmx.SubItems(1) = DTPicker1.Value
        itmx.SubItems(2) = lblPcode.Caption
        itmx.SubItems(3) = txtQuant.Text
        itmx.SubItems(4) = txtUnitP.Text
        itmx.SubItems(5) = txtTotal.Text
    cmdTransfer.Caption = "<"
    empty_obj
    n1 = 1
    Do While n1 <= lvwList.ListItems.Count
        total = total + Val(Trim(lvwList.ListItems(n1).SubItems(5)))
        txtGrand.Text = Format(total, "##,##0.00")
        n1 = n1 + 1
    Loop
End If
End Sub

Private Sub cmdNew_Click()
Call open_conn
'''''''''''''''validation if tblproduct is empty'''''''''''''
Set rs = cn.Execute("select * from tblproduct")
If rs.EOF Then
    MsgBox "No current record on Product Database!", vbCritical + vbInformation, "User Info"
    Exit Sub
End If
Call close_conn
''''''''''''''end of validation'''''''''''''''''''''''''''''''
empty_obj
lvwList.ListItems.Clear
enabled_obj
cmdOk.Visible = True
cmdTransfer.Visible = False
Call open_conn
Set rs = cn.Execute("select * from tblsales")
If Not rs.EOF Then                  ' autonumbering to avoid invoice redundancy
    rs.MoveFirst                    ' getting first the highest invoice value in the database
    Do While Not rs.EOF             ' then, add 1 and display the amt to the lblInvoce
        If rs!invoice > ctr Then
            ctr = rs!invoice
        End If
        rs.MoveNext
    Loop
End If
Call close_conn
ctr = ctr + 1
cmdFind.SetFocus
lblInvoice.Caption = ctr
End Sub



Private Sub cmdOk_Click()
''''''''''validation starts here''''''''''''''''''''
If lblPcode.Caption = "" Then
    MsgBox "No product selected! Select a product first!", vbInformation, "User Info"
    cmdFind.SetFocus
    Exit Sub
End If
If txtQuant.Text = "" Then
    MsgBox "Enter Quantity!", vbInformation, "User Info"
    txtQuant.SetFocus
    Exit Sub
End If
If txtUnitP.Text = "" Then
    MsgBox "Enter Unit Price!", vbInformation, "User Info"
    txtUnitP.SetFocus
    Exit Sub
End If
''''''''''''validation ends here'''''''''''''''''''

''''''''''''transfering of datas to list view''''''''''''''''''''''''
If MsgBox("Add Another?", vbYesNo, "User Info") = vbYes Then
'''''''''''''''''verify first if all records on product is already been used'''''''''
n1 = 1
test = 0
Call open_conn
Set rs = cn.Execute("select * from tblproduct")
If Not rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF ' get the total number of the items in database
    cInvent = rs!pcode
    test = test + 1
    lbltest.Caption = test
    rs.MoveNext
Loop
n1 = lvwList.ListItems.Count
If n1 = test - 1 Then
    MsgBox "All records on the product are in use!", vbInformation, "User Info"
    Exit Sub
End If
End If
Call close_conn
''''''''''''''''''end verification''''''''''''''''''''''''''
    Set itmx = lvwList.ListItems.Add(, , lblInvoice.Caption) ' transfer of items to listview
        itmx.SubItems(1) = DTPicker1.Value
        itmx.SubItems(2) = lblPcode.Caption
        itmx.SubItems(3) = txtQuant.Text
        itmx.SubItems(4) = Format(txtUnitP.Text, "## ##0.00")
        itmx.SubItems(5) = txtTotal.Text
    grand = grand + Val(txtTotal.Text)
    lblPcode.Caption = ""
    txtDescrr.Text = ""
    txtBrand.Text = ""
    txtUnit.Text = ""
    txtQuant.Text = ""
    txtUnitP.Text = ""
    txtTotal.Text = ""
    cmdFind.SetFocus
Else
    Set itmx = lvwList.ListItems.Add(, , lblInvoice.Caption)
        itmx.SubItems(1) = DTPicker1.Value
        itmx.SubItems(2) = lblPcode.Caption
        itmx.SubItems(3) = txtQuant.Text
        itmx.SubItems(4) = Format(txtUnitP.Text, "## ##0.00")
        itmx.SubItems(5) = txtTotal.Text
    grand = grand + Val(Trim(txtTotal.Text))
    DTPicker1.Enabled = False
    cmdOk.Enabled = False
    cmdSave.Enabled = True
    cmdFind.Enabled = False
    txtQuant.Enabled = False
    txtUnitP.Enabled = False
    txtTotal.Enabled = False
End If
txtGrand.Text = Format(grand, "##,##0.00")
End Sub

Private Sub cmdSave_Click()
Call open_conn
If BEdt = False Then
    ' saving items in the listview
    n1 = 1
    Do While n1 <= lvwList.ListItems.Count
        lvwList.ListItems(n1).Selected = True
        'vdte = Format(vdate, "dddd - mmmm d, yyyy")
        'vdate = Trim(lvwList.SelectedItem.SubItems(1))
        cn.Execute "insert into tblsales values('" + lvwList.SelectedItem + "','" + Trim(lvwList.SelectedItem.SubItems(1)) + "','" _
        + lvwList.SelectedItem.SubItems(2) + "','" + lvwList.SelectedItem.SubItems(3) + "','" _
        + lvwList.SelectedItem.SubItems(4) + "','" + lvwList.SelectedItem.SubItems(5) + "')"
        n1 = n1 + 1
    Loop
    MsgBox "Record Saved!", vbInformation, "User Info"
    ctr = Val(lblInvoice.Caption)
    disabled_obj
    empty_obj
Else
    ' updating the whole invoice using the delete - insert method
    Call open_conn
        cn.Execute "Delete * from tblsales where invoice='" + Trim(lvwList.ListItems(1)) + "'"
    Call close_conn
    BEdt = False
    cmdSave_Click
    cmdSave.Caption = "&Save"
End If
Call close_conn
End Sub

Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
vdate = DTPicker1.Value
End Sub

Private Sub Form_Load()
ctr = 0
'DTPicker1.Value = Date
'move_record
If lvwList.ListItems.Count = 0 Then
    cmdEdit.Enabled = False
End If
End Sub



Private Sub lvwList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
n1 = ColumnHeader.Index
If n1 <> 2 Then
    Call SortNum(lvwList, ColumnHeader) ' call the sorting function in the module
End If
End Sub

Private Sub txtQuant_Change()
txtUnitP_Change
End Sub

Private Sub txtQuant_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Not IsNumeric(txtQuant.Text) Then
    txtQuant.Text = ""
    txtQuant.SetFocus
    Exit Sub
End If
    txtUnitP.SetFocus
End If
End Sub

Private Sub txtUnitP_Change()
total = Val(txtQuant.Text) * Val(txtUnitP.Text)
txtTotal.Text = Format(total, "## ##0.00")
End Sub

Private Sub txtUnitP_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Not IsNumeric(txtUnitP.Text) Then
    txtUnitP.Text = ""
    txtUnitP.SetFocus
    Exit Sub
End If
    txtUnitP_Change
    If BEdt = False Then cmdOk_Click Else cmdTransfer_Click
End If
End Sub

Public Sub enabled_obj()
lvwList.Enabled = True
lvwList.BackColor = &H80C0FF
cmdNew.Enabled = False
cmdEdit.Enabled = False
DTPicker1.Enabled = True
cmdCancel.Enabled = True
cmdExit.Enabled = False
cmdFind.Enabled = True
cmdFindR.Enabled = False
cmdOk.Enabled = True
cmdTransfer.Visible = True
txtQuant.Enabled = True
txtUnitP.Enabled = True
txtTotal.Enabled = True
End Sub

Public Sub disabled_obj()
lvwList.Enabled = False
lvwList.BackColor = &HE0E0E0
cmdNew.Enabled = True
cmdEdit.Enabled = True
DTPicker1.Enabled = False
cmdSave.Enabled = False
cmdOk.Enabled = False
cmdCancel.Enabled = False
cmdExit.Enabled = True
cmdFind.Enabled = False
cmdFindR.Enabled = True
cmdTransfer.Visible = False
txtQuant.Enabled = False
txtUnitP.Enabled = False
txtTotal.Enabled = False
End Sub

Public Sub empty_obj()
lblInvoice.Caption = ""
DTPicker1.Value = Date
lblPcode.Caption = ""
txtDescrr.Text = ""
txtBrand.Text = ""
txtUnit.Text = ""
txtQuant.Text = ""
txtUnitP.Text = ""
txtTotal.Text = ""
txtGrand.Text = ""
End Sub

Public Sub move_record()
Call open_conn
Set rs = cn.Execute("select * from tblsales")
If Not rs.EOF Then
    rs.MoveFirst
    lblInvoice.Caption = rs!invoice
    DTPicker1.Value = rs!dates
    lblPcode.Caption = rs!pcode
    txtQuant.Text = rs!quant
    txtUnitP.Text = rs!unitp
    txtTotal.Text = rs!total
    lvwList.ListItems.Clear
    Do While Not rs.EOF
    Set itmx = lvwList.ListItems.Add(, , rs!invoice)
        itmx.SubItems(1) = rs!dates
        itmx.SubItems(2) = rs!pcode
        itmx.SubItems(3) = rs!quant
        itmx.SubItems(4) = rs!unitp
        itmx.SubItems(5) = rs!total
        rs.MoveNext
    Loop
Else
    lvwList.ListItems.Clear
End If
Call close_conn
Call open_conn
Set rs = cn.Execute("select * from tblproduct where pcode='" + Trim(lblPcode.Caption) + "'")
If Not rs.EOF Then
    txtDescrr.Text = rs!descrr
    txtBrand.Text = rs!brand
    txtUnit.Text = rs!unit
End If
Call close_conn
End Sub