by Jerry Barnes (5 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: Visual Basic 3.0
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: 
(15 Votes)
This program is designed to teach the user how to load data into a FlexGrid from an Access database and then manipulate the FlexGrid to perform typical database actions such as Add, Edit, Sort, and Delete. The database manipulations are executed with ADO methods
VBcoders
FlexGrid Tutorial
FlexGrid Tutorial
This program is designed to teach the user how to load
data into a FlexGrid from a database and then manipulate the FlexGrid to perform typical database actions such as Add, Edit, Sort, and
Delete.
Part One - Setting Up the FlexGrid
1st Step:
A. Go to the Project Menu Tab and select Components.
B. Add the Microsoft Flexgrid Control 6.0
Picture
One
C. Go to the Project menu Tab and select References.
D. Add Microsoft ActiveX Data Objects 2.1 Libray.
Picture
Two
2nd Step
A. Rename the form to frmMain.
B. Change the form's Caption To "FlexGrid Tutorial"
C. Rename the project to FlexGridTutorial.
D. Add a FlexGrid to the form.
E. Using the property window, Rename the FlexGrid to fg.
Picture
Three
3rd Step:
A. Declare a connection and recordset object (Code Follows).
B. In the Form_Load Event, open the connection and recordset (Code Follows).
C. Also, from the Form_Load Event, call the LoadFG Procedure (This is not written yet- It will be the next step).
Option Explicit
Dim WithEvents cn As ADODB.Connection
Dim WithEvents rs As ADODB.Recordset
Private Sub Form_Load()
Dim strConnect As String
strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\fgtutorial.mdb"
Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient
cn.Open strConnect
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenForwardOnly
rs.LockType = adLockPessimistic
rs.Source = "SELECT * FROM [Employees]"
rs.ActiveConnection = cn
rs.Open
Call LoadFG
End Sub
4th Step:
A. Write the LoadFG Procedure as follows
Private Sub LoadFG()
'The AllowUserResizing property
' allows the user to resize
' the columns and rows during
' runtime when it is set to
' flexResizeBoth.
' The other options are:
' flexResizeColumns
' flexResizeNone
' flexResizeRows
fg.AllowUserResizing = flexResizeBoth
'Set the number of columns by using the
' number of fields plus one. One is added
' in order to leave the first column
' (row headers) blank. Note that you can
' use any number for the number of columns
' if you want to leave certain data out.
' For example, if you only want to use
' three fields out of ten, set fg.cols
' equal to 4.
fg.Cols = rs.Fields.Count + 1
'Set the number of rows equal to one
' for the time being. We do this since
' we are going to be adding the column
' titles first. When we are finished
' adding the column headers, we will
' populate the rest of the table.
fg.Rows = 1
Dim i As Integer 'This will be a counter.
'Fill in the column headings with the
' field names from the recordset. Note
' that we are using the field names
' from the database for the column
' headers. You could
' assign whatever header you like by
' simply doing something like the
' following:
' fg.Col = 0
' fg.Text = "First Column"
' fg.Col = 1
' fg.Text = "Second Column"
' etc.
'Row 0 is the first row (and only row). It is
' where the headers will be placed.
fg.Row = 0
For i = 0 To rs.Fields.Count - 1
'Move to column i. Remember that the
' first column is left blank so
' we shift over 1.
fg.Col = i + 1
'The following line aligns the cell.
' The other options for alignment are:
'
' flexAlignLeftTop 0
' flexAlignLeftCenter 1
' flexAlignLeftBottom 2
' flexAlignCenterTop 3
' flexAlignCenterCenter 4
' flexAlignCenterBottom 5
' flexAlignRightTop 6
' flexAlignRightCenter 7
' flexAlignRightBottom 8
' flexAlignGeneral 9
fg.ColAlignment(i) = flexAlignLeftCenter
'Set the text in the current cell
' to the field name.
fg.Text = rs.Fields(i).Name
Next
'This would be a good time to run
the project
' to see what you have.
Try to resize the
' columns using the mouse.
'Fill in the data from the db into the
' grid.
Do While Not rs.EOF
'Add a row to the FlexGrid everytime
' the database goes to another row.
fg.Rows = fg.Rows + 1
'Move to last row to add data.
fg.Row = fg.Rows - 1
'Move to every cell in the row
' and fill it in with the
' corresponding value from the
' database.
For i = 0 To rs.Fields.Count - 1
'Remember that the
' first column is left blank so
' we shift over 1.
fg.Col = i + 1
fg.Text = rs(i).Value & ""
Next
'Move to the next record.
rs.MoveNext
Loop
'The first column is the headers for the
' rows. Change its width so that
' it is not as wide as the other columns.
' You could change all column widths
' with a for next loop.
fg.ColWidth(0) = 500
'The FlexGrid is loaded.
' Now is a good time to run the
' the program and view your results.
End Sub
Part Two - Adding Common Database Functions
1st Step
A. Go to the Tools Menu and select Menu Editor.
B. Add the following menus:
File
Exit
Edit
Add
Delete
Sort
Properties of Menus:
Name
Caption
mnuFile
&File
mnuFileExit
E&xit
mnuEdit
&Edit
mnuEditAdd &Add
mnuEditDelete &Delete
mnuEditSort &Sort
Picture
Four
C. Program in the follwing procedures for the mnuFileExit_Click event.
Private Sub mnuFileExit_Click()
'Tidy up the objects floating in memory.
Set cn = Nothing
Set rs = Nothing
End
End Sub
2nd Step
A. Add the following code for the delete procedure.
Private Sub mnuEditDelete_Click()
Dim intChoice As Integer
Dim intEmployeeID As Integer
'Move to column 0 so that we can get
' the employeeid number. This will
' be used to delete the record from
' the database.
fg.Col = 1
intEmployeeID = fg.Text
'find the desired record and kill it.
rs.MoveFirst
rs.Find ("EmployeeID Like '" & intEmployeeID & "'")
intChoice = MsgBox("Are you sure you want to delete " & _
"the record of " & rs.Fields("FirstName").Value & " " & _
rs.Fields("LastName").Value & "?", vbYesNo, "Delete?")
'Confirm Delete
If intChoice = vbYes Then
rs.Delete
'This command does not delete the row from
' database. It just removes the row.
' from the flexgrid.
fg.RemoveItem (fg.Row)
Else
MsgBox "Delete Cancelled", vbOKOnly, "Cancelled"
End If
'Potential Problem: You cannot remove the last
' non-fixed row from the flexgrid. Try it.
' Delete all rows. When you delete the last
' one, it is deleted from the database, but
' not from the flexgrid.
'I do not know the best solution for this
' problem, but I do have temporary solution
' that works for me.
' Replace fg.RemoveItem (fg.Row) with the
' following code:
'
' if rs.RecordCount <> 0 then
'
fg.RemoveItem(fg.Row)
' Else
'
fg.RowHeight(fg.Row) = 0
' End If
'
'The problem with this fix is that the row still
' exists in the flexgrid until the app is
' closed. When it is opened again, the
' row will not be there.
End Sub
3rd Step
A. Program the following code for the mnuEditSort_Click procedure
Private Sub mnuEditSort_Click()
'This will sort the flexgrid according to
' the column that is selected. We have
' selected sort ascending. The other options
' are given below.
fg.Sort = 1
'flexSortNone = 0
'flexSortGenericAscending = 1
'flexSortGenericDescending = 2
'flexSortNumericAscending = 3
'flexSortNumericDescending = 4
'flexSortStringNoCaseAsending = 5
'flexSortNoCaseDescending = 6
'flexSortStringAscending = 7
'flexSortStringDescending = 8
'It it not a bad idea to add a menu item
' for sort descending and sort ascending.
'Potential Problem: The first column is fixed.
' You cannot select a cell in the first column.
'
' fg.Col = 0
' fg.Sort = 1
' but this takes away the use of the mouse
' in selecting a column.
' Another solution is to leave the first column
' empty when you are loading the table. Start
' with 1 instead of 0 when filling in values
' on the row. This is the solution we used.
End Sub
4th Step
In this step we will add a new row to the grid. Adding a row is easy. You just
put in fg.AddItem "". This adds a blank row. It doesn't do any good to add a row unless you can put data into your
database though. It is a lot harder to get this done.
A. Add a text box to the form named txtCell. Set the text property to "",
set the visible property to false,
and the border style to none.
Picture
Five
B. Add the following code for the add procedure.
Private Sub mnuEditAdd_Click()
'Add a new record to the DB. We need to do this
' in order to get the next Employee ID number
' since the EmployeeID is an autonumber field.
rs.AddNew
'In this particular database, FirstName and
' lastname are required fields. Since the
' user needs to enter values for them, we
' use empty strings for the values
' until they can be filled in.
rs.Fields("FirstName").Value = " "
rs.Fields("LastName").Value = " "
'Save the record. It would be nice if escape
' could cancel the update, but I haven't
' got that part figured out yet.
rs.Update
'Move to the last record so that we
' can get the employee ID.
rs.MoveLast
'The format: AddItem String, Index
' the string is whatever message goes in the
' first column. The Index is row where
' the new row is inserted. If left blank
' the row is adding onto the end.
fg.AddItem ""
'Put the Employee ID in the table.
' Go to the last row and first column.
fg.Row = fg.Rows - 1
fg.Col = 1
'Add the EmployeedID. Note that a permanent
' record has been created in the database.
' If nothing is typed in the fields then
' a record exists with just an employee id.
fg.Text = rs.Fields("EmployeeID").Value
'Call the MoveTextBox Procedure. It has not
' been written yet.
Call MoveTextBox
End Sub
C. Go to the declarations section and add thefollowing declarations.
Dim mblnLoaded As Boolean
Dim mblnMouse As Boolean
mblnLoaded is going to be used to load the grid.
mblnMouse is going to be used to determine if a cell has been clicked on.
D. Now go to the Form_Load event. Before the the call to LoadGrid, set mblnLoaded to false.
After the call to LoadGrid, set mblnLoaded = True. It should look like the
following.
mblnLoaded = False
Call LoadFG
mblnLoaded = True
This is necessary in order to keep the cell from being filled
with null values with the EnterCell and LeaveCell events coming up.
E. Program in the MoveTextBox Procedure.
Private Sub MoveTextBox()
'This procedure moves a textbox over the
' selected cell, makes it visible, sets
' its text equal to the cell's text, &
' gives it the focus. I got the idea
' for this from:
' www.msdn.microsoft.com
'Make the textbox visible.
txtCell.Visible = True
'Move the text box over the selected cell.
Dim inthold
inthold = fg.Row
inthold = fg.Col
txtCell.Left = fg.Left + fg.CellLeft
txtCell.Top = fg.Top + fg.CellTop
txtCell.Height = fg.CellHeight
txtCell.Width = fg.CellWidth
'Set the text in the textbox equal to the
' text in the selected cell.
txtCell.Text = fg.Text
'Activate the cell.
txtCell.SetFocus
If Len(txtCell.Text) > 0 Then
txtCell.SelStart = 0
txtCell.SelLength = Len(txtCell.Text)
End If
'The following line will be important later.
' If two controls occupy the same space,
' Zorder describes which control is on top.
' Zorder (0) brings a control to the front.
txtCell.ZOrder (0)
End Sub
F. Add the following five procedures.
Private Sub fg_EnterCell()
'First
'Do not manipulate cell values until
' the grid is loaded.
If mblnLoaded = True Then
'Assign cell value to the textbox
txtCell.Text = fg.Text
End If
End Sub
Private Sub fg_LeaveCell()
'Second
'Do not manipulate cell values until
' the grid is loaded.
If mblnLoaded = True Then
'Assign textbox value to the cell
fg.Text = txtCell.Text
txtCell.Text = ""
End If
End Sub
Private Sub fg_MouseDown(Button As Integer, Shift As Integer, _
x As Single, y As Single)
'Third
'If the mouse is clicked set mblnMouse to True.
mblnMouse = True
'Assign the textbox with the cell value.
fg.Text = txtCell.Text
'Move the textbox to the desired postion.
MoveTextBox
End Sub
Private Sub txtCell_KeyDown(KeyCode As Integer, Shift As Integer)
'Fourth
'This procedure will allow the user to leave
' a cell with the enter key.
If KeyCode = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Form_Activate()
'Fifth
'The procedure set the focus to the first
' cell when the form activates. This
' could be inconvienent if the user changes
' forms while leaving this one open. Boolean
' variables could be used to avoid this.
fg.Col = 1
fg.Row = 1
MoveTextBox
End Sub
'G. Enter the following procedure. Basically this procedure moves the text box when
you tab.
Private Sub Txtcell_LostFocus()
'This sub has not been programmed yet.
' It will be programmed next.
Call SaveRecord
'If the user clicks on a cell, go
' to the cell. See the MouseDown
' Proc earlier. Leave.
If mblnMouse = True Then
mblnMouse = False
Exit Sub
End If
'Move to the new column and send the
' text box there.
'If you're not at the end of the column,
' move to next column.
If fg.Col <= fg.Cols - 2 Then
fg.Col = fg.Col + 1
MoveTextBox
Else 'If you're at the end of a row,
' go to the last row unless you
' are on the last row.
If fg.Row + 1 < fg.Rows Then
fg.Row = fg.Row + 1
fg.Col = 1
Call MoveTextBox
End If
End If
End Sub
H. Enter the SaveRecord Procedure. This procedure saves the record whenever
you leave the cell.
Private Sub SaveRecord()
'If the cell and textbox are different,
' save the new value.
If txtCell.Text <> fg.Text Then
Dim intEmployeeID As Integer
Dim inthold As Integer
'Hold the current col position.
inthold = fg.Col
'Move to the first column in order
' to get the Employee ID.
fg.Col = 1
intEmployeeID = fg.Text
'Move back to the original column.
fg.Col = inthold
'Assign the text from the textbox to
' the cell.
fg.Text = txtCell.Text
'Find the record with the specified
' employee id.
rs.MoveFirst
rs.Find ("EmployeeID Like '" & intEmployeeID & "'")
'Change the value and save the record.
rs.Fields(fg.Col - 1).Value = fg.Text
rs.Update
End If
End Sub
Run the program now. Click on a cell and scroll. You will notice that the cell moves and the
text box stays where it is. This is unacceptable. so lets fix it.
I. The following procedure will take care of this problem.
Private Sub fg_Scroll()
'Whenever a scroll occurs, automatically
' put txtCell on top.
txtCell.ZOrder (0)
'If the current cell is scrolled off screen
' then put it behind the grid.
If fg.ColPos(fg.Col) < 0 Then
txtCell.ZOrder (1)
ElseIf fg.ColPos(fg.Col) > 4500 Then
txtCell.ZOrder (1)
Else 'If the current cell comes back
' on the screen bring it to
' the front.
txtCell.Left = fg.CellLeft + fg.Left
End If
End Sub
Another problem has arisen since we started using the floating text box. Run the program
and sort a column. The text box does not move or contain the value of the cell that it is over after the sort is performed.
J. Fix the Sort Problem by going to the mnuEditSort_Click Procedure and inserting
the following two lines after fg.Sort = 1
fg.Row = 1
Call MoveTextBox
Afterward:
This project took a lot longer than I presumed
it would. My goal was to make this table look and behave like an Access table. It is
close now but still has many features to be added. If I have time I may
add these.
The project took a while because every time I added a new feature, it would affect another part
of the program. This led to many changes and revisions. I think that the the version that I have now
works fairly well. There are some features that I did not get to such as cutting
columns or rows and pasting them at a different position.
There are also some features that I did not know how to implement. I could not import pictures
from a database into the FlexGrid correctly (which would be a cool feature). I would also
like to be able to cancel an add new record correctly. In Access with autonumber, the
record number will not be saved until another
field is completed. It would be a great help if someone would post solutions to these problems.
[email protected]
