


Visual Basic Intrinsic Control
Routines Pure VB: Simulating a Matrix Checkbox Control Array with a Picture Box 

Posted:  Wednesday January 15, 2003  
Updated:  Monday December 26, 2011  
Applies to:  VB416, VB432, VB5, VB6  
Developed with:  VB6, Windows XP  
OS restrictions:  None  
Author:  Larry Serflaten, VBnet  Randy Birch  
Related: 
Pure VB: Simulating a Matrix Checkbox Control Array with a MSFlexGrid  
Prerequisites 
None. 

A newsgroup poster recently requested help when his project started causing VB to lock up. As a compiled exe the project the application ran to a point, then disappeared without raising an error. Investigation determined the developer was using his own usercontrol consisting of a picture box populated with a userdefined number of check boxes and labels in a set of control arrays. The developer's goal was to produce a clickable matrix of checkboxes the program would use to perform a list of calculations. Each check indicated an equation to be evaluated where the column and row values were to be used as two of the values in the equation. Some equations had a large set of values to display for the column or row selections, and some equations had more than two variables to select which required multiple usercontrols in an array to display all the possible selections. Each new matrix control added to the control array produced a corresponding increase in the total number of Checkbox and Label controls. The problem was the cumulative size of the control arrays  the developer was required to allow the enduser to specify experiment conditions whereby the application would create the required check box/label arrays. The problem surfaced as the application attempted to create six usercontrols, where each usercontrol contained 2601 checkboxes and 102 labels (a 6 x 51^2 matrix of controls). Larry Serflaten responded to the question with an interesting and highly workable solution to the resource problem, and implementing Larry's solution would also provide a boost to the application's overall performance. The solution utilized precisely one picture box and used the control's intrinsic methods to simulate a check box control array matrix. Larry's code is reproduced here with permission.
The number of columns (COLCELLS) and rows (ROWCELLS) is adjustable as
demanded by the initial design criteria, as is the cell size (CELLTWIPS) 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 CELLTWIPS value. Together, these three values are used to create an empty grid drawn into the picture box. Each
'cell' of the 'grid' is clickable, visibly toggling on/off the respective
cell by drawing or removing the chosen check mark character determined
through the x/y positions provided through mouse events. Each
selection/deselection of a cell is actually toggling the appropriate
array element in a module level userdefined type representing the grid
data. In addition to using far fewer resources and eliminating the load delay prevalent when forms contain an excessive number of controls, this method will also boost overall application performance when calculations are being made by providing the user's selections in a suitable data structure instead of thousands of checkbox properties. 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. The command buttons, combo and listbox were added to Larry's basic matrix method in order to highlight additional functionality the demo provides which you may wish to utilize in your implementation of this design. The code for the basic matrix grid does not rely on those controls being present. 
BAS Module Code 
None. 

