Next Chapter 42 Item Master
PROJECT SOURCE CODE
SPONSORED LINKS
Item Master
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Save and Manipulate Item Details
'** Date : Monday, August, 04, 2003
'** Modified : Tuesday, August, 05, 2003
'******************************************************************
'******************************************************************
Dim ADDMode As Boolean
Dim EditMode As Boolean
Dim EmptyTable As Boolean
Dim Conn As ADODB.Connection
Private Sub AddCmd_Click()
On Error GoTo ErHand
ADDMode = True
Call SetControls
Call ClearFields
Conn.BeginTrans
ErHand:
ErrHandler "ItemFrm.AddCmd_Click()"
End Sub
Private Sub CancelCmd_Click()
On Error GoTo ErHand
ADDMode = False
EditMode = False
Call SetControls
Conn.RollbackTrans
ErHand:
ErrHandler "ItemFrm.CancelCmd_Click()"
End Sub
Private Sub ColorTxt_GotFocus()
ClrSrch.SearchValue ColorTxt
End Sub
Private Sub DelCmd_Click()
Dim Cancelled As Boolean
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
If ItemNameTxt.Tag = "" Then MsgBox "Please select item from list to delete.", vbCritical, "Item not selected": Exit Sub
SQL = "SELECT * FROM LEDGER WHERE ICODE = '" & ItemNameTxt.Tag & "'"
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If rst.RecordCount > 0 Then
MsgBox "Selected item [" & ItemNameTxt & "] could not be deleted because the transaction of this item is available.", vbCritical, "Deletion Aborted"
Cancelled = True
GoTo ExitLable 'Skip Deletion part
End If
If MsgBox("This will delete the selected item [" & ItemNameTxt & "]. Are you sure to delete it ?", vbQuestion + vbYesNo + vbDefaultButton2, "Deletion Confirmation") = vbNo Then Cancelled = True: GoTo ExitLable
'Delete Item
SQL = "DELETE FROM ITEM WHERE ITEMCODE = '" & ItemNameTxt.Tag & "'"
Conn.Execute SQL, , adCmdText
Conn.CommitTrans
ItemSrch.PopulateList
ItemDBCtl.Recordset.Requery
ExitLable:
If Cancelled Then Conn.RollbackTrans
If Not (ItemDBCtl.Recordset.RecordCount > 0) Then EmptyTable = True
ADDMode = False
EditMode = False
Call SetControls
Call SetFieldsValues(ItemDBCtl.Recordset)
End Sub
Private Sub EditCmd_Click()
EditMode = True
Call SetControls
Conn.BeginTrans
End Sub
Private Sub ExitCmd_Click()
Unload Me
End Sub
Private Sub SetGrid(Optional vItemCode As String)
'Connect to Database and populate data in the grid and
'Set the curentrecord as to supplied ItemCode
'Called in Form_Load(), SaveCmd_Click()
Dim Dformat As New StdDataFormat
Dformat.Format = "0.00#"
ItemDBCtl.ConnectionString = ConnectString
ItemDBCtl.RecordSource = "ItemDetails"
ItemDBCtl.Refresh
If Not (ItemDBCtl.Recordset.RecordCount > 0) Then EmptyTable = True
If Not Trim(vItemCode) = "" Then
ItemDBCtl.Recordset.MoveFirst
ItemDBCtl.Recordset.Find "ItemCode = '" & Trim(vItemCode) & "'"
End If
Set ItemGrid.DataSource = ItemDBCtl
ItemGrid.Refresh
ItemGrid.Columns("Purchase Rate").Alignment = dbgRight
ItemGrid.Columns("Sale Rate").Alignment = dbgRight
ItemGrid.Columns("Re Order Level").Alignment = dbgRight
ItemGrid.Columns("Over Flow Level").Alignment = dbgRight
ItemGrid.Columns("ItemCode").Width = 0
ItemGrid.Columns("IGCode").Width = 0
ItemGrid.Columns("ManufCode").Width = 0
ItemGrid.Columns("Item Name").Width = TextWidth("A") * 20
ItemGrid.Columns("Group").Width = TextWidth("A") * 11
ItemGrid.Columns("Manufacturer").Width = TextWidth("A") * 12
ItemGrid.Columns("Purchase Rate").Width = TextWidth("A") * 12
ItemGrid.Columns("Sale Rate").Width = TextWidth("A") * 12
ItemGrid.Columns("Re Order Level").Width = TextWidth("A") * 10
ItemGrid.Columns("Over Flow Level").Width = TextWidth("A") * 10
ItemGrid.Columns("Packing").Width = TextWidth("A") * 10
ItemGrid.Columns("Description").Width = TextWidth("A") * 50
Set ItemGrid.Columns("Re Order Level").DataFormat = Dformat
Set ItemGrid.Columns("Over Flow Level").DataFormat = Dformat
Set ItemGrid.Columns("Packing").DataFormat = Dformat
Set ItemGrid.Columns("Purchase Rate").DataFormat = Dformat
Set ItemGrid.Columns("Sale Rate").DataFormat = Dformat
End Sub
Private Sub SetSearchEngines()
'Populate all search list
'Called in Form_Load()
With ItemSrch
.DBConnectString = ConnectString
.SQLString = "SELECT ItemCode, Item_Desc FROM ITEM"
.PopulateList
End With
With IGSrch
.DBConnectString = ConnectString
.SQLString = "SELECT IGCODE, IGDesc FROM ITEMGROUP"
.PopulateList
Set .BoundTextBox = ItemGroupTxt
End With
With MnufSrch
.DBConnectString = ConnectString
.SQLString = "SELECT ManufCode, Manuf_Desc FROM MANUFACTURER"
.PopulateList
Set .BoundTextBox = MnfTxt
End With
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = vbCtrlMask And KeyCode = vbKeyLeft Then
If PrevCmd.Enabled Then PrevCmd.SetFocus
Call PrevCmd_Click
ElseIf Shift = vbCtrlMask And KeyCode = vbKeyRight Then
If NextCmd.Enabled Then NextCmd.SetFocus
Call NextCmd_Click
ElseIf Shift = vbCtrlMask And KeyCode = vbKeyHome Then
If TopCmd.Enabled Then TopCmd.SetFocus
Call TopCmd_Click
ElseIf Shift = vbCtrlMask And KeyCode = vbKeyEnd Then
If LastCmd.Enabled Then LastCmd.SetFocus
Call LastCmd_Click
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If (KeyAscii <> vbKeyReturn Or (ActiveControl.Name = "ItemNameTxt" And Not ItemSrch.BoundTextBox Is Nothing)) Then Exit Sub
If Not (ActiveControl.Name = "ItemGroupTxt") Or _
ActiveControl.Name = "MnfTxt" Or _
ActiveControl.Name = "PackingTxt" Or _
ActiveControl.Name = "PharmasistTxt" Or _
ActiveControl.Name = "ReOrderLevelTxt" Or _
ActiveControl.Name = "PRateTxt" Or _
ActiveControl.Name = "SRateTxt" Or _
ActiveControl.Name = "OverFlowTxt" Or _
ActiveControl.Name = "RemarkTxt" _
Then SendKeys "{TAB}"
End Sub
Private Sub Form_Load()
Set Conn = New ADODB.Connection
Conn.CursorLocation = adUseClient
Conn.Open ConnectString
Call SetGrid
Call SetControls
Call SetSearchEngines
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
If (ADDMode Or EditMode) Then
Cancel = True
Exit Sub
End If
Conn.Close
Set Conn = Nothing
End Sub
Private Sub OverFlowTxt_KeyPress(KeyAscii As Integer)
ValidateNumber KeyAscii
End Sub
Private Sub OverFlowTxt_Validate(Cancel As Boolean)
ValidateDesimal OverFlowTxt, Cancel, 0
End Sub
Private Sub PackingTxt_KeyPress(KeyAscii As Integer)
ValidateNumber KeyAscii
End Sub
Private Sub ReOrderLevelTxt_KeyPress(KeyAscii As Integer)
ValidateNumber KeyAscii
End Sub
Private Sub ReOrderLevelTxt_Validate(Cancel As Boolean)
ValidateDesimal ReOrderLevelTxt, Cancel, 0
End Sub
'Private Sub HellTxt_Validate(Cancel As Boolean)
' If ADDMode Then HellTxt = StrConv(HellTxt, vbProperCase)
'End Sub
Private Sub SetFieldsValues(ByVal rst As ADODB.Recordset)
'Set database values in the forms fields
'Called in ItemDBCtl_MoveComplete()
On Error GoTo ErHand
If Not (rst.RecordCount > 0) Then Call ClearFields: Exit Sub
If rst.EOF Then rst.MoveLast
If rst.BOF Then rst.MoveFirst
Dim NumFormat As String
NumFormat = "0.00#"
With Me
.ItemNameTxt = rst("Item Name")
.ItemNameTxt.Tag = rst("ItemCode")
.ItemGroupTxt = rst("Group")
.ItemGroupTxt.Tag = rst("IGCode")
.PharmasistTxt = rst("Pharmasist Name") & ""
.MnfTxt = rst("Manufacturer")
.MnfTxt.Tag = rst("ManufCode")
.PackingTxt = rst("Packing")
.ReOrderLevelTxt = rst("Re Order Level")
.OverFlowTxt = rst("Over Flow Level")
.PRateTxt = Format(rst("Purchase Rate"), NumFormat)
.SRateTxt = Format(rst("Sale Rate"), NumFormat)
End With
ErHand:
ErrHandler "ItemName_Click()"
End Sub
Private Sub ClearFields()
'To Clear forms fields
'Called in AddCmd_Click()
With Me
.ItemNameTxt = ""
.ItemNameTxt.Tag = ""
.ItemGroupTxt = ""
.ItemGroupTxt.Tag = ""
.MnfTxt = ""
.MnfTxt.Tag = ""
.PharmasistTxt = ""
.PackingTxt = ""
.ReOrderLevelTxt = ""
.OverFlowTxt = ""
.PRateTxt = ""
.SRateTxt = ""
End With
End Sub
'Private Sub ItemDBCtl_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
' 'If (ADDMode Or EditMode) Then Exit Sub
' ' Call SetFieldsValues(pRecordset)
' ' Call SetControls
'End Sub
Private Sub ItemGroupTxt_GotFocus()
IGSrch.SearchValue ItemGroupTxt
End Sub
Private Sub ItemNameTxt_GotFocus()
If Not EditMode Then Exit Sub
ItemSrch.SearchValue ItemNameTxt
End Sub
Private Sub ItemNameTxt_Validate(Cancel As Boolean)
If ADDMode Then ItemNameTxt = StrConv(ItemNameTxt, vbProperCase)
End Sub
Private Sub ItemSrch_ValidateBoundTextBox()
If Not (ADDMode Or EditMode) Then Exit Sub
If Not Trim(ItemNameTxt.Tag) = "" Then
ItemDBCtl.Recordset.MoveFirst
ItemDBCtl.Recordset.Find "ItemCode = '" & Trim(ItemNameTxt.Tag) & "'"
If ItemDBCtl.Recordset.EOF Then
MsgBox "Item details not found.", vbCritical, "Invalid Item"
Exit Sub
End If
Call SetFieldsValues(ItemDBCtl.Recordset)
End If
Set ItemSrch.BoundTextBox = Nothing
ItemSrch.HideList
End Sub
Private Sub LastCmd_Click()
LastMove ItemDBCtl.Recordset
End Sub
Private Sub MnfTxt_GotFocus()
MnufSrch.SearchValue MnfTxt.Text
End Sub
Private Sub NextCmd_Click()
NextMove ItemDBCtl.Recordset
End Sub
Private Sub PRateTxt_KeyPress(KeyAscii As Integer)
ValidateNumber KeyAscii
End Sub
Private Sub PRateTxt_Validate(Cancel As Boolean)
ValidateDesimal PRateTxt.Text, Cancel, 2
End Sub
Private Sub PrevCmd_Click()
TopMove ItemDBCtl.Recordset
End Sub
Private Sub SaveCmd_Click()
If Not SavedData Then Exit Sub
Conn.CommitTrans
Call SetGrid(ItemNameTxt.Tag)
ItemSrch.PopulateList
If ADDMode Then EmptyTable = False
ADDMode = False
EditMode = False
Call SetControls
End Sub
Private Sub SRateTxt_KeyPress(KeyAscii As Integer)
ValidateNumber KeyAscii
End Sub
Private Sub SRateTxt_Validate(Cancel As Boolean)
ValidateDesimal SRateTxt, Cancel, 2
End Sub
Private Sub TopCmd_Click()
TopMove ItemDBCtl.Recordset
End Sub
Private Sub SetControls()
'Set Forms Control's status
'Called in ItemDBCtl_MoveComplete(), Form_Load(), Navigation Buttons Click()
ItemFrame.Enabled = (ADDMode Or EditMode)
ItemGrid.Enabled = Not (ADDMode Or EditMode)
AddCmd.Enabled = Not (ADDMode Or EditMode)
EditCmd.Enabled = Not (EmptyTable Or ADDMode Or EditMode)
SaveCmd.Enabled = (ADDMode Or EditMode)
CancelCmd.Enabled = (ADDMode Or EditMode)
CancelCmd.Cancel = (ADDMode Or EditMode)
DelCmd.Enabled = (Not EmptyTable) And (ADDMode Or EditMode)
ExitCmd.Enabled = Not (ADDMode Or EditMode)
ExitCmd.Cancel = Not (ADDMode Or EditMode)
TopCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (ItemDBCtl.Recordset.AbsolutePosition > 1)
PrevCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (ItemDBCtl.Recordset.AbsolutePosition > 1)
NextCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (ItemDBCtl.Recordset.AbsolutePosition < ItemDBCtl.Recordset.RecordCount)
LastCmd.Enabled = (Not (EmptyTable Or ADDMode Or EditMode)) And (ItemDBCtl.Recordset.AbsolutePosition < ItemDBCtl.Recordset.RecordCount)
RecLbl.Caption = "Record(s): " & ItemDBCtl.Recordset.AbsolutePosition & "/" & ItemDBCtl.Recordset.RecordCount
Set ItemSrch.BoundTextBox = IIf(EditMode, ItemNameTxt, Nothing)
If Not (ADDMode Or EditMode) Then IGSrch.HideList
If Not (ADDMode Or EditMode) Then ISGSrch.HideList
If Not (ADDMode Or EditMode) Then MnufSrch.HideList
If Not (ADDMode Or EditMode) Then ClrSrch.HideList
If Not (ADDMode Or EditMode) Then SizeRollSrch.HideList
If Not (ADDMode Or EditMode) Then ItemSrch.HideList
End Sub
Private Function ValidateData() As Boolean
With Me
If Trim(.ItemNameTxt) = "" Then
MsgBox "Please enter item name.", vbCritical, "Missing values"
.ItemNameTxt.SetFocus
ElseIf EditMode And Trim(.ItemNameTxt.Tag) = "" Then
MsgBox "Please select item name to edit.", vbCritical, "Missing values"
.ItemNameTxt.SetFocus
ElseIf Trim(.ItemGroupTxt) = "" Or Trim(.ItemGroupTxt.Tag) = "" Then
MsgBox "Please select Item Group.", vbCritical, "Missing values"
.ItemGroupTxt.SetFocus
ElseIf Trim(.PackingTxt) = "" And Trim(.ItemGroupTxt = "Medicine") Then
MsgBox "Please Fill Medicine Packing .", vbCritical, "Missing values"
.PackingTxt.SetFocus
ElseIf Trim(.MnfTxt) = "" Or Trim(.MnfTxt.Tag) = "" Then
MsgBox "Please select Manufacturer.", vbCritical, "Missing values"
.MnfTxt.SetFocus
ElseIf Trim(.ReOrderLevelTxt) = "" Then
.ReOrderLevelTxt = 0
ElseIf Trim(.OverFlowTxt) = "" Then
.OverFlowTxt = 0
ElseIf Trim(.PRateTxt) = "" Then
MsgBox "Please enter the purchase rate of item.", vbCritical, "Missing values"
.PRateTxt.SetFocus
ElseIf Trim(.SRateTxt) = "" Then
MsgBox "Please enter the sale rate of item.", vbCritical, "Missing values"
.SRateTxt.SetFocus
Else
ValidateData = True
End If
End With
End Function
Private Function GetItemCode()
Dim RS As New ADODB.Recordset
RS.Open "Select Max(ITEMCODE) From ITEM", Conn, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then GetItemCode = GetProperCode(IIf(IsNull(RS(0)), "1", Mid(RS(0), 2) + 1), 5) Else GetItemCode = GetProperCode("1", 5)
End Function
Private Function SavedData() As Boolean
On Error GoTo ErrLbl
If Not ValidateData Then Exit Function
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
If ADDMode Then
SQL = "SELECT * FROM ITEM"
Else
SQL = "SELECT * FROM ITEM WHERE ITEMCODE = '" & ItemNameTxt.Tag & "'"
End If
rst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
With Me
If ADDMode Then
rst.AddNew
ItemNameTxt.Tag = GetItemCode()
rst("ItemCode") = ItemNameTxt.Tag
End If
rst("Item_Desc") = Trim(.ItemNameTxt)
rst("IGCode") = .ItemGroupTxt.Tag
rst("ManufCode") = .MnfTxt.Tag
rst("Packing") = IIf(.PackingTxt = "", Null, .PackingTxt)
rst("PharmasistName") = IIf(.PharmasistTxt = "", Null, .PharmasistTxt)
rst("ReOrderLevel") = Val(.ReOrderLevelTxt)
rst("OverFlowLevel") = Val(.OverFlowTxt)
rst("Purch_Rate") = Val(.PRateTxt)
rst("Sale_Rate") = Val(.SRateTxt)
rst("Remark") = IIf(.RemarkTxt = "", Null, .RemarkTxt)
rst.Update
End With
SavedData = True
Exit Function
ErrLbl:
ErrHandler "Function ItemFrm.SavedData"
End Function
Sponsored Links