by Surendra Nath (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 6th April 2002
Date Added: Mon 8th February 2021
Rating: (1 Votes)
using MSFlexGrid Entering Data,editng data, removal of data
API Declarations
Dim rstX As New ADODB.Recordset
Dim rsttrans As New ADODB.Recordset
Dim rstValue As New ADODB.Recordset
Function DefaultFlexGrid()
FG1.Cols = 7
FG1.FixedCols = 1
FG1.ColWidth(0) = 350
FG1.ColWidth(1) = 500
FG1.ColWidth(2) = 2000
FG1.ColWidth(3) = 1200
FG1.ColWidth(4) = 1100
FG1.ColWidth(5) = 1750
FG1.ColWidth(6) = 1400
FG1.TextMatrix(0, 0) = ""
FG1.TextMatrix(0, 1) = "S.No"
FG1.TextMatrix(0, 2) = "Item"
FG1.TextMatrix(0, 3) = "SampleDate"
FG1.TextMatrix(0, 4) = "Prod.Date"
FG1.TextMatrix(0, 5) = "Reference"
FG1.TextMatrix(0, 6) = "Remarks"
End Function
Function EnterFreshRecord1()
i = i + 1
If i >= 18 Then
FG1.Rows = FG1.Rows + 1
End If
FG1.TextMatrix(i, 0) = ">>"
FG1.TextMatrix(i, 1) = (i)
FG1.TextMatrix(i, 2) = rstValue.Fields("Item") & ""
FG1.TextMatrix(i, 3) = Format(rstValue.Fields("SDate"), "dd-mmm-yyyy") & ""
FG1.TextMatrix(i, 4) = rstValue.Fields("PDate") & ""
FG1.TextMatrix(i, 5) = rstValue.Fields("Reference") & ""
FG1.TextMatrix(i, 6) = rstValue.Fields("Remarks") & ""
Exit Function
End Function
Private Sub fillformcontrols()
txtTNo.Text = ""
txtTNo.Text = rsttrans.Fields("TransactionNo") & ""
End Sub
Function EnterFreshRecord()
On Error GoTo ErrorHandler
i = i + 1
If i >= 18 Then
FG1.Rows = FG1.Rows + 1
End If
FG1.TextMatrix(i, 0) = ">>"
FG1.TextMatrix(i, 1) = (i)
FG1.TextMatrix(i, 2) = Trim(cboItem.Text)
FG1.TextMatrix(i, 3) = Trim(txtSDate)
FG1.TextMatrix(i, 4) = Trim(txtPDate)
FG1.TextMatrix(i, 5) = Trim(txtRef)
FG1.TextMatrix(i, 6) = Trim(txtRemarks)
Rearrange here is used to get the total amount and total qty immediately
sql = "insert into RawMaterial values(" & txtTNo & ",#" & Format(Date, "dd-mmm-yyyy") & "#," & FG1.TextMatrix(i, 1) & ",'" & FG1.TextMatrix(i, 2) & "',#" & FG1.TextMatrix(i, 3) & "#,'" & FG1.TextMatrix(i, 4) & "','" & FG1.TextMatrix(i, 5) & "','" & FG1.TextMatrix(i, 6) & "')"
con.Execute sql
If Err.Number = -2147217900 Then
'MsgBox "removeitem"
FG1.Rows = FG1.Rows + 1
FG1.RemoveItem (i)
i = i - 1
Rearrange
End If
ClearFormControl
Rearrange
cboItem.SetFocus
Exit Function
ErrorHandler:
If Err.Number = -2147217900 Then
Resume Next
End If
If Err.Number = -2147467259 Then 'duplicate values (primary key violation)
MsgBox "SerialNo Already Exits!" & vbCrLf & "Enter a Unique SerialNo"
FG1.Rows = FG1.Rows + 1
FG1.RemoveItem (i)
i = i - 1
'
Rearrange
cboItem.SetFocus
Exit Function
End If
MsgBox Err.Number & vbCrLf & Err.Description
End Function
Function RequiredLabel()
MDIMain.lblF2.Visible = True
MDIMain.lblF2.Caption = "F2 - Add"
MDIMain.lblF3.Visible = True
MDIMain.lblF3.Caption = "F3 - Edit"
MDIMain.lblF4.Visible = True
MDIMain.lblF4.Caption = "F4 - Remove"
MDIMain.lblF5.Visible = True
MDIMain.lblF5.Caption = "F5 - Save"
MDIMain.lblF6.Visible = True
MDIMain.lblF6.Caption = "F6 - Print"
MDIMain.lblf9.Visible = True
MDIMain.lblf9.Caption = "F9 - Exit"
End Function
Function ClearFormControl()
cboItem.Text = ""
txtPDate.Text = ""
txtRef.Text = ""
txtRemarks.Text = ""
End Function
Function Rearrange()
k = 1
While k < FG1.Rows
If FG1.TextMatrix(k, 2) <> "" Then
FG1.TextMatrix(k, 1) = k
If k > 7 Then
FG1.TopRow = k - 7
Else
FG1.TopRow = 1
End If
End If
k = k + 1
Wend
End Function
Function TransactionNumber()
Dim rstdno As New ADODB.Recordset
sql = "select max(TransactionNo) from RawMaterial"
rstdno.Open sql, con
If rstdno(0) <> "" Then
tno = rstdno(0) + 1
Else
tno = 1
End If
txtTNo.Text = tno
'sql = "insert into DNCustomer (DNoteNo) values(" & dnno & ")"
'dbclr.Execute sql
rstdno.Close
End Function
Function SaveTransaction()
On Error GoTo ErrorHandler
Dim s As Integer
For s = 1 To i
Sno = FG1.TextMatrix(s, 1)
Item = FG1.TextMatrix(s, 2)
sdate = FG1.TextMatrix(s, 3)
pdate = FG1.TextMatrix(s, 4)
ref = FG1.TextMatrix(s, 5)
remarks = FG1.TextMatrix(s, 6)
sql = "insert into RawMaterial values(" & txtTNo & ",#" & Format(Date, "dd-mmm-yyyy") & "#," & Sno & ",'" & Item & "',#" & sdate & "#,'" & pdate & "','" & ref & "','" & remarks & "')"
'MsgBox sql
con.Execute sql
Next
Exit Function
ErrorHandler:
If Err.Number = -2147217900 Then
Resume Next
End If
MsgBox Err.Number & vbCrLf & Err.Description
End Function
Function PrintTransaction()
CR1.ReportFileName = App.Path & "\rptRaw.rpt"
CR1.ReplaceSelectionFormula ("{RawMaterial.Transactionno}=" & txtTNo.Text & ";")
CR1.FetchSelectionFormula
CR1.RetrieveDataFiles
CR1.WindowState = crptMaximized
'CR1.ParameterFields(0) = "lblword;" & lblWords.Caption & ";true"
'CR1.ParameterFields(1) = "InvAddress;" & repCustAdd & ";true"
CR1.Action = 7
End Function
Private Sub cmdAdd_Click()
Dim rstmax As New ADODB.Recordset
rstmax.Open "select max(TransactionNo) from RawMaterial", con, 3
If rstmax(0) <> "" Then
txtTNo.Text = rstmax.Fields(0) + 1
Else
txtTNo.Text = 1
End If
rstmax.Close
cboItem.SetFocus
End Sub
Private Sub cmdFirst_Click()
FG1.Clear
DefaultFlexGrid
i = 0
rsttrans.MoveFirst
fillformcontrols
cboItem.SetFocus
End Sub
Private Sub cmdLast_Click()
FG1.Clear
DefaultFlexGrid
i = 0
rsttrans.MoveLast
fillformcontrols
cboItem.SetFocus
End Sub
Private Sub cmdNext_Click()
FG1.Clear
DefaultFlexGrid
i = 0
rsttrans.MoveNext
If rsttrans.EOF = True Then
rsttrans.MoveLast
End If
fillformcontrols
cboItem.SetFocus
End Sub
Private Sub cmdPrevious_Click()
FG1.Clear
DefaultFlexGrid
i = 0
rsttrans.MovePrevious
If rsttrans.BOF = True Then
rsttrans.MoveFirst
End If
fillformcontrols
cboItem.SetFocus
End Sub
Private Sub Form_Activate()
On Error GoTo ErrorHandler
DisableLabel
RequiredLabel
i = 0
FG1.Rows = 19
FG1.Clear
DefaultFlexGrid
txtSDate = Format(Date, "dd-mmm-yyyy")
DefaultFlexGrid
TransactionNumber
cboItem.SetFocus
rstX.Open "select * from RawMaterial", con, 3
rsttrans.Open "select distinct(TransactionNo) from RawMaterial order by TransactionNo", con, 3
'---=-=====
Dim rstCombo As New ADODB.Recordset
Dim rawName
rstCombo.Open "select RawItem from tblConfig where id=1", con, 3
If rstCombo.RecordCount > 0 Then
rawName = rstCombo.Fields("RawItem")
rawName1 = Split(rawName, ",")
If UBound(rawName1) > 0 Then
cboItem.Clear
For k = 0 To UBound(rawName1)
cboItem.AddItem (rawName1(k))
Next
Else
cboItem.Clear
cboItem.AddItem rawName
End If
End If
rstCombo.Close
Exit Sub
ErrorHandler:
If Err.Number = 3704 Or Err.Number = 3705 Then
Resume Next
End If
MsgBox Err.Number & vbCrLf & Err.Description
End Sub
Private Sub Form_Unload(Cancel As Integer)
DisableLabel
EnableLabel
End Sub
Private Sub smAdd_Click()
cmdAdd_Click
End Sub
Private Sub smEdit_Click()
frameRemove.Visible = False
frameEdit.Visible = True
txtEdit.Text = ""
txtEdit.SetFocus
End Sub
Private Sub smExit_Click()
Unload Me
End Sub
Private Sub smPrint_Click()
PrintTransaction
End Sub
Private Sub smRemove_Click()
frameEdit.Visible = False
frameRemove.Visible = True
txtRemove.Text = ""
txtRemove.SetFocus
End Sub
Private Sub smSave_Click()
SaveTransaction
End Sub
Private Sub cboItem_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
txtSDate.SetFocus
SendKeys "{end}"
End Select
End Sub
Private Sub txtEdit_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Val(txtEdit) > 0 And Val(txtEdit) <= i Then
frameEdit.Visible = False
cboItem.Text = FG1.TextMatrix(Val(txtEdit), 2)
txtSDate.Text = FG1.TextMatrix(Val(txtEdit), 3)
txtPDate.Text = FG1.TextMatrix(Val(txtEdit), 4)
txtRef.Text = FG1.TextMatrix(Val(txtEdit), 5)
txtRemarks.Text = FG1.TextMatrix(Val(txtEdit), 6)
cboItem.SetFocus
SendKeys "{END}"
FG1.RemoveItem (Val(txtEdit))
'deleting the deleted item from database
sql = "delete from RawMaterial where SNo=" & Trim(txtEdit.Text) & "and TransactionNo=" & Trim(txtTNo.Text)
'MsgBox sql
con.Execute sql
Dim newsno
iam updating here slno, since slno is changed upon removal of slno
For k = (Val(txtEdit) + 1) To i
sql1 = "select sno from RawMaterial where TransactionNo=" & txtTNo & "and sno =" & k
rstX.Close
rstX.Open sql1, con, 3
newsno = rstX(0)
newsno1 = newsno - 1
sql2 = "update RawMaterial set SNo=" & newsno1 & " where sno=" & newsno & "and TransactionNo=" & txtTNo
con.Execute sql2
Next k
i = i - 1
Rearrange
Else
txtEdit.Text = ""
End If
ElseIf KeyAscii = 27 Then
frameEdit.Visible = False
txtEdit.Text = ""
frmEntry.Refresh
cboItem.SetFocus
ElseIf KeyAscii > 46 And KeyAscii < 58 Then
KeyAscii = KeyAscii
ElseIf KeyAscii = 8 Then
KeyAscii = 8
Else
KeyAscii = 0
End If
End Sub
Private Sub txtPDate_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
txtRef.SetFocus
Case 8
If txtPDate.Text = "" Then
txtSDate.SetFocus
Else
Exit Sub
End If
End Select
End Sub
Private Sub txtRef_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
txtRemarks.SetFocus
Case 8
If txtRef.Text = "" Then
txtPDate.SetFocus
Else
Exit Sub
End If
End Select
End Sub
Private Sub txtRemarks_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
If Trim(cboItem.Text) = "" Then
MsgBox "Enter Item Details"
cboItem.SetFocus
Exit Sub
ElseIf Trim(txtSDate) = "" Then
MsgBox "Enter Sample Date"
txtSDate.SetFocus
ElseIf Not IsDate(txtSDate.Text) Then
MsgBox "Enter Valid SampleDate"
txtSDate.SetFocus
SendKeys "{end}"
Exit Sub
End If
EnterFreshRecord
SaveTransaction
cboItem.SetFocus
Case 8
If txtRemarks.Text = "" Then txtRef.SetFocus
End Select
End Sub
Private Sub txtRemove_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Val(txtRemove) > 0 And Val(txtRemove) <= i Then
frameRemove.Visible = False
cboItem.SetFocus
FG1.RemoveItem (Val(txtRemove))
'deleting the deleted item from database
sql = "delete from RawMaterial where SNo=" & Trim(txtRemove.Text) & "and TransactionNo=" & Trim(txtTNo.Text)
'MsgBox sql
con.Execute sql
Dim newsno
iam updating here slno, since slno is changed upon removal of slno
For k = (Val(txtRemove) + 1) To i
sql1 = "select sno from RawMaterial where TransactionNo=" & txtTNo & "and sno =" & k
rstX.Close
rstX.Open sql1, con, 3
newsno = rstX(0)
newsno1 = newsno - 1
sql2 = "update RawMaterial set SNo=" & newsno1 & " where sno=" & newsno & "and transactionno=" & txtTNo
con.Execute sql2
Next k
i = i - 1
Rearrange
Else
txtRemove.Text = ""
End If
ElseIf KeyAscii = 27 Then
frameRemove.Visible = False
txtRemove.Text = ""
frmEntry.Refresh
cboItem.SetFocus
ElseIf KeyAscii > 46 And KeyAscii < 58 Then
KeyAscii = KeyAscii
ElseIf KeyAscii = 8 Then
KeyAscii = 8
Else
KeyAscii = 0
End If
End Sub
Private Sub txtSDate_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 13
txtPDate.SetFocus
Case 8
If txtSDate.Text = "" Then
cboItem.SetFocus
Else
Exit Sub
End If
End Select
End Sub
Private Sub txtTNo_Change()
On Error GoTo ErrorHandler
FG1.Clear
i = 0
DefaultFlexGrid
If txtTNo.Text <> "" Then
sql = "select * from RawMaterial where TransactionNo = " & txtTNo.Text
rstValue.Open sql, con, 3
If rstValue.RecordCount > 0 Then
rstValue.MoveFirst
While Not rstValue.EOF
EnterFreshRecord1
rstValue.MoveNext
Wend
End If
rstValue.Close
End If
Exit Sub
ErrorHandler:
If Err.Number = 3704 Then
Resume Next
End If
MsgBox Err.Description
End Sub