Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
PROJECT SOURCE CODE
SPONSORED LINKS
Item Group
'******************************************************************
'******************************************************************
'** Author : Samee Ullah Siddiqui
'** Subject : Item Group Creation DialogBox
'** Date : Friday, August, 01, 2003
'** Modified : Saturday, August, 02, 2003
'******************************************************************
'******************************************************************
Dim ADDMode As Boolean
Dim EditMode As Boolean
Private Sub AddCmd_Click()
Dim ItemGroup, ItemGroupCode As String
Call SetControls(False)
ItemGroup = InputBox("Enter Item Group Name", "Item Group Entry", , Me.Left + Me.Width + 50, 1050)
If Trim(ItemGroup) = "" Then GoTo ExitLable
Dim IGRst As New ADODB.Recordset
IGRst.CursorLocation = adUseClient
Conn.BeginTrans
ItemGroupCode = GetNextCode()
IGRst.Open "ITEMGROUP", Conn, adOpenKeyset, adLockOptimistic, adCmdTable
With IGRst
.AddNew
!IGCode = ItemGroupCode
!IGDesc = StrConv(Trim(Left(ItemGroup, 50)), vbProperCase)
.Update
End With
Conn.CommitTrans
Call PopulateGroupList
GroupList.SetFocus
ExitLable:
Call SetControls(True)
End Sub
Private Sub ExitCmd_Click()
Unload Me
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Load()
Call PopulateGroupList
End Sub
Private Sub PopulateGroupList()
'To populating all groups in list
Dim SQL As String
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
SQL = "SELECT * FROM ITEMGROUP"
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
GroupList.View = lvwReport
GroupList.ColumnHeaders(1).Width = 5151.41 'Item Group
GroupList.ColumnHeaders(2).Width = 0 'Item Group Code
GroupList.ListItems.Clear
Do Until rst.EOF
With GroupList.ListItems.Add(, , rst!IGDesc)
.ListSubItems.Add , , rst!IGCode
End With
rst.MoveNext
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
End Sub
Private Sub GroupList_AfterLabelEdit(Cancel As Integer, NewString As String)
On Error GoTo ErrLbl
Dim ItemGroupCode, SQL As String
Dim Index As Integer
If GroupList.SelectedItem Is Nothing Then Exit Sub
Index = GroupList.SelectedItem.Index
If Index = "0001" Then MsgBox "You Can't Alter Or Change This Group", vbCritical + vbDefaultButton1, App.Title: Cancel = True: GoTo EndLabel
If Trim(NewString) = "" Then
Cancel = True
MsgBox "Item Group Name cannot be blank.", vbCritical, "Editing aborted"
GoTo EndLabel
End If
Dim IGRst As New ADODB.Recordset
IGRst.CursorLocation = adUseClient
Conn.BeginTrans
ItemGroupCode = GroupList.SelectedItem.SubItems(1)
SQL = "SELECT * FROM ITEMGROUP WHERE IGCODE = '" & ItemGroupCode & "'"
IGRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
With IGRst
!IGDesc = StrConv(Trim(Left(NewString, 50)), vbProperCase)
.Update
End With
Conn.CommitTrans
Call PopulateGroupList
GroupList.ListItems(Index).Selected = True
EndLabel:
GroupList.SetFocus
Call SetControls(True)
Exit Sub
ErrLbl:
ErrHandler "IGFrm.AfterLableEdit"
End Sub
Private Sub GroupList_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
With GroupList
.SortKey = ColumnHeader.Index - 1
.SortOrder = IIf(.SortOrder = lvwAscending, lvwDescending, lvwAscending)
.Sorted = True
End With
End Sub
Private Sub GroupList_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF2 Then
GroupList.StartLabelEdit
ElseIf KeyCode = vbKeyDelete Then
If GroupList.SelectedItem.Index = "0001" Then MsgBox "You Can't Alter Or Change This Group", vbCritical + vbDefaultButton1, App.Title: Exit Sub
If MsgBox("This will delete selected item [" & GroupList.SelectedItem.Text & "] from the list. Are you sure to do this.", vbQuestion + vbYesNo + vbDefaultButton2, "Deletion Confirmation") = vbNo Then Exit Sub
Dim rst As New ADODB.Recordset
rst.CursorLocation = adUseClient
Dim SQL As String
SQL = "SELECT COUNT(*) FROM ITEM WHERE IGCODE = '" & GroupList.SelectedItem.SubItems(1) & "'"
rst.Open SQL, Conn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rst(0) > 0 Then
SQL = "DELETE FROM ITEMGROUP WHERE IGCODE = '" & GroupList.SelectedItem.SubItems(1) & "'"
Conn.BeginTrans
Conn.Execute SQL, , adCmdText
Conn.CommitTrans
Call PopulateGroupList
GroupList.SetFocus
Else
MsgBox "The Item Group you are trying to delete, could not be successful because Item of this group is available.", vbCritical, "Deletion aborted"
GroupList.SetFocus
End If
End If
End Sub
Private Sub SetControls(ByVal Status As Boolean)
AddCmd.Enabled = Status
ExitCmd.Enabled = Status
End Sub
Private Function GetNextCode() As String
Dim RS As New ADODB.Recordset
RS.Open "Select Max(IGCODE) From ITEMGROUP", Conn, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then GetNextCode = GetProperCode(IIf(IsNull(RS(0)), "1", Mid(RS(0), 2) + 1), 4) Else GetNextCode = GetProperCode("1", 4)
End Function
Sponsored Links