|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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. |