[VBnet Intrinsic] Pure VB: Simulating a Matrix Checkbox Control Array with a Picture Box


	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:	VB4-16, VB4-32, 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 user-defined 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 end-user 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/de-selection of a cell is actually toggling the appropriate array element in a module level user-defined type representing the grid data.

For ease in reading a large matrix, each 10th row and column is drawn in a user-defined colour, stored in the BANDCOLOR constant. To provide the user with a rapid means to select adjacent cells, holding the mouse button down and dragging causes cells beneath the cursor to toggle state. Alternatively, clicking on the label of a row or column causes that entire row/column to become selected (or deselected).

As the illustration shows, the check mark character can be changed on the fly with existing checks assuming the new character selected. The Invert Selection option reverses the checks - handy when the desire is to select most items; the user can select the few they don't want and hit Invert.

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

'form-level 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.

PayPal Link