|
|
![]() |
|
||
|
|
|||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||
|
Visual Basic Intrinsic Control
Routines Pure VB: Simulating a Matrix Checkbox Control Array with a MSFlexGrid |
||
| Posted: | Monday January 02, 2006 | |
| Updated: | Monday December 26, 2011 | |
| Applies to: | VB4-16, VB4-32, VB5, VB6 | |
| Developed with: | VB6, Windows XP | |
| OS restrictions: | None | |
| Author: | Rick Rothstein, VBnet - Randy Birch | |
|
Related: |
Pure VB: Simulating a Matrix Checkbox Control Array with a Picture Box | |
| Prerequisites |
| None. |
|
|
![]() The VBnet page Pure VB: Simulating a Matrix Checkbox Control Array with a Picture Box provided a single picture box solution for a user experiencing resource issues when using huge arrays of check boxes to simulate a matrix array. This post shows how a MSFlexGrid could also be used to achieve much of the original page's functionality. See the explanation there for additional info.
Like the original demo, the number of columns (COLCELLS) and rows (ROWCELLS) is adjustable as
demanded by the initial design criteria, as is the cell size (TEXTCELLWIDTH) to better
suit aesthetics or fit the matrix into available screen space. The size of the
matrix label and checkmark fonts scale to fit the cell size based upon
the TEXTCELLWIDTH value. Along with two other variables,
LASTDRAWINGCOLUMN and NUMTEXTCOLUMNS, the values assigned to these
variables are used to create a check box-like grid. Each
'cell' of the 'grid' from 1 to LASTDRAWINGCOLUMN is clickable, visibly toggling on/off the respective
cell by drawing or removing the chosen check mark character. While not as light as the associated picture box demo, using one grid to simulate possibly hundreds of check boxes is far less resource-intensive than a corresponding array of check box controls, resulting in faster loading of the form, And, since the grid handles the data directly, it's a simple matter to run through each column/row to determine whether a particular cell is checked. The Matrix button's click event code shows how to access the data; pressing this button will add each checked cell's column and row values to individual lines in the Listbox shown on the form. This method also provides the bonus of text columns after the check box grid to accommodate questions or comments. As with the picture box matrix demo, the command buttons, combo and listbox were added in order to highlight additional functionality the demo provides which you may wish to utilize in your implementation of this design. The actual matrix grid code does not rely on those controls being present; however, in a final app you must at a minimum assign a font character to the CheckSymbol variable if you elect to hard-code one specific character. |
| BAS Module Code |
| None. |
|
|
| Form Code |
|
|
| To a new form add a MSFlexGrid control (MSFlexGrid1), a list box (List1), a combo box (Combo1) and four command buttons (Command1 through Command4). The form's Load event sizes and positions these controls. Add the following code: |
|
|
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'adjustable values
Private CurrentRow As Long
Private CurrentCol As Long
'store font symbol for checkmarks
Private CheckSymbol As String
'ADJUSTABLE VALUES
'=================
'VALUES AFFECTING COLUMNS
'Columns after this one are normal FlexGrid cells
Private Const LASTDRAWINGCOLUMN As Long = 16
'Number of non-checkbox columns after last drawing column
Private Const NUMTEXTCOLUMNS As Long = 1
'Total number of Columns set in the load event based
'on the data above (here the 16 check columns,
'1 text column, and the 1 header column). The header
'column must be accounted for in the total.
Private COLCELLS As Long
'VALUES AFFECTING ROWS
'Total number of Rows including the header row
Private Const ROWCELLS As Long = 15
'MISC VALUES
'Height and width of checkbox cells in PIXELS
Private Const CHECKCELLSIZE As Long = 17
'Width of non-checkbox cells in PIXELS
Private Const TEXTCELLWIDTH As Long = 225
'Color of every 10th row/col
Private Const BANDCOLOR As Long = &HFFEFEF
Private Const SM_CXVSCROLL = 2
Private Const SM_CYHSCROLL = 3
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Sub Form_Load()
Dim dx As Long
Dim sbarsize As Long
'we need to determine this first of all.
'1 must be added to account for the header!!!!
COLCELLS = LASTDRAWINGCOLUMN + NUMTEXTCOLUMNS + 1
With MSFlexGrid1
'last row will be invisible, used to hide FocusRectangle
.Rows = ROWCELLS + 1
.Cols = COLCELLS
.Move 150, 150
For dx = LASTDRAWINGCOLUMN + 1 To _
LASTDRAWINGCOLUMN + NUMTEXTCOLUMNS
.ColWidth(dx) = TEXTCELLWIDTH * Screen.TwipsPerPixelX
Next 'dx
.FillStyle = flexFillRepeat
For dx = 0 To LASTDRAWINGCOLUMN
.TextMatrix(0, dx) = dx
.ColWidth(dx) = CHECKCELLSIZE * Screen.TwipsPerPixelX
If dx > 0 And dx Mod 10 = 0 Then
.Col = dx
.ColSel = dx
.Row = .FixedRows
.RowSel = .Rows - 1
.CellBackColor = BANDCOLOR
End If
Next 'dx
For dx = 0 To .Rows - 1
.TextMatrix(dx, 0) = dx
If dx > 0 And dx < .Rows - 1 Then
.TextMatrix(dx, LASTDRAWINGCOLUMN + NUMTEXTCOLUMNS) = _
"Sample line of text on Line #" & CStr(dx)
End If
.RowHeight(dx) = CHECKCELLSIZE * Screen.TwipsPerPixelY
If dx > 0 And dx Mod 10 = 0 Then
.Row = dx
.Col = .FixedCols
.RowSel = dx
.ColSel = .Cols - 1
.CellBackColor = BANDCOLOR
End If
Next 'dx
.Col = 1
.Row = 1
.ColSel = LASTDRAWINGCOLUMN
.RowSel = .Rows - 1
.CellFontName = "Marlett"
.Row = .Rows - 1
sbarsize = GetSystemMetrics(SM_CXVSCROLL)
.Width = ((.GridLineWidth + CHECKCELLSIZE) * LASTDRAWINGCOLUMN + _
(TEXTCELLWIDTH * NUMTEXTCOLUMNS) + sbarsize) * Screen.TwipsPerPixelX
.Height = (.GridLineWidth + CHECKCELLSIZE * (.Rows - 1)) * Screen.TwipsPerPixelY
.Appearance = flexFlat
.BackColorSel = .BackColor
.RowHeight(.Rows - 1) = 0
End With
With List1
.Move MSFlexGrid1.Left + MSFlexGrid1.Width + 240, _
MSFlexGrid1.Top, 1500, MSFlexGrid1.Height
End With
With Command1
.Move MSFlexGrid1.Left, 150 + MSFlexGrid1.Top + _
MSFlexGrid1.Height, 1350, 345
.Caption = "Select All"
End With
With Command2
.Move Command1.Left + Command1.Width, _
Command1.Top, 1350, 345
.Caption = "Select None"
End With
With Command3
.Move Command2.Left + Command2.Width, _
Command1.Top, 1350, 345
.Caption = "Invert Selection"
End With
With Command4
.Move List1.Left, Command1.Top, List1.Width, 345
.Caption = "Matrix"
End With
With Combo1
.Move MSFlexGrid1.Left + MSFlexGrid1.Width - _
.Width, Command1.Top
.Font = "Marlett"
.FontSize = 10
.AddItem "a" 'check
.AddItem "g" 'solid box
.AddItem "i" 'diamond
.AddItem "n" 'solid dot
.AddItem "r" 'x
.ListIndex = 0
CheckSymbol = .List(.ListIndex)
End With
With Me
.Width = List1.Left + List1.Width + 300
.Height = Command1.Top + Command1.Height + 600
.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
End With
End Sub
Private Sub Combo1_Click()
Dim dx As Long
Dim dy As Long
With Combo1
CheckSymbol = .List(.ListIndex)
End With
With MSFlexGrid1
For dx = 1 To .Rows - 1
For dy = 1 To LASTDRAWINGCOLUMN
If .TextMatrix(dx, dy) <> "" Then
.TextMatrix(dx, dy) = CheckSymbol
End If
Next
Next
.Col = 1
.Row = 1
.ColSel = LASTDRAWINGCOLUMN
.RowSel = .Rows - 1
.CellFontName = "Marlett"
If CheckSymbol = "a" Then
.CellFontSize = 10
Else
.CellFontSize = 8
End If
.Row = .Rows - 1
End With
End Sub
Private Sub Command1_Click()
List1.Clear
With MSFlexGrid1
.Col = 1
.Row = 1
.ColSel = LASTDRAWINGCOLUMN
.RowSel = .Rows - 1
.Text = CheckSymbol
.Row = .Rows - 1
End With
End Sub
Private Sub Command2_Click()
List1.Clear
With MSFlexGrid1
.Col = 1
.Row = 1
.ColSel = LASTDRAWINGCOLUMN
.RowSel = .Rows - 1
.Text = ""
.Row = .Rows - 1
End With
End Sub
Private Sub Command3_Click()
Dim dx As Long
Dim dy As Long
List1.Clear
With MSFlexGrid1
For dx = 1 To .Rows - 1
For dy = 1 To LASTDRAWINGCOLUMN
.TextMatrix(dx, dy) = IIf(.TextMatrix(dx, dy) = _
"", CheckSymbol, "")
Next
Next
End With
End Sub
Private Sub Command4_Click()
Dim dx As Long
Dim dy As Long
With List1
.Clear
.AddItem "col" & vbTab & "row"
.AddItem "------------------------------"
End With
With MSFlexGrid1
For dx = 1 To LASTDRAWINGCOLUMN
For dy = 1 To .Rows - 1
If .TextMatrix(dy, dx) <> "" Then
List1.AddItem dx & vbTab & dy
End If
Next
Next
End With
End Sub
Private Sub MSFlexGrid1_Click()
Dim dx As Long
Dim TextSymbol As String
With MSFlexGrid1
If .MouseCol = 0 And .MouseRow > 0 Then
For dx = 1 To LASTDRAWINGCOLUMN
If .TextMatrix(.MouseRow, dx) = "" Then
TextSymbol = CheckSymbol
Exit For
End If
Next
.Row = .MouseRow
.Col = 1
.RowSel = .MouseRow
.ColSel = LASTDRAWINGCOLUMN
.Text = TextSymbol
CurrentRow = .MouseRow
CurrentCol = .MouseCol
ElseIf (.MouseRow = 0 And .MouseCol > 0) And _
(.MouseCol <= LASTDRAWINGCOLUMN) Then
For dx = 1 To .Rows - 2
If .TextMatrix(dx, .MouseCol) = "" Then
TextSymbol = CheckSymbol
Exit For
End If
Next
.Row = 1
.Col = .MouseCol
.ColSel = .MouseCol
.RowSel = .Rows - 2
.Text = TextSymbol
CurrentRow = .MouseRow
CurrentCol = .MouseCol
ElseIf (CurrentRow <> .MouseRow Or CurrentCol <> .MouseCol) And _
(.MouseRow > 0 And .MouseCol > 0) And _
(.MouseCol <= LASTDRAWINGCOLUMN) Then
.TextMatrix(.MouseRow, .MouseCol) = IIf(.TextMatrix(.MouseRow, _
.MouseCol) = CheckSymbol, _
"", CheckSymbol)
CurrentRow = .MouseRow
CurrentCol = .MouseCol
End If
.Row = .Rows - 1
End With
End Sub
Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
CurrentRow = 0
CurrentCol = 0
End Sub
Private Sub MSFlexGrid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
With MSFlexGrid1
If .Col <= LASTDRAWINGCOLUMN Then .Row = .Rows - 1
End With
End Sub
Private Sub MSFlexGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
With MSFlexGrid1
If (CurrentRow <> .MouseRow Or CurrentCol <> _
.MouseCol) And .MouseRow > 0 And .MouseCol > 0 And _
.MouseCol <= LASTDRAWINGCOLUMN Then
.TextMatrix(.MouseRow, .MouseCol) = IIf(.TextMatrix( _
.MouseRow, .MouseCol) = _
CheckSymbol, "", CheckSymbol)
End If
.Row = .MouseRow
.RowSel = .MouseRow
.Col = .MouseCol
.ColSel = .MouseCol
CurrentRow = .MouseRow
CurrentCol = .MouseCol
End With
End If
End Sub
|
| Comments |
| Set the ROWCELLS and COLCELLS constants to the desired values and run. |
|
|
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
![]() |