by Gurjeet Singh Issar (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 5th May 2005
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This is the code which u can not get from books easily. This code provides u understanding of Flex Grid Control and How to use it.
API Declarations
Dim Mode As String 'Stores the current operation "add" or "edit"
Dim CON As Connection 'A Connection variable
Dim RS As Recordset 'A RecordSet variable
VBcoders
Private Sub CmdAddIns_Click()
On Error GoTo ErrHandler
Mode = "add"
MSFlexGrid1.Clear 'Clearing the data in the FlexGrid
MSFlexGrid1.FormatString = "ID |Name "
MSFlexGrid1.Rows = 2 'One FixedRow + One Empty Row
MSFlexGrid1.SetFocus
Exit Sub
ErrHandler:
MsgBox "An Error has Occured In The FlexChk() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example"
End Sub
Private Sub CmdSaveUpdate_Click()
On Error GoTo ErrHandler
Select Case Mode
Case "add"
If FlexUpdate(MSFlexGrid1, RS) = True Then
MsgBox "Record Saved Successfully", vbCritical, "FlexGrid Sample"
End If
Case "edit"
If FlexChk(MSFlexGrid1) = True Then
'If Flex Grid is not empty then deleting current records and
'updating the new records. However the FlexUpdate() Procedure
'will check for empty cells, we need to call FlexChk(), because
'we are going to delete the current records
CON.Execute "Delete from Student"
If FlexUpdate(MSFlexGrid1, RS) = True Then
MsgBox "Record Modified Successfully", vbCritical, "FlexGrid Sample"
End If
Else
MsgBox "Fill All Boxes", vbCritical, "FlexGrid Sample"
End If
End Select
Call Form_Load
Exit Sub
ErrHandler:
MsgBox "An Error has Occured In The CmdSaveUpdate_Click() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example"
End Sub
Private Sub CmdCancel_Click()
Call Form_Load 'canceling "add" or "edit" operation
End Sub
Private Sub CmdEditMod_Click()
On Error GoTo ErrHandler
Mode = "edit"
MSFlexGrid1.SetFocus
Exit Sub
ErrHandler:
MsgBox "An Error has Occured In The CmdEditMod_Click() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example"
End Sub
Private Sub CmdExit_Click()
End
End Sub
Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandler
Select Case Mode
Case "add"
Call GetKeysAdd(MSFlexGrid1, KeyAscii)
Case "edit"
Call GetKeysEdit(MSFlexGrid1, KeyAscii)
End Select
Exit Sub
ErrHandler:
MsgBox "An Error has Occured In The MSFlexgrid1_KeyPress() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example"
End Sub
Private Sub Form_Load()
On Error GoTo ErrHandler
Set CON = New Connection
CON.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\FlexGridSample.mdb;"
Set RS = New Recordset
RS.Open "Select ID,Name from Student", CON, adOpenStatic, adLockBatchOptimistic
Call AssignData(MSFlexGrid1, RS)
Mode = ""
Exit Sub
ErrHandler:
MsgBox "An Error has Occured In The Form_Load() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example"
End Sub
Public Sub GetKeysAdd(argFlexGrid As MSFlexGrid, KeyAscii As Integer)
'This Procedure is used to display the pressed key into FlexGrid in Addition Mode
'so that when you press Enter Key in the last row then one row will be added.
'When you press the BackSpace Key in an empty Row then a Row will be Removed.
On Error GoTo ErrHandler
Dim i As Long
If KeyAscii = 13 Then 'if Enter Key then...
If argFlexGrid.Cols <> (argFlexGrid.Col + 1) Then 'If current column is not last column...
argFlexGrid.Col = argFlexGrid.Col + 1 'increment col by 1
Else 'If current column is the last column then...
argFlexGrid.Rows = argFlexGrid.Rows + 1 'add a row to the FlexGrid...
argFlexGrid.Col = 0 'set the current column to first column - (0)...
argFlexGrid.Row = argFlexGrid.Row + 1 'set the current row to last row...
argFlexGrid.SetFocus 'set the focus.
End If
Exit Sub
End If
If KeyAscii = 8 Then 'If BackSpace Key then...
If Len(Trim(argFlexGrid.Text)) <> 0 Then 'If current cell is not empty then...
argFlexGrid.Text = Left(argFlexGrid.Text, (Len(argFlexGrid.Text) - 1)) 'Removing a character from the right side of the FlexGrid cell's text
ElseIf argFlexGrid.Rows > 2 Then 'If FlexGrid has more than 2 Rows including the FixedRow then...
For i = 0 To argFlexGrid.Cols - 1 'Checking that the current row is empty or not...
If Len(Trim(argFlexGrid.TextMatrix(argFlexGrid.Row, i))) = 0 Then 'Checking for Empty cell in the current row...
If argFlexGrid.Col <> argFlexGrid.Cols - 1 Then 'Checking that if we reached the last column...
argFlexGrid.Col = argFlexGrid.Col + 1 'goto next column...
Else 'If current columnn is the last column then...
argFlexGrid.Rows = argFlexGrid.Rows - 1 'Remove a Row.
Exit Sub
End If
End If
Next
End If
Else 'If Not BackSpace key then...
argFlexGrid.Text = argFlexGrid.Text + Chr(KeyAscii) 'Append the pressed character to the right.
End If
Exit Sub
ErrHandler:
MsgBox "An Error has Occured In The GETKEYSAdd() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example"
End Sub
Public Sub GetKeysEdit(argFlexGrid As MSFlexGrid, KeyAscii As Integer)
'This Procedure is used to display the pressed key into FlexGrid in Addition Mode
'that is you cannot add new rows as you do in GETKEYSAdd().
On Error GoTo ErrHandler
Dim i As Integer
If KeyAscii = 13 Or KeyAscii = 9 Then Exit Sub 'If Enter Key or Tab Key then Exit Sub.
If KeyAscii = 8 Then 'If BackSpace key then...
If Len(Trim(argFlexGrid.Text)) <> 0 Then 'If current cell is not empty then...
argFlexGrid.Text = Left(argFlexGrid.Text, (Len(argFlexGrid.Text) - 1)) 'Removing a character from the right side of the FlexGrid cell's text
End If
Else
argFlexGrid.Text = argFlexGrid.Text + Chr(KeyAscii) 'Append the pressed character to the right.
End If
Exit Sub
ErrHandler:
MsgBox "An Error has Occured In The GETKEYSEdit() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example"
End Sub
Public Sub AssignData(argFlexGrid As MSFlexGrid, argRS As Recordset)
'This procedure is used to Assign the Data in the given recordset
'to the given FlexGrid
On Error GoTo ErrHandler
Dim FormatString As String 'Stores the FormatString
Dim i As Long 'Loop Variable
Dim j As Long 'Loop Variable
Dim MaxFldValLen As Long 'Stores the Maximum Field Value Length, Used for Automatic Resizing
'Moving The Recordset to the First
argRS.MoveFirst
'Checking for Empty Recordset
If argRS.RecordCount = 0 Or IsEmpty(argRS) Then Exit Sub
'setting the number of rows
'the total rows of FlexGrid includes the FixedRows also
'So argFlexGrid.Rows=No. Of Records->(argRs.RecordCount) + argrs.FixedRows->(1)
argFlexGrid.Rows = argRS.RecordCount + 1
'Setting the current row
argFlexGrid.Row = 1
'checking for FixedCols
'if FixedCols is 1 then S.No. will be automatically generated
'if FixedCols is 0 then S.No. will Not be generated
If argFlexGrid.FixedCols = 1 Then
'If FlexGrid's FixedCols is 1 then data should be assigned from the second column is that argFlexGrid.col=1
argFlexGrid.Col = 1
'setting the number of columns
'the total Cols of FlexGrid includes the FixedCols also
'So argFlexGrid.Cols=No. Of Fields->(argRs.Fields.Count) + argrs.FixedCols->(1)
argFlexGrid.Cols = argRS.Fields.Count + 1
For i = 1 To argRS.RecordCount 'this loop is for rows
For j = 1 To argRS.Fields.Count 'this loop is for Columns
argFlexGrid.TextMatrix(i, j) = argRS(j - 1)
Next
argFlexGrid.TextMatrix(i, 0) = i 'i holds the S.No.
argRS.MoveNext
Next
argRS.MoveFirst
FormatString = "S.No."
'The Following loop is used for resizing the FlexGrid Columns using the FormatString Property
'the MaxFldValLen variable stores the maximum length of a field's value
'and this variable is used to add spaces in the FormatString
'Note: This Resizing Is Not Very Accurate !!!
For i = 0 To argRS.Fields.Count - 1 'this loop is for each Field in the argRS
MaxFldValLen = 0
For j = 0 To argRS.RecordCount - 1 'this loop is for each Record in the argRS
If MaxFldValLen <= Len(argRS(i)) Then
MaxFldValLen = Len(argRS(i))
End If
argRS.MoveNext
Next
argRS.MoveFirst
If Len(argRS(i).Name) > MaxFldValLen Then
'if length of argRS(i).Name>MaxFldValLen(the maximum length of the field's value in a Record) then,
'add some spaces to the FormatString with the Name of the field, here I added 5 You can change it.
FormatString = FormatString & "|" & argRS(i).Name & Space(5)
Else
'if MaxFldValLen(the maximum length of the field's value in a Record)
'is greater than the length of argRS(i).Name then,
'add the excess spaces is that Space(MaxFldValLen - Len(argRS(i).Name) + 15),
'the value 15 should not be changed for exact output
FormatString = FormatString & "|" & argRS(i).Name & Space(MaxFldValLen - Len(argRS(i).Name) + 15)
End If
Next
Else 'if argFlexGrid.FixedCols=0 then - "S.No." will Not be generated
'If FlexGrid's FixedCols is 0 then data should be assigned from the First column is that argFlexGrid.col=0
argFlexGrid.Col = 0
'setting the number of columns
'the total Cols of FlexGrid includes the FixedCols also
'So argFlexGrid.Cols=No. Of Fields->(argRs.Fields.Count) + argrs.FixedCols->(1)
'if FixedCols=0 then argFlexGrid.Cols = argRS.Fields.Count
argFlexGrid.Cols = argRS.Fields.Count
For i = 1 To argRS.RecordCount 'this loop is for rows
For j = 0 To argRS.Fields.Count - 1 'this loop is for Columns
argFlexGrid.TextMatrix(i, j) = argRS(j)
Next
argRS.MoveNext
Next
argRS.MoveFirst
'The Following loop is used for resizing the FlexGrid Columns using the FormatString Property
'the MaxFldValLen variable stores the maximum length of a field's value
'and this variable is used to add spaces in the FormatString
'Note: This Resizing Is Not Very Accurate !!!
For i = 0 To argRS.Fields.Count - 1 'this loop is for each Field in the argRS
MaxFldValLen = 0
For j = 0 To argRS.RecordCount - 1 'this loop is for each Record in the argRS
If MaxFldValLen <= Len(argRS(i)) Then
MaxFldValLen = Len(argRS(i))
End If
argRS.MoveNext
Next
argRS.MoveFirst
If Len(argRS(i).Name) > MaxFldValLen Then
'if length of argRS(i).Name>MaxFldValLen(the maximum length of the field's value in a Record) then,
'add some spaces to the FormatString with the Name of the field, here I added 5 You can change it.
If FormatString = "" Then 'if this loop runs for first time then FormatString will be empty
FormatString = argRS(i).Name & Space(5)
Else
FormatString = FormatString & "|" & argRS(i).Name & Space(5)
End If
Else
'if MaxFldValLen(the maximum length of the field's value in a Record)
'is greater than the length of argRS(i).Name then,
'add the excess spaces is that Space(MaxFldValLen - Len(argRS(i).Name) + 15),
'the value 15 should not be changed for exact output
If FormatString = "" Then 'if this loop runs for first time then FormatString will be empty
FormatString = argRS(i).Name & Space(MaxFldValLen - Len(argRS(i).Name) + 15)
Else
FormatString = FormatString & "|" & argRS(i).Name & Space(MaxFldValLen - Len(argRS(i).Name) + 15)
End If
End If
Next
End If
'Finally assign the FormatString
argFlexGrid.FormatString = FormatString
Exit Sub
ErrHandler:
MsgBox "An Error has Occured In The AssignData() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbYesNo + vbCritical, "FlexGrid Example"
End Sub
Public Function FlexUpdate(argFlexGrid As MSFlexGrid, argRS As Recordset) As Boolean
'This Procedure will Save the Data in the FlexGrid to the given
'Recordset's Database
On Error GoTo ErrHandler
Dim i As Long, j As Long
If argFlexGrid.Rows <= 1 Then Exit Function 'If there is no Row or Only FixedRow.
If FlexChk(argFlexGrid) = False Then 'Checking for empty cells by calling FlexChk().
FlexUpdate = False
Exit Function
End If
argFlexGrid.Row = 0 'setting current row
argFlexGrid.Col = 0 'setting current col
argRS.AddNew
For i = 0 To (argFlexGrid.Rows - 1) 'This loop saves data to the table.
argFlexGrid.Row = argFlexGrid.Row + 1
argFlexGrid.Col = 0
For j = 0 To argRS.Fields.Count - 1
argRS(j) = Trim(argFlexGrid.Text)
If argFlexGrid.Col + 1 <> argFlexGrid.Cols Then
argFlexGrid.Col = argFlexGrid.Col + 1
End If
Next
argRS.UpdateBatch adAffectAllChapters
If argFlexGrid.Rows = (argFlexGrid.Row + 1) Then GoTo FIN
argRS.AddNew
Next
FIN:
argRS.UpdateBatch adAffectAllChapters
FlexUpdate = True
Exit Function
ErrHandler:
MsgBox "An Error has Occured In The FlexUpdate() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example"
End Function
Public Function FlexChk(argFlexGrid As MSFlexGrid) As Boolean
'This Procedure will check the given flexgrid for empty cells
On Error GoTo ErrHandler
Dim ig, jg, ercnt As Long
Dim flg As Boolean
For jg = 0 To (argFlexGrid.Rows - 1)
For ig = 0 To (argFlexGrid.Cols - 1)
If Len(Trim(argFlexGrid.TextMatrix(jg, ig))) = 0 Then
flg = True
GoTo EMTY
Else
flg = False
End If
Next
Next
EMTY:
If flg = True Then
FlexChk = False
Else
FlexChk = True
End If
Exit Function
ErrHandler:
MsgBox "An Error has Occured In The FlexChk() Procedure" & vbCr & "Report This Error To [email protected]" & vbCr & "Error Details :-" & vbCr & "Error Number : " & Err.Number & vbCr & "Error Description : " & Err.Description, vbCritical, "FlexGrid Example"
End Function
No comments have been posted about This is the code which u can not get from books easily. This code provides u understanding of Flex . Why not be the first to post a comment about This is the code which u can not get from books easily. This code provides u understanding of Flex .