Form Code 
To a new form, toss on a picture box (Picture1), a list (List1), a combo (Combo1) and four command buttons (Command1 through Command4)  the form's Load event sizes and positions those controls. Add the following code: 

Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©19962011 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 Const ROWCELLS = 18 'number of Rows Private Const COLCELLS = 28 'number of Columns Private Const CELLTWIPS = 240 'cell size in twips (min ~150) 300=20 pixels Private Const BANDCOLOR = &HFFEFEF 'color of every 10th row/col 'UDT's holding row/column array Private Type DataRow Rows() As Byte End Type Private Type DataCol Cols() As DataRow End Type 'formlevel variables Private Data As DataCol 'the array of cells to create Private CellSize As Long 'working var containing CELLTWIPS Private ColCount As Long 'working var containing COLCELLS Private RowCount As Long 'working var containing ROWCELLS Private MouseCount As Long 'tracks mouse activity Private CellChar As String 'character selected for cell checks Private Dirty As Boolean 'true if grid has been checked Private Sub Form_Load() 'Dynamic adjustments RowCount = ROWCELLS ColCount = COLCELLS CellSize = CELLTWIPS 'working var Dirty = False 'set up controls With Picture1 .ScaleMode = vbTwips .Move 200, 200, CellSize * (ColCount + 2), CellSize * (RowCount + 2) .BackColor = vbWhite .AutoRedraw = True End With With List1 .Move Me.ScaleLeft + Picture1.Width + 300, Picture1.Top, 1500, Picture1.Height End With With Command1 .Move 200, Form1.ScaleTop + 400 + Picture1.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, 1350, 345 .Caption = "Matrix" End With With Combo1 .Font.Name = "Marlett" .Font.Size = 10 .AddItem "a" .AddItem "g" .AddItem "i" .AddItem "n" .AddItem "r" .Move Command3.Left + Command3.Width + 120, _ Command1.Top + (Command1.Height  .Height) \ 2, 950 .ListIndex = 0 End With With Me .Width = Picture1.Width + List1.Width + (.Width  .ScaleWidth) + 500 .Height = Picture1.Height + (.Height  .ScaleHeight) + (Command1.Height * 2.5) End With 'set up the data and draw new grid Call BuildArray Call DrawDisplay End Sub Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'If the user happens to move the mouse when 'trying to select just one cell, then that 'cell is toggled in the MouseMove and again 'at MouseUp, resulting in no change from its 'original state. Using a counter for mouse 'movement allows the user to 'accidentally' 'move the mouse between MouseDown and MouseUp, 'and still register it as a mark. MouseCount = 0 End Sub Private Sub Command1_Click() 'Select All Dim dx As Long Dim dy As Long For dx = 1 To ColCount For dy = 1 To RowCount Data.Cols(dx).Rows(dy) = 255 FillCell dx, dy Next 'dy Next 'dx End Sub Private Sub Command2_Click() 'Clear All Dim dx As Long Dim dy As Long For dx = 1 To ColCount For dy = 1 To RowCount Data.Cols(dx).Rows(dy) = 0 FillCell dx, dy Next 'dy Next 'dx Dirty = False End Sub Private Sub Command3_Click() 'Invert Dim dx As Long Dim dy As Long For dx = 1 To ColCount For dy = 1 To RowCount FillCell dx, dy, True Next 'dy Next 'dx End Sub Private Sub Command4_Click() 'Matrix Dim dx As Long Dim dy As Long With List1 .Clear .AddItem "col" & vbTab & "row" .AddItem "" For dx = 1 To ColCount For dy = 1 To RowCount If Data.Cols(dx).Rows(dy) <> 0 Then .AddItem dx & vbTab & dy End If Next 'dy Next 'dx End With End Sub Private Sub Combo1_Click() Dim dx As Long Dim dy As Long If Combo1.ListIndex > 1 Then CellChar = Combo1.List(Combo1.ListIndex) If Dirty Then For dx = 1 To ColCount For dy = 1 To RowCount FillCell dx, dy Next 'dy Next 'dx End If 'Dirty End If 'If Combo1.ListIndex End Sub Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Static px As Long, py As Long 'previous X & Y Dim dx As Long, dy As Long 'dynamic X & Y MouseCount = MouseCount + 1 If Button = vbLeftButton Then 'limit to one change per cell while dragging dx = X \ CellSize dy = Y \ CellSize If (px <> dx) Or (py <> dy) Then px = dx py = dy MouseCount = 0 Picture1_MouseUp Button, Shift, X, Y End If 'if px <> dx End If 'if Button End Sub Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim dx As Long Dim dy As Long dx = X \ CellSize dy = Y \ CellSize 'bail if out of bounds If (MouseCount > 2) Or _ (dx < 0) Or (dx > ColCount) Or (dy < 0) Or (dy > RowCount) Then Exit Sub Else 'ensure next MouseMove will be out of bounds MouseCount = 3 End If If (dx = 0 And dy > 0) Then 'toggle Row dy (based on nearest cell) FillCell 1, dy, True For dx = 2 To ColCount Data.Cols(dx).Rows(dy) = Data.Cols(1).Rows(dy) FillCell dx, dy Next ElseIf (dy = 0 And dx > 0) Then 'toggle Col dx (based on nearest cell) FillCell dx, 1, True For dy = 2 To RowCount Data.Cols(dx).Rows(dy) = Data.Cols(dx).Rows(1) FillCell dx, dy Next ElseIf dx Or dy Then 'toggle cell FillCell dx, dy, True End If End Sub Private Sub BuildArray() Dim cnt As Long Erase Data.Cols ReDim Data.Cols(1 To ColCount) For cnt = 1 To ColCount ReDim Data.Cols(cnt).Rows(1 To RowCount) Next cnt End Sub Private Sub DrawDisplay() Dim r As Long Dim c As Long Dim cell As Long 'As VB's graphic methods do not work 'when used in contracted form inside a 'With statement block. Specific references 'to Picture1 are required on any graphic 'method calls With Picture1 'set font for row/col headings .Font.Name = "Trebuchet MS" .Font.Size = 1 + ((CellSize \ 120) * 4) 'draw Col lines r = RowCount * CellSize For c = 1 To ColCount If c Mod 10 = 0 Then For cell = 1 To RowCount DrawCellColor c, cell, BANDCOLOR Next End If Picture1.Line (c * CellSize, CellSize)Step(0, r), &HC0C0C0 CenterCellText CStr(c), c, 0 Next 'draw Row lines c = ColCount * CellSize For r = 1 To RowCount If r Mod 10 = 0 Then For cell = 1 To ColCount DrawCellColor cell, r, BANDCOLOR Next End If Picture1.Line (CellSize, r * CellSize)Step(c, 0), &HC0C0C0 CenterCellText CStr(r), 0, r Next 'black border Picture1.Line (CellSize, CellSize)Step(ColCount * CellSize, RowCount * CellSize), vbBlack, B 'set font to display checkmarks .Font.Name = "Marlett" .Font.Size = 1 + ((CellSize \ 120) * 5) .Font.Bold = False End With End Sub Private Sub DrawCellColor(ByVal X As Long, ByVal Y As Long, K As Long) Picture1.Line (X * CellSize + Screen.TwipsPerPixelX, _ Y * CellSize + Screen.TwipsPerPixelY)Step(CellSize  Screen.TwipsPerPixelX * 3, _ CellSize  Screen.TwipsPerPixelY * 3), K, BF End Sub Private Sub FillCell(ByVal X As Long, ByVal Y As Long, Optional Toggle As Boolean = False) Dim tgl As Byte Dim bnd As Long tgl = Data.Cols(X).Rows(Y) If Toggle Then tgl = tgl Xor 255 Data.Cols(X).Rows(Y) = tgl End If If (X Mod 10 = 0) Or (Y Mod 10 = 0) Then bnd = BANDCOLOR Else bnd = vbWhite End If DrawCellColor X, Y, bnd If tgl Then CenterCellText CellChar, X, Y Dirty = True End Sub Private Sub CenterCellText(sText As String, X As Long, Y As Long) 'Determine the X and Y print position 'for the character. With Picture1 .CurrentX = (X * CellSize) + ((CellSize  .TextWidth(sText)) \ 2) + Screen.TwipsPerPixelX .CurrentY = (Y * CellSize) + ((CellSize  .TextHeight(sText)) \ 2) + Screen.TwipsPerPixelY End With Picture1.Print sText End Sub 
Comments 
Set the ROWCELLS and COLCELLS constants to the desired values and run. 








Copyright ©19962011 VBnet and Randy Birch. All Rights Reserved. 