Re: Class Events

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

Yuck - just realised the grid looks flickers when you make a selection. That's because for the purposes of this demo, when simplifying it, I added the line
Me.GridControl.ZOrder 0
to fcnAddNewSelectionLabel
so you could rightclick on a selection.

I've removed this to get rid of the flickering. Thus the labels remain on top to prevent any more click events firing. This means (for the demo) you have to rightclick elsewhere on the grid after you've made your selection. This might seem like strange functionality to implement but it's for the purposes of this demo only - I don't actually use it in the long run - and the question of "making events for a class available in the userform module" stands as originally.

Thanks

class module should read as follows:
'-------------------------
Option Explicit

Public WithEvents GridControl As MSForms.Label

'Settings for the grid
Public Start_Y As Integer
Public Start_X As Integer
Public RowHeight As Integer
Public ColWidth As Integer
Public NoOfRows As Integer
Public NoOfCols As Integer

Public GridParent As MSForms.UserForm


Public blnMouseButtonAlreadyDown As Boolean

Public GridSelection As Collection
Public SelectionCurrentRow As Integer
Public SelectionCurrentCol As Integer
Public SelectionMinCol As Integer
Public SelectionMaxCol As Integer

Public GridBlocks As Collection

Public OnRightClick  As String

Private Sub Class_Initialize()
   Set GridSelection = New Collection
   Set GridBlocks = New Collection
   SelectionCurrentRow = -1
   SelectionCurrentCol = -1
End Sub
Sub FormatGridControl()
Dim iCol As Integer
Dim myLbl As MSForms.Label

   'draw the back labels for the grid
   For iCol = 0 To NoOfCols - 1
      Set myLbl = GridParent.Controls.Add("Forms.Label.1", _
            "BackDrop_Col" & iCol, True)
      With myLbl
         .Left = Start_X + (ColWidth * iCol)
         .Width = ColWidth
         .Top = Start_Y
         .Height = NoOfRows * RowHeight
         .BorderStyle = fmBorderStyleSingle
         .BorderColor = RGB(0, 0, 180)
         .BackColor = RGB(255, 255, 255)
'         .ZOrder = 1
      End With
   Next iCol

   'format the main label as per user settings
   With Me.GridControl
      .BorderStyle = fmBorderStyleSingle
      .BorderColor = RGB(0, 0, 0)
      .SpecialEffect = fmSpecialEffectSunken
      .BackStyle = fmBackStyleTransparent
      .ZOrder 0
   End With



   Set myLbl = Nothing

End Sub
Private Sub GridControl_Click()

   If blnMouseButtonAlreadyDown Then
      blnMouseButtonAlreadyDown = False
   Else
      fcnClearSelection
   End If
End Sub

Private Sub GridControl_MouseDown(ByVal Button As Integer, _
   ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   'handle right clicking
   If Not Button = 2 Then Exit Sub

   If GridSelection.Count = 0 Then
      MsgBox "pls select something"
      Exit Sub
   End If
   Application.Run OnRightClick

End Sub

Private Sub GridControl_MouseMove(ByVal Button As Integer, _
   ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

Dim newCol As Integer, newRow As Integer
   'we want to trap when someone holds the mouse button down
   If Button <> 1 Then Exit Sub

   ' the mouse button isn't already down then this is a new selection
   If Not blnMouseButtonAlreadyDown Then
      'clear any existing "selections" from our collection
      fcnClearSelection
   End If

   'we want to create a label on the grid to represent a selection
   newRow = fcnCalculateGridRowFromY(Y)
   newCol = fcnCalculateGridColFromX(X)

'if it's the same cell as last time then exit
If newRow = SelectionCurrentRow And newCol = SelectionCurrentCol Then Exit Sub

   'if this is a new row then set this row as our selection row
   'clear our selection and exit
   If SelectionCurrentRow = -1 Then SelectionCurrentRow = newRow

   'If this is a different row than last time then
   'we ignore
   If SelectionCurrentRow <> newRow Then Exit Sub

'if this isn't the same as the previous column then we want to add a label
If SelectionCurrentCol <> newCol And newCol <= NoOfCols - 1 Then

      If SelectionMinCol = -1 Then
         SelectionMinCol = newCol
      ElseIf SelectionCurrentCol < SelectionMinCol Then
         SelectionMinCol = SelectionCurrentCol
      End If
      If SelectionCurrentCol > SelectionMaxCol Then _
                     SelectionMaxCol = SelectionCurrentCol

      fcnAddNewSelectionLabel newRow
      SelectionCurrentCol = newCol
      blnMouseButtonAlreadyDown = True

   End If




End Sub

Function fcnCalculateGridRowFromY(Y As Single) As Integer
   fcnCalculateGridRowFromY = CInt(Y / RowHeight - 0.499999)
End Function
Function fcnCalculateGridColFromX(X As Single) As Integer
   fcnCalculateGridColFromX = CInt(X / ColWidth - 0.499999)
End Function

Sub fcnClearSelection()
   While GridSelection.Count > 0
      GridParent.Controls.Remove GridSelection(1).Name
      GridSelection.Remove 1
   Wend
   SelectionCurrentCol = -1
   SelectionCurrentRow = -1
   SelectionMinCol = -1
   SelectionMaxCol = -1

End Sub
Sub fcnAddNewSelectionLabel(myRow As Integer)

Dim myLbl As MSForms.Label
Dim iCol As Integer


   'We insert this selection label but also
   'check that we haven't missed any cells
   '(this occurs when the mouse moves too fast
   'or the user hits another row while moving the mouse)
   For iCol = SelectionMinCol To SelectionMaxCol

   'check whether this label already exists in our collection
      If Not fcnKeyAlreadyExistsInCollection("R" _
                     & myRow & "C" & iCol, GridSelection) Then

         'create the control
         Set myLbl = GridParent.Controls.Add("Forms.Label.1", _
                                    "R" & myRow & "C" & iCol, True)
         With myLbl
            .Left = Start_X + iCol * ColWidth
            .Top = Start_Y + myRow * RowHeight
            .Height = RowHeight
            .Width = ColWidth
            .BorderStyle = fmBorderStyleSingle
            .BorderColor = RGB(200, 0, 0)
            .BackColor = RGB(255, 0, 0)
         End With

         On Error Resume Next
         GridSelection.Add myLbl, "R" & myRow & "C" & iCol

      End If

   Next iCol

   'bring the main grid label back to the front
   'Me.GridControl.ZOrder 0

End Sub
Function fcnKeyAlreadyExistsInCollection(myKey As String, _
                                       myColl As Collection) As Boolean
'checks a given collection to see if a key already exists in there

   On Error Resume Next
   If myColl(myKey).Name = "X" Then
      Exit Function
   End If
   fcnKeyAlreadyExistsInCollection = True
End Function
Sub CreateBlock(myCaption As String)
Dim myTextBox As MSForms.TextBox

   Set myTextBox = GridParent.Controls.Add("Forms.Textbox.1", _
      "Block_" & "R" & SelectionCurrentRow & "C" & SelectionMinCol, True)

   With myTextBox
      .BackColor = RGB(255, 255, 0)
      .Text = myCaption
      .Left = Start_X + SelectionMinCol * ColWidth
      .Top = Start_Y + SelectionCurrentRow * RowHeight
      .Height = RowHeight
      .Width = (SelectionMaxCol - SelectionMinCol + 1) * ColWidth
   End With
   Set myTextBox = Nothing

   'bring the main grid label back to the front
   Me.GridControl.ZOrder 0
   'add to my collection
   'DO THIS LATER'

   fcnClearSelection

End Sub
.

Quantcast