[SOLVED] Class Events

[Gareth]

Hi NG,

I've created a class that builds on a (large) Label and, with a host of
other labels (placed beneath the main label), acts as a clickable grid.

This grid is placed on a userform at run time. The events, selection of
objects etc. are handled within the class. I want to expand this however
such that an event such as a doubleclick on certain objects will fire as
an event within the parent userform's module i.e. expose something like:

Private Sub myGrid_DblClick(myRow as integer, myCol as integer, _
myID as integer)

End Sub

My assumption is that this isn't possible since the Grid isn't
instantiated until run time. (And I would definitely rather not have the
class module calling a procedure within the userform.)

Is my only option to make an OCX for this class so I can incorporate it
at design time (and accept all the deployment issues) or am I
overlooking something?

Thanks for any help,
Gareth

....The answer may well be in my copy of Power Programming by Mr
Walkenbach but it's packed up in boxes with all my other books...

[Tom Ogilvy]

Sounds like you could adapt this method for your request.

http://www.j-walk.com/ss/excel/tips/tip44.htm

A John Walkenbach's site

--
Regards,
Tom Ogilvy

"Gareth" <nah> wrote in message
news:[email protected]...
> Hi NG,
>
> I've created a class that builds on a (large) Label and, with a host of
> other labels (placed beneath the main label), acts as a clickable grid.
>
> This grid is placed on a userform at run time. The events, selection of
> objects etc. are handled within the class. I want to expand this however
> such that an event such as a doubleclick on certain objects will fire as
> an event within the parent userform's module i.e. expose something like:
>
> Private Sub myGrid_DblClick(myRow as integer, myCol as integer, _
> myID as integer)
>
> End Sub
>
> My assumption is that this isn't possible since the Grid isn't
> instantiated until run time. (And I would definitely rather not have the
> class module calling a procedure within the userform.)
>
> Is my only option to make an OCX for this class so I can incorporate it
> at design time (and accept all the deployment issues) or am I
> overlooking something?
>
> Thanks for any help,
> Gareth
>
> ...The answer may well be in my copy of Power Programming by Mr
> Walkenbach but it's packed up in boxes with all my other books...

[Gareth]

Hi Tom,

Thanks very much for your reply. John's example handles the events
within the class module - which is what I already do. I'm really looking
to bring the events outside of the class module.

The reason for this is that I want to keep my grid generic. It allows
the user to multiselect grid "cells" on mouse down, has methods to
accept arguments to create new objects on the grid and various
parameters (no of cols, width etc.) -- in order that I can just drop it
into other (disparate) applications without having to amend the class
itself and thereby avoiding any customization for individual apps.

The best workaround I've found is to expose a string property,
clsGrid.OnDoubleClick, that is set by the userform instantiating the
class with the name of the procedure to call upon a doubleclick.

e.g.
In Userform :
'code to make grid then:
With GRID
.gCol = etc. etc. etyc.
.OnDoubleClick = Thisworbook & "!" & "Event_GridDoubleClicked"
End With

In my class module I have:
Public OnDoubleClick As String
'loads of other stuff handling selection, mouse moves etc.
Private Sub GridControl_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
DIm myID as Long
myID = fcnGetIDFromXY(X,Y) ' which I know from mouse move traps
Application.Run OnDoubleClick (myID)
End Sub

And then in a standard module I have:

Sub Event_GridDoubleClicked(MyID as Long)
MsgBox "hurray"
myData = ADO_GetRecordFromDB (myID)
GRID.UpdateRecord myData
End Sub


But I don't like passing the function name - it seems a bit messy. And I
have to put the procedure to be run in a standard module also since I
can't get application.run to work with
thisworkbook.name!userform1.procedurename.

I guess neither of these are showstoppers, but it would be nice to keep
everything in its place and not mix up my class code with the userform.
Particularly when I would like to use the grid on two different forms
since they both have different data sources. If I don't use the 'set
OnDoubleClick' method - it would mean I would need to have two almost
identical class modules - or handle the two of them within the one class
module - which doesn't lend itselfeasily to further expansion.

Hence... I'm thinking maybe an OCX is the way to go..?

Thanks again,
Gareth


Tom Ogilvy wrote:
> Sounds like you could adapt this method for your request.
>
> http://www.j-walk.com/ss/excel/tips/tip44.htm
>
> A John Walkenbach's site
>

[Peter T]

Hi Gareth,

I'm sure I'm missing things from your combined posts, could you clarify -

Do you have just the one instance of Class to trap events of your "Large"
label. If so why do you need a separate class.

Or, referring to your first post, do you instanciate classes for each label
hidden under the main large label. If so how do events for these get
triggered. However if this is indeed what you are doing why do you need to
get the XY coordinates to work out the id of the control the mouse is over,
why not set the id to a class level variable at the moment you instanciate
the class.

Why are you using Application.Run to call a procedure within the same
project, and why do you need to pass the name of a procedure as an argument,
instead of say an If-Else or Select Case construct.

What's the problem of the Class(s) not being instanciated until run time.
Typically Withevents class's are set in the form's initialize event just
before the form is activated for the first time.

How/where do you store ref's to your Class(s), an array or collection I
assume if multiple classes. If public in a normal module you can call all
the methods of a class and access it's properties from anywhere, if that's
an issue.

> I can't get application.run to work with
> thisworkbook.name!userform1.procedurename.

Again why application.run and the thisworkbook.name! qualifier. Providing
the proc in the userform is not Private why not simply
userform1.procedurename (arg's).

Regards,
Peter T

"Gareth" <nah> wrote in message
news:#[email protected]...
> Hi Tom,
>
> Thanks very much for your reply. John's example handles the events
> within the class module - which is what I already do. I'm really looking
> to bring the events outside of the class module.
>
> The reason for this is that I want to keep my grid generic. It allows
> the user to multiselect grid "cells" on mouse down, has methods to
> accept arguments to create new objects on the grid and various
> parameters (no of cols, width etc.) -- in order that I can just drop it
> into other (disparate) applications without having to amend the class
> itself and thereby avoiding any customization for individual apps.
>
> The best workaround I've found is to expose a string property,
> clsGrid.OnDoubleClick, that is set by the userform instantiating the
> class with the name of the procedure to call upon a doubleclick.
>
> e.g.
> In Userform :
> 'code to make grid then:
> With GRID
> .gCol = etc. etc. etyc.
> .OnDoubleClick = Thisworbook & "!" & "Event_GridDoubleClicked"
> End With
>
> In my class module I have:
> Public OnDoubleClick As String
> 'loads of other stuff handling selection, mouse moves etc.
> Private Sub GridControl_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
> DIm myID as Long
> myID = fcnGetIDFromXY(X,Y) ' which I know from mouse move traps
> Application.Run OnDoubleClick (myID)
> End Sub
>
> And then in a standard module I have:
>
> Sub Event_GridDoubleClicked(MyID as Long)
> MsgBox "hurray"
> myData = ADO_GetRecordFromDB (myID)
> GRID.UpdateRecord myData
> End Sub
>
>
> But I don't like passing the function name - it seems a bit messy. And I
> have to put the procedure to be run in a standard module also since I
> can't get application.run to work with
> thisworkbook.name!userform1.procedurename.
>
> I guess neither of these are showstoppers, but it would be nice to keep
> everything in its place and not mix up my class code with the userform.
> Particularly when I would like to use the grid on two different forms
> since they both have different data sources. If I don't use the 'set
> OnDoubleClick' method - it would mean I would need to have two almost
> identical class modules - or handle the two of them within the one class
> module - which doesn't lend itselfeasily to further expansion.
>
> Hence... I'm thinking maybe an OCX is the way to go..?
>
> Thanks again,
> Gareth
>
>
> Tom Ogilvy wrote:
> > Sounds like you could adapt this method for your request.
> >
> > http://www.j-walk.com/ss/excel/tips/tip44.htm
> >
> > A John Walkenbach's site
> >

[Gareth]

Hi Peter,

Thanks for replying - I think you're right - my posts haven't been that
clear.

I have just one class - and that's all I want to use, for this part at
least.

The labels hidden under the large label are classless - they have no
events since they never get clicked (they're always underneath).

I want the logic of the control to follow thus:

When double clicked, tell the parent form that it's been doubleclicked
and let the parent form decide what to do with it.

I don't want:
To have the class go off and query the database, populate everything
etc. because that means the class is no longer generic - it's tied into
one application and must be modified for use in another.

Since I can't create an event procedure called MyGrid_DoubleClick in the
userform module I thought I could just set a string in the class called
OnDoubleClick which was the name of a procedure. This works - but only
if the procedure is in a standard module. I can't get it to work with
Userform1.MyProcedureName - whether or not it's Private, not private or
public. Other than that, this solution is acceptable I guess. I just
don't like having it in a standard module.

You're right - I could use an If Else construct but again that means the
Class is not generic.

In case you're still interested (!) I've copied some example code to
demonstrate the direction I'm heading in. It's crude but it works and
can just be copied and pasted into a new workbook without any modifications.

Just run userform1 and make a selection on the grid using left mouse
button and moving it left or right and then right click on it. (I'm
using right click rather than double click for this example.)


Many thanks,
G



'-----IN USERFORM1----------------
Option Explicit
Private Const GRID_START_Y As Integer = 20
Private Const GRID_START_X As Integer = 50
Private Const GRID_ROW_HEIGHT As Integer = 20
Private Const GRID_COL_WIDTH As Integer = 25
Private Const GRID_NO_OF_ROWS As Integer = 10
Private Const GRID_NO_OF_COLS As Integer = 24

Private Sub UserForm_Initialize()
With Me
.Height = 450
.Width = 700
End With
DrawGrid
End Sub

Sub DrawGrid()

Dim lblGrid As MSForms.Label

'Make our main grid label
Set lblGrid = Me.Controls.Add("Forms.Label.1", "GRID", True)

With lblGrid
'size grid control as desired
.Left = GRID_START_X
.Top = GRID_START_Y
.Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT
.Width = GRID_NO_OF_COLS * GRID_COL_WIDTH
End With

'create the grid control
Set GRID.GridControl = lblGrid
'tidy up
Set lblGrid = Nothing

'set parameters for the grid
With GRID
.Start_X = GRID_START_X
.Start_Y = GRID_START_Y
.RowHeight = GRID_ROW_HEIGHT
.ColWidth = GRID_COL_WIDTH
.NoOfRows = GRID_NO_OF_ROWS
.NoOfCols = GRID_NO_OF_COLS
Set .GridParent = Me
'format the grid as per settings
.FormatGridControl

'set the procedure to be called in the event _
'of a right clik on the grid
.OnRightClick = "Event_GridRightClicked"
End With

End Sub

'---------------

'--IN A STANDARD MODULE-------------
Option Explicit
Public GRID As New clsGrid

Sub Event_GridRightClicked()
GRID.CreateBlock "TEST"
End Sub
'---------------

'--IN A CLASS MODULE NAMED clsGrid-------------
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
'-----------------------------------------

[Gareth]

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

[Peter T]

Hi Gareth,

I ran your code and sort of see what you are doing, though not of course how
it relates to your entire project and which parts you want to keep as
generic for use in other projects. So the following may not be relevant.

First, I don't see why you need a Withevents class for just your single
"large" label. The events already exit in the userform. Could pass the XY
coord's of mouse move over the large label to a proc elsewhere, possibly in
a non withevents class to do stuff.

But I don't even see why you need the large label at all. Why not dispense
with that and set multiple instance's of a withevents class to handle events
for each of the grid labels.

In this collection or array of classes you only need to be concerned with
label.left, label.width and the Y coordinate to calc' to draw and resize a
single red label. Eventually user can click that to create the textbox and
remove the temporary red label. Perhaps set an extra instance of the same
labels class to handle the red label, thereby avoiding the necessity to
"name" its click event in code. (in the class click event - If clsLab.name =
varLabelname Then)

Also you could have set whatever unique properties for each label class, as
required for other purposes, when these classes were created.

Regards,
Peter T



"Gareth" <nah> wrote in message
news:[email protected]...
> Hi Peter,
>
> Thanks for replying - I think you're right - my posts haven't been that
> clear.
>
> I have just one class - and that's all I want to use, for this part at
> least.
>
> The labels hidden under the large label are classless - they have no
> events since they never get clicked (they're always underneath).
>
> I want the logic of the control to follow thus:
>
> When double clicked, tell the parent form that it's been doubleclicked
> and let the parent form decide what to do with it.
>
> I don't want:
> To have the class go off and query the database, populate everything
> etc. because that means the class is no longer generic - it's tied into
> one application and must be modified for use in another.
>
> Since I can't create an event procedure called MyGrid_DoubleClick in the
> userform module I thought I could just set a string in the class called
> OnDoubleClick which was the name of a procedure. This works - but only
> if the procedure is in a standard module. I can't get it to work with
> Userform1.MyProcedureName - whether or not it's Private, not private or
> public. Other than that, this solution is acceptable I guess. I just
> don't like having it in a standard module.
>
> You're right - I could use an If Else construct but again that means the
> Class is not generic.
>
> In case you're still interested (!) I've copied some example code to
> demonstrate the direction I'm heading in. It's crude but it works and
> can just be copied and pasted into a new workbook without any
modifications.
>
> Just run userform1 and make a selection on the grid using left mouse
> button and moving it left or right and then right click on it. (I'm
> using right click rather than double click for this example.)
>
>
> Many thanks,
> G
>
>
>
> '-----IN USERFORM1----------------
> Option Explicit
> Private Const GRID_START_Y As Integer = 20
> Private Const GRID_START_X As Integer = 50
> Private Const GRID_ROW_HEIGHT As Integer = 20
> Private Const GRID_COL_WIDTH As Integer = 25
> Private Const GRID_NO_OF_ROWS As Integer = 10
> Private Const GRID_NO_OF_COLS As Integer = 24
>
> Private Sub UserForm_Initialize()
> With Me
> .Height = 450
> .Width = 700
> End With
> DrawGrid
> End Sub
>
> Sub DrawGrid()
>
> Dim lblGrid As MSForms.Label
>
> 'Make our main grid label
> Set lblGrid = Me.Controls.Add("Forms.Label.1", "GRID", True)
>
> With lblGrid
> 'size grid control as desired
> .Left = GRID_START_X
> .Top = GRID_START_Y
> .Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT
> .Width = GRID_NO_OF_COLS * GRID_COL_WIDTH
> End With
>
> 'create the grid control
> Set GRID.GridControl = lblGrid
> 'tidy up
> Set lblGrid = Nothing
>
> 'set parameters for the grid
> With GRID
> .Start_X = GRID_START_X
> .Start_Y = GRID_START_Y
> .RowHeight = GRID_ROW_HEIGHT
> .ColWidth = GRID_COL_WIDTH
> .NoOfRows = GRID_NO_OF_ROWS
> .NoOfCols = GRID_NO_OF_COLS
> Set .GridParent = Me
> 'format the grid as per settings
> .FormatGridControl
>
> 'set the procedure to be called in the event _
> 'of a right clik on the grid
> .OnRightClick = "Event_GridRightClicked"
> End With
>
> End Sub
>
> '---------------
>
> '--IN A STANDARD MODULE-------------
> Option Explicit
> Public GRID As New clsGrid
>
> Sub Event_GridRightClicked()
> GRID.CreateBlock "TEST"
> End Sub
> '---------------
>
> '--IN A CLASS MODULE NAMED clsGrid-------------
> 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
> '-----------------------------------------

[Gareth]

Hi Peter,

Thanks for taking the time to run and examine my code - I really
appreciate it. I've been playing around with a few things following your
response.

You're correct with respect to not needing the events for the large
label -- but I need the events from something: they can't be userform
click events because I have the background labels for the grid which
would cover the userform and thereby block the userform's click events.
So I could use the click events of the background labels - obviously
this would have to be a new class since I don't want to write separate
events for each label - not to mention that the number of labels will
vary depending on the grid size/resolution (not necessarily an issue but
it means some juggling).

Therefore I need to trap the click events on the large form or the
background labels - I don't think it makes that much difference which
one I go for. I opted for the former for aesthetics (it lets me "sink"
the main label giving the impression of a sunken grid - which wouldn't
work for the background labels since it would appear as if each one was
sunk individually. Codewise I think it makes little difference.

I'm using multiple red labels rather than a single one that resizes with
the selection again for aesthetic reasons: I like having the little
blocks for each column - I just think it looks neater. I don't need to
trap an event of clicking on the selection - just clicks off the
selection. I'll have an "insert" button on the form which will allow the
user to replace the selection with a "proper" yellow label to represent
a record (which would be just one label no matter the width). This
wasn't clearly explained earlier - for which I apologize - but the
thrust of my query is how I get events back from a runtime addition of
the class to a form and therefore it's not really relevant.

Again, you're right: this yellow label could well be a class in its own
right. I think this is the road I shall take -- as you say, it allows me
to easily assign it new properties and indeed methods. However, I'm
still stuck with capturing the event in a class module and then having
that event fire a procedure outside the class whether it's in the grid
class or a its own discrete class - I've just moved the problem to a
different class... but I'm sure I can work around it using
application.run etc.

Thanks once again for your help,

Gareth


Peter T wrote:
> Hi Gareth,
>
> I ran your code and sort of see what you are doing, though not of course how
> it relates to your entire project and which parts you want to keep as
> generic for use in other projects. So the following may not be relevant.
>
> First, I don't see why you need a Withevents class for just your single
> "large" label. The events already exit in the userform. Could pass the XY
> coord's of mouse move over the large label to a proc elsewhere, possibly in
> a non withevents class to do stuff.
>
> But I don't even see why you need the large label at all. Why not dispense
> with that and set multiple instance's of a withevents class to handle events
> for each of the grid labels.
>
> In this collection or array of classes you only need to be concerned with
> label.left, label.width and the Y coordinate to calc' to draw and resize a
> single red label. Eventually user can click that to create the textbox and
> remove the temporary red label. Perhaps set an extra instance of the same
> labels class to handle the red label, thereby avoiding the necessity to
> "name" its click event in code. (in the class click event - If clsLab.name =
> varLabelname Then)
>
> Also you could have set whatever unique properties for each label class, as
> required for other purposes, when these classes were created.
>
> Regards,
> Peter T
>
>
>
> "Gareth" <nah> wrote in message
> news:[email protected]...
>
>>Hi Peter,
>>
>>Thanks for replying - I think you're right - my posts haven't been that
>>clear.
>>
>>I have just one class - and that's all I want to use, for this part at
>>least.
>>
>>The labels hidden under the large label are classless - they have no
>>events since they never get clicked (they're always underneath).
>>
>>I want the logic of the control to follow thus:
>>
>>When double clicked, tell the parent form that it's been doubleclicked
>>and let the parent form decide what to do with it.
>>
>>I don't want:
>>To have the class go off and query the database, populate everything
>>etc. because that means the class is no longer generic - it's tied into
>>one application and must be modified for use in another.
>>
>>Since I can't create an event procedure called MyGrid_DoubleClick in the
>>userform module I thought I could just set a string in the class called
>>OnDoubleClick which was the name of a procedure. This works - but only
>>if the procedure is in a standard module. I can't get it to work with
>>Userform1.MyProcedureName - whether or not it's Private, not private or
>>public. Other than that, this solution is acceptable I guess. I just
>>don't like having it in a standard module.
>>
>>You're right - I could use an If Else construct but again that means the
>>Class is not generic.
>>
>>In case you're still interested (!) I've copied some example code to
>>demonstrate the direction I'm heading in. It's crude but it works and
>>can just be copied and pasted into a new workbook without any
>
> modifications.
>
>>Just run userform1 and make a selection on the grid using left mouse
>>button and moving it left or right and then right click on it. (I'm
>>using right click rather than double click for this example.)
>>
>>
>>Many thanks,
>>G
>>
>>
>>
>>'-----IN USERFORM1----------------
>>Option Explicit
>>Private Const GRID_START_Y As Integer = 20
>>Private Const GRID_START_X As Integer = 50
>>Private Const GRID_ROW_HEIGHT As Integer = 20
>>Private Const GRID_COL_WIDTH As Integer = 25
>>Private Const GRID_NO_OF_ROWS As Integer = 10
>>Private Const GRID_NO_OF_COLS As Integer = 24
>>
>>Private Sub UserForm_Initialize()
>> With Me
>> .Height = 450
>> .Width = 700
>> End With
>> DrawGrid
>>End Sub
>>
>>Sub DrawGrid()
>>
>>Dim lblGrid As MSForms.Label
>>
>> 'Make our main grid label
>> Set lblGrid = Me.Controls.Add("Forms.Label.1", "GRID", True)
>>
>> With lblGrid
>> 'size grid control as desired
>> .Left = GRID_START_X
>> .Top = GRID_START_Y
>> .Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT
>> .Width = GRID_NO_OF_COLS * GRID_COL_WIDTH
>> End With
>>
>> 'create the grid control
>> Set GRID.GridControl = lblGrid
>> 'tidy up
>> Set lblGrid = Nothing
>>
>> 'set parameters for the grid
>> With GRID
>> .Start_X = GRID_START_X
>> .Start_Y = GRID_START_Y
>> .RowHeight = GRID_ROW_HEIGHT
>> .ColWidth = GRID_COL_WIDTH
>> .NoOfRows = GRID_NO_OF_ROWS
>> .NoOfCols = GRID_NO_OF_COLS
>> Set .GridParent = Me
>> 'format the grid as per settings
>> .FormatGridControl
>>
>> 'set the procedure to be called in the event _
>> 'of a right clik on the grid
>> .OnRightClick = "Event_GridRightClicked"
>> End With
>>
>>End Sub
>>
>>'---------------
>>
>>'--IN A STANDARD MODULE-------------
>>Option Explicit
>>Public GRID As New clsGrid
>>
>>Sub Event_GridRightClicked()
>> GRID.CreateBlock "TEST"
>>End Sub
>>'---------------
>>
>>'--IN A CLASS MODULE NAMED clsGrid-------------
>>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
>>'-----------------------------------------
>
>
>

[Peter T]

Hi Gareth,

I think it would be much easier to create a collection of withevents class's
for your vertical grid labels, and a separate collection of the same class
for your red-labels.

Keep the large label at the back and make it a tad bigger for aesthetic
reasons.

Just the skeleton of what I have in mind -

'' in Userform1, Drawgrid
' make the large label bigger
With lblGrid
'size grid control as desired
.Left = GRID_START_X - 3
.Top = GRID_START_Y - 3
.Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT + 6
.Width = GRID_NO_OF_COLS * GRID_COL_WIDTH + 6

End With

'' in class GRID

Sub FormatGridControl()
Dim iCol As Integer
Dim myLbl As MSForms.Label 'new
Dim clsLab As clsGrid2 'new
Dim id As Long 'new

'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)

Set clsLab = New clsGrid2
Set clsLab.lbl = myLbl
colLbls.Add clsLab, myLbl.Name
id = id + 1
clsLab.propColID = id


' .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
'' keep the large label at the back so comment .ZOrder
' .ZOrder 0
End With

Set myLbl = Nothing

End Sub

'' in Module1
Public colLbls As New Collection
Public colRedLbls As New Collection

'' a new class named clsGrid2

Public WithEvents lbl As MSForms.Label
Dim nColID As Long
Dim bRedLabel As Boolean

Public Property Let propColID(n As Long)
nColID = n
End Property

Public Property Let propRed(b As Boolean)
'set this flag when adding a red label and adding
'an instance of this class to the red-labels collection
' for use in click & move events
bRedLabel = b
End Property

Private Sub lbl_Click()
If bRedLabel Then
'code
Else
'code
End If
End Sub


Private Sub lbl_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim s As String
s = nColID & " " & lbl.Name
'avoid flicker
If UserForm1.Caption <> s Then UserForm1.Caption = s

' If bRedLabel Then
'' Maybe delete a red label if moving backwards
' Else
'' stuff to add new red label and add new instance of this
'' class to the red labels collection
'' Already got nCol, Position the new red label to
'' lbl.Left, lbl.Width & height constant. Only need to calc Top from
'' this Y coord.
'' Set variables (Public in a normal module or Properties in clsGRID) to
track count and location of red labels.
'End If

End Sub

'' put this in clsGRID
'Public Property Let propMouseDown(b As Boolean)
'blnMouseButtonAlreadyDown = b
'End Property
'Public Property Get propMouseDown() As Boolean
'propMouseDown = blnMouseButtonAlreadyDown
'End Property

Private Sub lbl_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
GRID.propMouseDown = True
End Sub
Private Sub lbl_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
GRID.propMouseDown = False
End Sub

'''''''

Add new red-labels in the mousemove event in clsGrid2 with code similar but
simpler to that what you have in GridControl_MouseMove in clsGRID. Add a new
instance of the same class to the colRedLbls Collection. When creating
instances of clsGrid2 set whatever properties you need, eg columnID, what
type of label, etc.

When deleting the red-labels also Set colRedLbls = Nothing
If you want to delete the red labels from withevent code of a red-label, you
will probably need to call code in another module with OnTime Now.

Although I've suggested two public collections of clsGrid2 in a normal
module, you could instead use the GridBlocks collection you already have in
clsGRID and another similar collection in clsGRID.

I would add yet another class to handle the click event of the Textbox that
gets added. In this 3rd class set whatever properties might needed for when
user clicks to do the "main thing".

I hope you can "read my mind" as to the rest of what I envisage! However if
you can and expand on the above I think you will end up with more
flexibility, as well as easier and portable code.

Regards,
Peter T

"Gareth" <nah> wrote in message
news:[email protected]...
> Hi Peter,
>
> Thanks for taking the time to run and examine my code - I really
> appreciate it. I've been playing around with a few things following your
> response.
>
> You're correct with respect to not needing the events for the large
> label -- but I need the events from something: they can't be userform
> click events because I have the background labels for the grid which
> would cover the userform and thereby block the userform's click events.
> So I could use the click events of the background labels - obviously
> this would have to be a new class since I don't want to write separate
> events for each label - not to mention that the number of labels will
> vary depending on the grid size/resolution (not necessarily an issue but
> it means some juggling).
>
> Therefore I need to trap the click events on the large form or the
> background labels - I don't think it makes that much difference which
> one I go for. I opted for the former for aesthetics (it lets me "sink"
> the main label giving the impression of a sunken grid - which wouldn't
> work for the background labels since it would appear as if each one was
> sunk individually. Codewise I think it makes little difference.
>
> I'm using multiple red labels rather than a single one that resizes with
> the selection again for aesthetic reasons: I like having the little
> blocks for each column - I just think it looks neater. I don't need to
> trap an event of clicking on the selection - just clicks off the
> selection. I'll have an "insert" button on the form which will allow the
> user to replace the selection with a "proper" yellow label to represent
> a record (which would be just one label no matter the width). This
> wasn't clearly explained earlier - for which I apologize - but the
> thrust of my query is how I get events back from a runtime addition of
> the class to a form and therefore it's not really relevant.
>
> Again, you're right: this yellow label could well be a class in its own
> right. I think this is the road I shall take -- as you say, it allows me
> to easily assign it new properties and indeed methods. However, I'm
> still stuck with capturing the event in a class module and then having
> that event fire a procedure outside the class whether it's in the grid
> class or a its own discrete class - I've just moved the problem to a
> different class... but I'm sure I can work around it using
> application.run etc.
>
> Thanks once again for your help,
>
> Gareth
>
>
> Peter T wrote:
> > Hi Gareth,
> >
> > I ran your code and sort of see what you are doing, though not of course
how
> > it relates to your entire project and which parts you want to keep as
> > generic for use in other projects. So the following may not be relevant.
> >
> > First, I don't see why you need a Withevents class for just your single
> > "large" label. The events already exit in the userform. Could pass the
XY
> > coord's of mouse move over the large label to a proc elsewhere, possibly
in
> > a non withevents class to do stuff.
> >
> > But I don't even see why you need the large label at all. Why not
dispense
> > with that and set multiple instance's of a withevents class to handle
events
> > for each of the grid labels.
> >
> > In this collection or array of classes you only need to be concerned
with
> > label.left, label.width and the Y coordinate to calc' to draw and resize
a
> > single red label. Eventually user can click that to create the textbox
and
> > remove the temporary red label. Perhaps set an extra instance of the
same
> > labels class to handle the red label, thereby avoiding the necessity to
> > "name" its click event in code. (in the class click event - If
clsLab.name =
> > varLabelname Then)
> >
> > Also you could have set whatever unique properties for each label class,
as
> > required for other purposes, when these classes were created.
> >
> > Regards,
> > Peter T
> >
> >
> >
> > "Gareth" <nah> wrote in message
> > news:[email protected]...
> >
> >>Hi Peter,
> >>
> >>Thanks for replying - I think you're right - my posts haven't been that
> >>clear.
> >>
> >>I have just one class - and that's all I want to use, for this part at
> >>least.
> >>
> >>The labels hidden under the large label are classless - they have no
> >>events since they never get clicked (they're always underneath).
> >>
> >>I want the logic of the control to follow thus:
> >>
> >>When double clicked, tell the parent form that it's been doubleclicked
> >>and let the parent form decide what to do with it.
> >>
> >>I don't want:
> >>To have the class go off and query the database, populate everything
> >>etc. because that means the class is no longer generic - it's tied into
> >>one application and must be modified for use in another.
> >>
> >>Since I can't create an event procedure called MyGrid_DoubleClick in the
> >>userform module I thought I could just set a string in the class called
> >>OnDoubleClick which was the name of a procedure. This works - but only
> >>if the procedure is in a standard module. I can't get it to work with
> >>Userform1.MyProcedureName - whether or not it's Private, not private or
> >>public. Other than that, this solution is acceptable I guess. I just
> >>don't like having it in a standard module.
> >>
> >>You're right - I could use an If Else construct but again that means the
> >>Class is not generic.
> >>
> >>In case you're still interested (!) I've copied some example code to
> >>demonstrate the direction I'm heading in. It's crude but it works and
> >>can just be copied and pasted into a new workbook without any
> >
> > modifications.
> >
> >>Just run userform1 and make a selection on the grid using left mouse
> >>button and moving it left or right and then right click on it. (I'm
> >>using right click rather than double click for this example.)
> >>
> >>
> >>Many thanks,
> >>G
> >>
> >>
> >>
> >>'-----IN USERFORM1----------------
> >>Option Explicit
> >>Private Const GRID_START_Y As Integer = 20
> >>Private Const GRID_START_X As Integer = 50
> >>Private Const GRID_ROW_HEIGHT As Integer = 20
> >>Private Const GRID_COL_WIDTH As Integer = 25
> >>Private Const GRID_NO_OF_ROWS As Integer = 10
> >>Private Const GRID_NO_OF_COLS As Integer = 24
> >>
> >>Private Sub UserForm_Initialize()
> >> With Me
> >> .Height = 450
> >> .Width = 700
> >> End With
> >> DrawGrid
> >>End Sub
> >>
> >>Sub DrawGrid()
> >>
> >>Dim lblGrid As MSForms.Label
> >>
> >> 'Make our main grid label
> >> Set lblGrid = Me.Controls.Add("Forms.Label.1", "GRID", True)
> >>
> >> With lblGrid
> >> 'size grid control as desired
> >> .Left = GRID_START_X
> >> .Top = GRID_START_Y
> >> .Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT
> >> .Width = GRID_NO_OF_COLS * GRID_COL_WIDTH
> >> End With
> >>
> >> 'create the grid control
> >> Set GRID.GridControl = lblGrid
> >> 'tidy up
> >> Set lblGrid = Nothing
> >>
> >> 'set parameters for the grid
> >> With GRID
> >> .Start_X = GRID_START_X
> >> .Start_Y = GRID_START_Y
> >> .RowHeight = GRID_ROW_HEIGHT
> >> .ColWidth = GRID_COL_WIDTH
> >> .NoOfRows = GRID_NO_OF_ROWS
> >> .NoOfCols = GRID_NO_OF_COLS
> >> Set .GridParent = Me
> >> 'format the grid as per settings
> >> .FormatGridControl
> >>
> >> 'set the procedure to be called in the event _
> >> 'of a right clik on the grid
> >> .OnRightClick = "Event_GridRightClicked"
> >> End With
> >>
> >>End Sub
> >>
> >>'---------------
> >>
> >>'--IN A STANDARD MODULE-------------
> >>Option Explicit
> >>Public GRID As New clsGrid
> >>
> >>Sub Event_GridRightClicked()
> >> GRID.CreateBlock "TEST"
> >>End Sub
> >>'---------------
> >>
> >>'--IN A CLASS MODULE NAMED clsGrid-------------
> >>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
> >>'-----------------------------------------
> >
> >
> >

[Gareth]

Hi Peter,

Wow! OK - that's probably gonna take me a minute or two :-) to fully
digest. But I see where you're heading and it makes a lot of sense.

I'm going to have a play and see how I get on. I'll post back with code
when I get it running well.

That's very good of you to take the time to do this. Thanks a million.

Gareth

Peter T wrote:
> Hi Gareth,
>
> I think it would be much easier to create a collection of withevents class's
> for your vertical grid labels, and a separate collection of the same class
> for your red-labels.
>
> Keep the large label at the back and make it a tad bigger for aesthetic
> reasons.
>
> Just the skeleton of what I have in mind -
>
> '' in Userform1, Drawgrid
> ' make the large label bigger
> With lblGrid
> 'size grid control as desired
> .Left = GRID_START_X - 3
> .Top = GRID_START_Y - 3
> .Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT + 6
> .Width = GRID_NO_OF_COLS * GRID_COL_WIDTH + 6
>
> End With
>
> '' in class GRID
>
> Sub FormatGridControl()
> Dim iCol As Integer
> Dim myLbl As MSForms.Label 'new
> Dim clsLab As clsGrid2 'new
> Dim id As Long 'new
>
> '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)
>
> Set clsLab = New clsGrid2
> Set clsLab.lbl = myLbl
> colLbls.Add clsLab, myLbl.Name
> id = id + 1
> clsLab.propColID = id
>
>
> ' .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
> '' keep the large label at the back so comment .ZOrder
> ' .ZOrder 0
> End With
>
> Set myLbl = Nothing
>
> End Sub
>
> '' in Module1
> Public colLbls As New Collection
> Public colRedLbls As New Collection
>
> '' a new class named clsGrid2
>
> Public WithEvents lbl As MSForms.Label
> Dim nColID As Long
> Dim bRedLabel As Boolean
>
> Public Property Let propColID(n As Long)
> nColID = n
> End Property
>
> Public Property Let propRed(b As Boolean)
> 'set this flag when adding a red label and adding
> 'an instance of this class to the red-labels collection
> ' for use in click & move events
> bRedLabel = b
> End Property
>
> Private Sub lbl_Click()
> If bRedLabel Then
> 'code
> Else
> 'code
> End If
> End Sub
>
>
> Private Sub lbl_MouseMove(ByVal Button As Integer, _
> ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
> Dim s As String
> s = nColID & " " & lbl.Name
> 'avoid flicker
> If UserForm1.Caption <> s Then UserForm1.Caption = s
>
> ' If bRedLabel Then
> '' Maybe delete a red label if moving backwards
> ' Else
> '' stuff to add new red label and add new instance of this
> '' class to the red labels collection
> '' Already got nCol, Position the new red label to
> '' lbl.Left, lbl.Width & height constant. Only need to calc Top from
> '' this Y coord.
> '' Set variables (Public in a normal module or Properties in clsGRID) to
> track count and location of red labels.
> 'End If
>
> End Sub
>
> '' put this in clsGRID
> 'Public Property Let propMouseDown(b As Boolean)
> 'blnMouseButtonAlreadyDown = b
> 'End Property
> 'Public Property Get propMouseDown() As Boolean
> 'propMouseDown = blnMouseButtonAlreadyDown
> 'End Property
>
> Private Sub lbl_MouseDown(ByVal Button As Integer, _
> ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
> GRID.propMouseDown = True
> End Sub
> Private Sub lbl_MouseUp(ByVal Button As Integer, _
> ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
> GRID.propMouseDown = False
> End Sub
>
> '''''''
>
> Add new red-labels in the mousemove event in clsGrid2 with code similar but
> simpler to that what you have in GridControl_MouseMove in clsGRID. Add a new
> instance of the same class to the colRedLbls Collection. When creating
> instances of clsGrid2 set whatever properties you need, eg columnID, what
> type of label, etc.
>
> When deleting the red-labels also Set colRedLbls = Nothing
> If you want to delete the red labels from withevent code of a red-label, you
> will probably need to call code in another module with OnTime Now.
>
> Although I've suggested two public collections of clsGrid2 in a normal
> module, you could instead use the GridBlocks collection you already have in
> clsGRID and another similar collection in clsGRID.
>
> I would add yet another class to handle the click event of the Textbox that
> gets added. In this 3rd class set whatever properties might needed for when
> user clicks to do the "main thing".
>
> I hope you can "read my mind" as to the rest of what I envisage! However if
> you can and expand on the above I think you will end up with more
> flexibility, as well as easier and portable code.
>
> Regards,
> Peter T
>
> "Gareth" <nah> wrote in message
> news:[email protected]...
>
>>Hi Peter,
>>
>>Thanks for taking the time to run and examine my code - I really
>>appreciate it. I've been playing around with a few things following your
>>response.
>>
>>You're correct with respect to not needing the events for the large
>>label -- but I need the events from something: they can't be userform
>>click events because I have the background labels for the grid which
>>would cover the userform and thereby block the userform's click events.
>>So I could use the click events of the background labels - obviously
>>this would have to be a new class since I don't want to write separate
>>events for each label - not to mention that the number of labels will
>>vary depending on the grid size/resolution (not necessarily an issue but
>>it means some juggling).
>>
>>Therefore I need to trap the click events on the large form or the
>>background labels - I don't think it makes that much difference which
>>one I go for. I opted for the former for aesthetics (it lets me "sink"
>>the main label giving the impression of a sunken grid - which wouldn't
>>work for the background labels since it would appear as if each one was
>>sunk individually. Codewise I think it makes little difference.
>>
>>I'm using multiple red labels rather than a single one that resizes with
>>the selection again for aesthetic reasons: I like having the little
>>blocks for each column - I just think it looks neater. I don't need to
>>trap an event of clicking on the selection - just clicks off the
>>selection. I'll have an "insert" button on the form which will allow the
>>user to replace the selection with a "proper" yellow label to represent
>>a record (which would be just one label no matter the width). This
>>wasn't clearly explained earlier - for which I apologize - but the
>>thrust of my query is how I get events back from a runtime addition of
>>the class to a form and therefore it's not really relevant.
>>
>>Again, you're right: this yellow label could well be a class in its own
>>right. I think this is the road I shall take -- as you say, it allows me
>>to easily assign it new properties and indeed methods. However, I'm
>>still stuck with capturing the event in a class module and then having
>>that event fire a procedure outside the class whether it's in the grid
>>class or a its own discrete class - I've just moved the problem to a
>>different class... but I'm sure I can work around it using
>>application.run etc.
>>
>>Thanks once again for your help,
>>
>>Gareth
>>
>>
>>Peter T wrote:
>>
>>>Hi Gareth,
>>>
>>>I ran your code and sort of see what you are doing, though not of course
>
> how
>
>>>it relates to your entire project and which parts you want to keep as
>>>generic for use in other projects. So the following may not be relevant.
>>>
>>>First, I don't see why you need a Withevents class for just your single
>>>"large" label. The events already exit in the userform. Could pass the
>
> XY
>
>>>coord's of mouse move over the large label to a proc elsewhere, possibly
>
> in
>
>>>a non withevents class to do stuff.
>>>
>>>But I don't even see why you need the large label at all. Why not
>
> dispense
>
>>>with that and set multiple instance's of a withevents class to handle
>
> events
>
>>>for each of the grid labels.
>>>
>>>In this collection or array of classes you only need to be concerned
>
> with
>
>>>label.left, label.width and the Y coordinate to calc' to draw and resize
>
> a
>
>>>single red label. Eventually user can click that to create the textbox
>
> and
>
>>>remove the temporary red label. Perhaps set an extra instance of the
>
> same
>
>>>labels class to handle the red label, thereby avoiding the necessity to
>>>"name" its click event in code. (in the class click event - If
>
> clsLab.name =
>
>>>varLabelname Then)
>>>
>>>Also you could have set whatever unique properties for each label class,
>
> as
>
>>>required for other purposes, when these classes were created.
>>>
>>>Regards,
>>>Peter T
>>>
>>>
>>>
>>>"Gareth" <nah> wrote in message
>>>news:[email protected]...
>>>
>>>
>>>>Hi Peter,
>>>>
>>>>Thanks for replying - I think you're right - my posts haven't been that
>>>>clear.
>>>>
>>>>I have just one class - and that's all I want to use, for this part at
>>>>least.
>>>>
>>>>The labels hidden under the large label are classless - they have no
>>>>events since they never get clicked (they're always underneath).
>>>>
>>>>I want the logic of the control to follow thus:
>>>>
>>>>When double clicked, tell the parent form that it's been doubleclicked
>>>>and let the parent form decide what to do with it.
>>>>
>>>>I don't want:
>>>>To have the class go off and query the database, populate everything
>>>>etc. because that means the class is no longer generic - it's tied into
>>>>one application and must be modified for use in another.
>>>>
>>>>Since I can't create an event procedure called MyGrid_DoubleClick in the
>>>>userform module I thought I could just set a string in the class called
>>>>OnDoubleClick which was the name of a procedure. This works - but only
>>>>if the procedure is in a standard module. I can't get it to work with
>>>>Userform1.MyProcedureName - whether or not it's Private, not private or
>>>>public. Other than that, this solution is acceptable I guess. I just
>>>>don't like having it in a standard module.
>>>>
>>>>You're right - I could use an If Else construct but again that means the
>>>>Class is not generic.
>>>>
>>>>In case you're still interested (!) I've copied some example code to
>>>>demonstrate the direction I'm heading in. It's crude but it works and
>>>>can just be copied and pasted into a new workbook without any
>>>
>>>modifications.
>>>
>>>
>>>>Just run userform1 and make a selection on the grid using left mouse
>>>>button and moving it left or right and then right click on it. (I'm
>>>>using right click rather than double click for this example.)
>>>>
>>>>
>>>>Many thanks,
>>>>G
>>>>
>>>>
>>>>
>>>>'-----IN USERFORM1----------------
>>>>Option Explicit
>>>>Private Const GRID_START_Y As Integer = 20
>>>>Private Const GRID_START_X As Integer = 50
>>>>Private Const GRID_ROW_HEIGHT As Integer = 20
>>>>Private Const GRID_COL_WIDTH As Integer = 25
>>>>Private Const GRID_NO_OF_ROWS As Integer = 10
>>>>Private Const GRID_NO_OF_COLS As Integer = 24
>>>>
>>>>Private Sub UserForm_Initialize()
>>>> With Me
>>>> .Height = 450
>>>> .Width = 700
>>>> End With
>>>> DrawGrid
>>>>End Sub
>>>>
>>>>Sub DrawGrid()
>>>>
>>>>Dim lblGrid As MSForms.Label
>>>>
>>>> 'Make our main grid label
>>>> Set lblGrid = Me.Controls.Add("Forms.Label.1", "GRID", True)
>>>>
>>>> With lblGrid
>>>> 'size grid control as desired
>>>> .Left = GRID_START_X
>>>> .Top = GRID_START_Y
>>>> .Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT
>>>> .Width = GRID_NO_OF_COLS * GRID_COL_WIDTH
>>>> End With
>>>>
>>>> 'create the grid control
>>>> Set GRID.GridControl = lblGrid
>>>> 'tidy up
>>>> Set lblGrid = Nothing
>>>>
>>>> 'set parameters for the grid
>>>> With GRID
>>>> .Start_X = GRID_START_X
>>>> .Start_Y = GRID_START_Y
>>>> .RowHeight = GRID_ROW_HEIGHT
>>>> .ColWidth = GRID_COL_WIDTH
>>>> .NoOfRows = GRID_NO_OF_ROWS
>>>> .NoOfCols = GRID_NO_OF_COLS
>>>> Set .GridParent = Me
>>>> 'format the grid as per settings
>>>> .FormatGridControl
>>>>
>>>> 'set the procedure to be called in the event _
>>>> 'of a right clik on the grid
>>>> .OnRightClick = "Event_GridRightClicked"
>>>> End With
>>>>
>>>>End Sub
>>>>
>>>>'---------------
>>>>
>>>>'--IN A STANDARD MODULE-------------
>>>>Option Explicit
>>>>Public GRID As New clsGrid
>>>>
>>>>Sub Event_GridRightClicked()
>>>> GRID.CreateBlock "TEST"
>>>>End Sub
>>>>'---------------
>>>>
>>>>'--IN A CLASS MODULE NAMED clsGrid-------------
>>>>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
>>>>'-----------------------------------------
>>>
>>>
>>>
>
>

[Gareth]

Hi Peter,

I don't know whether you're still monitoring this thread, but on the
offchance you are...

I've rewritten from scratch. I've pasted my code at the bottom of this
post in order that you (or indeed anyone else) can take a look at it for
their own interest. I wouldn't expect you to read it and correct it -
it's merely a courtesy FYI.

I do have a couple of questions though:

(a) I don't understand why you placed the colLbls and colRedLbls
collections in a standard module. It would seem to me this would
preclude running two grids silmultaneously and further more they would
need clearing each time I create a new grid if I run two consecutively.
I've placed them in the clsGrid module. This way they are instantiated
along with the clsGrid. This makes more sense to me BUT... if I've
missed something glaringly obvious then please feel free to shout out!

(b) By using separate labels for each column I now lose the ability to
keep the CurrentRow property updated - which was used to track, well,
the currently selected, or at least last selected, row.
It makes sense to me (and probably you) that this is a property of the
grid (or at least the collection of label columns) rather than of an
individual label column. AFAIK there is no means within VBA of
determining that the label column is "owned" by clsGrid.
Therefore I have created a Parent property for label columns, which is
set to the creating Grid. Therefore when the grid is "Mouse Moved" I can
set and check myLabelColumn.myParent.CurrentRow. Seems to work ok.
Again - does this make sense or am I overlooking something? Is there a
better way of carrying this value from one label column to the other?
(Obviously not in a standard module since this wouldn't support multiple
grids).

Thanks again,
Gareth


To reiterate, this code is an FYI. It's far from finished and there's
no selection functionality implemented yet.

'In Userform1:
'The grid hangs off a frame control - it seems to make sense to
'let me define its approximate location and size at design time.
'So place a fairsized frame of a fairsized userform:

Dim myGrid As New clsGrid

Private Sub UserForm_Initialize()

With myGrid
.StartTime = #8:00:00 AM#
.EndTime = #7:00:00 PM#
.Resolution = #12:15:00 AM#
.RowsCount = 12
.RowsHeight = 20
Set .FrameContainer = Frame1
.CreateGrid
End With

End Sub

'----------------------------
'in clsGrid

Option Explicit

'collections
Public GridColumns As New Collection
Public GridColumnHeaders As New Collection

'define the public properties for a grid
Private GridStartTime As Date
Private GridEndTime As Date
Private GridResolution As Date
Private GridFrame As MSForms.Frame
Private RowCount As Integer
Private RowHeight As Integer

'internal properties
Private ColsPerHour As Integer
Private ColCount As Integer
Private ColWidth As Integer

Private Const TopBorderHeight As Integer = 15
Private Const LeftBorderWidth As Integer = 30

'**DEFINE PROPETIES**
'StartTime
Property Let StartTime(myStartTime As Date)
GridStartTime = myStartTime
End Property
Property Get StartTime() As Date
StartTime = GridStartTime
End Property
'EndTime
Property Let EndTime(myEndTime As Date)
GridEndTime = myEndTime
End Property
Property Get EndTime() As Date
EndTime = GridEndTime
End Property
'Resolution
Property Let Resolution(myResolution As Date)
GridResolution = myResolution
End Property
Property Get Resolution() As Date
Resolution = GridResolution
End Property
'FrameContainer
Property Set FrameContainer(myFrame As MSForms.Frame)
Set GridFrame = myFrame
End Property
Property Get FrameContainer() As MSForms.Frame
Set FrameContainer = GridFrame
End Property
'Number of Rows
Property Let RowsCount(NoOfRows As Integer)
RowCount = NoOfRows
End Property
Property Get RowsCount() As Integer
RowsCount = RowCount
End Property
'Height of Rows
Property Let RowsHeight(HeightOfRows As Integer)
RowHeight = HeightOfRows
End Property
Property Get RowsHeight() As Integer
RowsHeight = RowHeight
End Property

'Initialise our grid
Private Sub Class_Initialize()

End Sub

Sub CreateGrid()

Dim myLbl As MSForms.Label
Dim myCol As clsGridColumn
Dim iCol As Integer

'work out how many columns we have per hour
ColsPerHour = #1:00:00 AM# / GridResolution
ColCount = (GridEndTime - GridStartTime) / GridResolution

'work out the width of each column
ColWidth = (GridFrame.Width - LeftBorderWidth) / ColCount

'add the columns and column headers to the frame
With GridFrame

'now create a label for each column
For iCol = 0 To ColCount - 1
'place a new label on our frame
Set myLbl = .Controls.Add("FORMS.LABEL.1", _
fcnCreateColumnName(iCol))

'position on grid and format as necessary
With myLbl
.Top = TopBorderHeight '+ 1 - make it slightly
'under, so the top borders don't show
.Height = RowCount * RowHeight
.Left = LeftBorderWidth + (iCol * ColWidth)
.Width = ColWidth + 1
.TextAlign = fmTextAlignCenter
.BackColor = RGB(255, 255, 255)
.SpecialEffect = fmSpecialEffectRaised
'black if this is the top of the hour else grey
.BorderColor = IIf(iCol Mod ColsPerHour = 0, _
RGB(0, 0, 0), RGB(200, 200, 200))
.BorderStyle = fmBorderStyleSingle
End With

'make our new class
Set myCol = New clsGridColumn
Set myCol.GRDCOL = myLbl

Set myCol.ParentGrid = Me

'add this label to our collection
GridColumns.Add myCol, myLbl.Name

Next iCol

'create column headers - just one per hour.
For iCol = 0 To (ColCount / ColsPerHour) - 1
'place a new label on our frame
Set myLbl = .Controls.Add("FORMS.LABEL.1", "ColHeader_" & iCol)
'format as required
With myLbl
.Top = 0
.Height = TopBorderHeight + 1
.Left = LeftBorderWidth + iCol * ColWidth * ColsPerHour
.Width = ColWidth * ColsPerHour
.Caption = Format(GridStartTime + _
TimeSerial(iCol, 0, 0), "hh:nn ampm")
.TextAlign = fmTextAlignCenter
.BackColor = RGB(255, 255, 255)
.SpecialEffect = fmSpecialEffectRaised
End With

'add this label to our collection - not that we really need
GridColumnHeaders.Add myCol, myLbl.Name

Next iCol

Set myLbl = Nothing

'let's make sure we have a nice snug fit within the frame,
'we may be slightly under or over depending on the original '
'width of the frame.
.Width = LeftBorderWidth + iCol * ColWidth * ColsPerHour + 2

End With 'GridFrame


End Sub

Private Function fcnCreateColumnName(ColNo As Integer) As String
'just makes the column name - I place it in a function to make
'it easy to update the format later.
fcnCreateColumnName = "BKCol_" & Format(ColNo, "000")
End Function


'--------------------------
'In clsGridColumn

Public WithEvents GridColumn As MSForms.Label
Private myParent As clsGrid

Private CurrentRow As Integer

Property Set ParentGrid(myGrid As clsGrid)
Set myParent = myGrid
End Property
Property Get ParentGrid() As MSForms.Frame
Set ParentGrid = myParent
End Property


Private Sub GridColumn_Click()


End Sub

[Gareth]

And further to this...

This took me by surprise let me tell you. If you use the MouseMove event
with the mouse button down you won't get mouse move events firing for
multiple controls as you pass over them like you do without the mouse
button down. No sir. The event fires continuously until the mouse button
is released. The X/Y values continue to increment outside the boundaries
of the shape (or decrement - becoming negative) until the mouse button
is released.

It's obviously workaround-able - just requires a little calculation.
Quite unexpected though. It's actually getting more complicated than
having one big label now I think.


To see what I mean place 3 labels on a form (make label 3 pretty big)
and insert the following code:
'---------------------------
Private Sub Label1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then Label3.Caption = "label1: " & X & ", " & Y _
& vbCrLf & Label3.Caption

End Sub
Private Sub Label2_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then Label3.Caption = "label2: " & X & ", " & Y _
& vbCrLf & Label3.Caption

End Sub
'---------------------------

Gareth wrote:
> Hi Peter,
>
> I don't know whether you're still monitoring this thread, but on the
> offchance you are...
>
> I've rewritten from scratch. I've pasted my code at the bottom of this
> post in order that you (or indeed anyone else) can take a look at it for
> their own interest. I wouldn't expect you to read it and correct it -
> it's merely a courtesy FYI.
>
> I do have a couple of questions though:
>
> (a) I don't understand why you placed the colLbls and colRedLbls
> collections in a standard module. It would seem to me this would
> preclude running two grids silmultaneously and further more they would
> need clearing each time I create a new grid if I run two consecutively.
> I've placed them in the clsGrid module. This way they are instantiated
> along with the clsGrid. This makes more sense to me BUT... if I've
> missed something glaringly obvious then please feel free to shout out!
>
> (b) By using separate labels for each column I now lose the ability to
> keep the CurrentRow property updated - which was used to track, well,
> the currently selected, or at least last selected, row.
> It makes sense to me (and probably you) that this is a property of the
> grid (or at least the collection of label columns) rather than of an
> individual label column. AFAIK there is no means within VBA of
> determining that the label column is "owned" by clsGrid.
> Therefore I have created a Parent property for label columns, which is
> set to the creating Grid. Therefore when the grid is "Mouse Moved" I can
> set and check myLabelColumn.myParent.CurrentRow. Seems to work ok.
> Again - does this make sense or am I overlooking something? Is there a
> better way of carrying this value from one label column to the other?
> (Obviously not in a standard module since this wouldn't support multiple
> grids).
>
> Thanks again,
> Gareth
>
>
> To reiterate, this code is an FYI. It's far from finished and there's
> no selection functionality implemented yet.
>
> 'In Userform1:
> 'The grid hangs off a frame control - it seems to make sense to
> 'let me define its approximate location and size at design time.
> 'So place a fairsized frame of a fairsized userform:
>
> Dim myGrid As New clsGrid
>
> Private Sub UserForm_Initialize()
>
> With myGrid
> .StartTime = #8:00:00 AM#
> .EndTime = #7:00:00 PM#
> .Resolution = #12:15:00 AM#
> .RowsCount = 12
> .RowsHeight = 20
> Set .FrameContainer = Frame1
> .CreateGrid
> End With
>
> End Sub
>
> '----------------------------
> 'in clsGrid
>
> Option Explicit
>
> 'collections
> Public GridColumns As New Collection
> Public GridColumnHeaders As New Collection
>
> 'define the public properties for a grid
> Private GridStartTime As Date
> Private GridEndTime As Date
> Private GridResolution As Date
> Private GridFrame As MSForms.Frame
> Private RowCount As Integer
> Private RowHeight As Integer
>
> 'internal properties
> Private ColsPerHour As Integer
> Private ColCount As Integer
> Private ColWidth As Integer
>
> Private Const TopBorderHeight As Integer = 15
> Private Const LeftBorderWidth As Integer = 30
>
> '**DEFINE PROPETIES**
> 'StartTime
> Property Let StartTime(myStartTime As Date)
> GridStartTime = myStartTime
> End Property
> Property Get StartTime() As Date
> StartTime = GridStartTime
> End Property
> 'EndTime
> Property Let EndTime(myEndTime As Date)
> GridEndTime = myEndTime
> End Property
> Property Get EndTime() As Date
> EndTime = GridEndTime
> End Property
> 'Resolution
> Property Let Resolution(myResolution As Date)
> GridResolution = myResolution
> End Property
> Property Get Resolution() As Date
> Resolution = GridResolution
> End Property
> 'FrameContainer
> Property Set FrameContainer(myFrame As MSForms.Frame)
> Set GridFrame = myFrame
> End Property
> Property Get FrameContainer() As MSForms.Frame
> Set FrameContainer = GridFrame
> End Property
> 'Number of Rows
> Property Let RowsCount(NoOfRows As Integer)
> RowCount = NoOfRows
> End Property
> Property Get RowsCount() As Integer
> RowsCount = RowCount
> End Property
> 'Height of Rows
> Property Let RowsHeight(HeightOfRows As Integer)
> RowHeight = HeightOfRows
> End Property
> Property Get RowsHeight() As Integer
> RowsHeight = RowHeight
> End Property
>
> 'Initialise our grid
> Private Sub Class_Initialize()
>
> End Sub
>
> Sub CreateGrid()
>
> Dim myLbl As MSForms.Label
> Dim myCol As clsGridColumn
> Dim iCol As Integer
>
> 'work out how many columns we have per hour
> ColsPerHour = #1:00:00 AM# / GridResolution
> ColCount = (GridEndTime - GridStartTime) / GridResolution
>
> 'work out the width of each column
> ColWidth = (GridFrame.Width - LeftBorderWidth) / ColCount
>
> 'add the columns and column headers to the frame
> With GridFrame
>
> 'now create a label for each column
> For iCol = 0 To ColCount - 1
> 'place a new label on our frame
> Set myLbl = .Controls.Add("FORMS.LABEL.1", _
> fcnCreateColumnName(iCol))
>
> 'position on grid and format as necessary
> With myLbl
> .Top = TopBorderHeight '+ 1 - make it slightly
> 'under, so the top borders don't show
> .Height = RowCount * RowHeight
> .Left = LeftBorderWidth + (iCol * ColWidth)
> .Width = ColWidth + 1
> .TextAlign = fmTextAlignCenter
> .BackColor = RGB(255, 255, 255)
> .SpecialEffect = fmSpecialEffectRaised
> 'black if this is the top of the hour else grey
> .BorderColor = IIf(iCol Mod ColsPerHour = 0, _
> RGB(0, 0, 0), RGB(200, 200, 200))
> .BorderStyle = fmBorderStyleSingle
> End With
>
> 'make our new class
> Set myCol = New clsGridColumn
> Set myCol.GRDCOL = myLbl
>
> Set myCol.ParentGrid = Me
>
> 'add this label to our collection
> GridColumns.Add myCol, myLbl.Name
>
> Next iCol
>
> 'create column headers - just one per hour.
> For iCol = 0 To (ColCount / ColsPerHour) - 1
> 'place a new label on our frame
> Set myLbl = .Controls.Add("FORMS.LABEL.1", "ColHeader_" & iCol)
> 'format as required
> With myLbl
> .Top = 0
> .Height = TopBorderHeight + 1
> .Left = LeftBorderWidth + iCol * ColWidth * ColsPerHour
> .Width = ColWidth * ColsPerHour
> .Caption = Format(GridStartTime + _
> TimeSerial(iCol, 0, 0), "hh:nn ampm")
> .TextAlign = fmTextAlignCenter
> .BackColor = RGB(255, 255, 255)
> .SpecialEffect = fmSpecialEffectRaised
> End With
>
> 'add this label to our collection - not that we really need
> GridColumnHeaders.Add myCol, myLbl.Name
>
> Next iCol
>
> Set myLbl = Nothing
>
> 'let's make sure we have a nice snug fit within the frame,
> 'we may be slightly under or over depending on the original '
> 'width of the frame.
> .Width = LeftBorderWidth + iCol * ColWidth * ColsPerHour + 2
>
> End With 'GridFrame
>
>
> End Sub
>
> Private Function fcnCreateColumnName(ColNo As Integer) As String
> 'just makes the column name - I place it in a function to make
> 'it easy to update the format later.
> fcnCreateColumnName = "BKCol_" & Format(ColNo, "000")
> End Function
>
>
> '--------------------------
> 'In clsGridColumn
>
> Public WithEvents GridColumn As MSForms.Label
> Private myParent As clsGrid
>
> Private CurrentRow As Integer
>
> Property Set ParentGrid(myGrid As clsGrid)
> Set myParent = myGrid
> End Property
> Property Get ParentGrid() As MSForms.Frame
> Set ParentGrid = myParent
> End Property
>
>
> Private Sub GridColumn_Click()
>
>
> End Sub

[Peter T]

Hi Gareth,

I'm feeling guilty firstly for having expected you to "read my mind" (my
previous scant notes) and totally forgetting that mousemove doesn't fire
when the button is down. Or rather it does but in a different way!

re your earlier post

> (a) I don't understand why you placed the colLbls and colRedLbls
> collections in a standard module.

- but I did also suggest putting these in your clsGrid

=====================

I shouldn't have tried to work something into your existing code. Following
rewritten from scratch but borrowing some of your code. Draws selection
labels triggered by dragging over the vertical grid labels.

A Userform, a normal module, and two class's named clsGrid & clsGrid2

Drag left or right on the grid. Click the red selection label(s)

'' Userform code
Option Explicit
Private Sub UserForm_Initialize()

With Me
.Height = 300
.Width = 500
End With
Set clsDraw.propForm = Me
clsDraw.DrawLabels
End Sub

Private Sub UserForm_Terminate()
Set clsDraw = Nothing
End Sub
'''''''''''''''''

'' in a normal module
Option Explicit

Public clsDraw As New clsGrid

Sub FormShow()
UserForm1.Show
End Sub
'''''''''''''''''''

'' code in class named "clsGrid"

Option Explicit

Private Const GRID_START_Y As Integer = 20
Private Const GRID_START_X As Integer = 50
Private Const GRID_ROW_HEIGHT As Integer = 20
Private Const GRID_COL_WIDTH As Integer = 25
' change these constants as required
Private Const GRID_NO_OF_ROWS As Integer = 10
Private Const GRID_NO_OF_COLS As Integer = 16

Dim aclsLabs(1 To GRID_NO_OF_COLS) As New clsGrid2
Dim abSelLabs(1 To GRID_NO_OF_COLS) As Boolean

Dim colGridSelection As New Collection

Dim frm As UserForm ' could just use form name
Dim nStartCol As Long
Dim nEndCol As Long
Dim bGotSelection As Boolean
Dim nRow As Long

Public Property Set propForm(uf As UserForm)
Set frm = uf
End Property
Public Property Let propLoc(ngY As Single, nC As Long)

If bGotSelection Then
nEndCol = nC
Else:
If nStartCol = 0 Then nStartCol = nC
nRow = fcnCalculateGridRowFromY(ngY)
End If
End Property
Public Property Get propLocB(nr As Long, nColSt As Long) As Long
If nStartCol < nEndCol Then
propLocB = nStartCol
nColSt = nEndCol
Else
propLocB = nEndCol
nColSt = nStartCol
End If
nr = nRow

End Property


Public Function DrawLabels()
Dim i As Long
Dim lbl As MSForms.Label


Set lbl = frm.Controls.Add("Forms.Label.1", "GRID", True)
'this label only cosmetic, no events
With lbl
.Left = GRID_START_X - 3
.Top = GRID_START_Y - 3
.Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT + 6
.Width = GRID_NO_OF_COLS * GRID_COL_WIDTH + 6
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 0)
.SpecialEffect = fmSpecialEffectSunken
'.BackStyle = fmBackStyleTransparent
End With


For i = 1 To GRID_NO_OF_COLS
Set lbl = frm.Controls.Add("Forms.Label.1", _
"BackDrop_Col" & i, True)
With lbl
.Left = GRID_START_X + (GRID_COL_WIDTH * (i - 1))
.Width = GRID_COL_WIDTH
.Top = GRID_START_Y
.Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(0, 0, 180)
.BackColor = RGB(255, 255, 255)

Set aclsLabs(i).lbl = lbl
aclsLabs(i).propColID = i
End With
Next
End Function


Function fcnAddNewSelectionLabel(nC As Long) As Boolean
Dim myLbl As MSForms.Label
Dim iCol As Integer
Dim sName As String
Dim nStep As Long

If nStartCol > nC Then nStep = -1 Else nStep = 1

For iCol = nStartCol To nC Step nStep

sName = "R" & nRow & "C" & iCol

If Not abSelLabs(iCol) Then
Set myLbl = frm.Controls.Add("Forms.Label.1", _
sName, True)
With myLbl
.Left = GRID_START_X + (iCol - 1) * GRID_COL_WIDTH
.Top = GRID_START_Y + nRow * GRID_ROW_HEIGHT
.Height = GRID_ROW_HEIGHT
.Width = GRID_COL_WIDTH
.BorderStyle = fmBorderStyleSingle
.BorderColor = RGB(200, 0, 0)
.BackColor = RGB(255, 0, 0)
End With

abSelLabs(iCol) = True

colGridSelection.Add New clsGrid2, sName
Set colGridSelection(sName).lbl = myLbl

colGridSelection(sName).propColID = iCol
colGridSelection(sName).propRed = True
bGotSelection = True

End If

Next iCol
nEndCol = iCol - nStep
sName = "Row " & nRow + 1 & " Start-Col " & nStartCol & _
" End-Col " & nEndCol
If UserForm1.Caption <> sName Then UserForm1.Caption = sName

End Function
Function fcnCalculateGridRowFromY(Y As Single) As Integer
fcnCalculateGridRowFromY = CInt(Y / GRID_ROW_HEIGHT - 0.499999)
End Function

Public Function DelSelection()
Dim i As Long
Dim s As String
If bGotSelection Then
For i = colGridSelection.Count To 1 Step -1
s = colGridSelection(i).lbl.Name
Set colGridSelection(i).lbl = Nothing
colGridSelection.Remove i
frm.Controls.Remove s
Next
Set colGridSelection = Nothing
Erase abSelLabs
End If

nStartCol = 0
nRow = 0
nEndCol = 0

bGotSelection = False
End Function
''''''''''''''''''''''''''

'' in a class named "clsGrid2"

Option Explicit
Public WithEvents lbl As MSForms.Label
Dim nColID As Long
Dim bRedLabel As Boolean
Dim Xold As Single

Public Property Let propColID(n As Long)
nColID = n
End Property
Public Property Let propRed(b As Boolean)
bRedLabel = b
End Property

Private Sub lbl_BeforeDragOver( _
ByVal Cancel As MSForms.ReturnBoolean, _
ByVal Data As MSForms.DataObject, _
ByVal X As Single, ByVal Y As Single, _
ByVal DragState As MSForms.fmDragState, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)

If bRedLabel = False Then
clsDraw.fcnAddNewSelectionLabel nColID
End If

Cancel = True
Effect = 1

' use lbl_BeforeDropOrPaste event if need to know when/where
' dragdrop finished & button is up
End Sub

Private Sub lbl_Click()
Dim nC1 As Long, nC2 As Long, nr As Long
Dim s As String
If bRedLabel Then
nC1 = clsDraw.propLocB(nr, nC2)
s = "Row " & nr + 1 & vbCr & "Cols " & nC1 & " to " & nC2
MsgBox s
End If

End Sub

Private Sub lbl_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim MyDataObject As DataObject
Dim Effect As Integer

If Button = 1 And Not bRedLabel Then
clsDraw.DelSelection
clsDraw.propLoc(Y) = nColID

Set MyDataObject = New DataObject
'optional if needed for later
MyDataObject.SetText CStr(nColID)

Effect = MyDataObject.StartDrag
End If

End Sub


I'm not suggesting this works better than what you originally had, however I
think it's adaptable, expandable and portable.

Regards,
Peter T


"Gareth" <nah> wrote in message news:[email protected]...
> And further to this...
>
> This took me by surprise let me tell you. If you use the MouseMove event
> with the mouse button down you won't get mouse move events firing for
> multiple controls as you pass over them like you do without the mouse
> button down. No sir. The event fires continuously until the mouse button
> is released. The X/Y values continue to increment outside the boundaries
> of the shape (or decrement - becoming negative) until the mouse button
> is released.
>
> It's obviously workaround-able - just requires a little calculation.
> Quite unexpected though. It's actually getting more complicated than
> having one big label now I think.
>
>
> To see what I mean place 3 labels on a form (make label 3 pretty big)
> and insert the following code:
> '---------------------------
> Private Sub Label1_MouseMove(ByVal Button As Integer, _
> ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
> If Button = 1 Then Label3.Caption = "label1: " & X & ", " & Y _
> & vbCrLf & Label3.Caption
>
> End Sub
> Private Sub Label2_MouseMove(ByVal Button As Integer, _
> ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
> If Button = 1 Then Label3.Caption = "label2: " & X & ", " & Y _
> & vbCrLf & Label3.Caption
>
> End Sub
> '---------------------------
>
> Gareth wrote:
> > Hi Peter,
> >
> > I don't know whether you're still monitoring this thread, but on the
> > offchance you are...
> >
> > I've rewritten from scratch. I've pasted my code at the bottom of this
> > post in order that you (or indeed anyone else) can take a look at it for
> > their own interest. I wouldn't expect you to read it and correct it -
> > it's merely a courtesy FYI.
> >
> > I do have a couple of questions though:
> >
> > (a) I don't understand why you placed the colLbls and colRedLbls
> > collections in a standard module. It would seem to me this would
> > preclude running two grids silmultaneously and further more they would
> > need clearing each time I create a new grid if I run two consecutively.
> > I've placed them in the clsGrid module. This way they are instantiated
> > along with the clsGrid. This makes more sense to me BUT... if I've
> > missed something glaringly obvious then please feel free to shout out!
> >
> > (b) By using separate labels for each column I now lose the ability to
> > keep the CurrentRow property updated - which was used to track, well,
> > the currently selected, or at least last selected, row.
> > It makes sense to me (and probably you) that this is a property of the
> > grid (or at least the collection of label columns) rather than of an
> > individual label column. AFAIK there is no means within VBA of
> > determining that the label column is "owned" by clsGrid.
> > Therefore I have created a Parent property for label columns, which is
> > set to the creating Grid. Therefore when the grid is "Mouse Moved" I can
> > set and check myLabelColumn.myParent.CurrentRow. Seems to work ok.
> > Again - does this make sense or am I overlooking something? Is there a
> > better way of carrying this value from one label column to the other?
> > (Obviously not in a standard module since this wouldn't support multiple
> > grids).
> >
> > Thanks again,
> > Gareth
> >
> >
> > To reiterate, this code is an FYI. It's far from finished and there's
> > no selection functionality implemented yet.
> >
> > 'In Userform1:
> > 'The grid hangs off a frame control - it seems to make sense to
> > 'let me define its approximate location and size at design time.
> > 'So place a fairsized frame of a fairsized userform:
> >
> > Dim myGrid As New clsGrid
> >
> > Private Sub UserForm_Initialize()
> >
> > With myGrid
> > .StartTime = #8:00:00 AM#
> > .EndTime = #7:00:00 PM#
> > .Resolution = #12:15:00 AM#
> > .RowsCount = 12
> > .RowsHeight = 20
> > Set .FrameContainer = Frame1
> > .CreateGrid
> > End With
> >
> > End Sub
> >
> > '----------------------------
> > 'in clsGrid
> >
> > Option Explicit
> >
> > 'collections
> > Public GridColumns As New Collection
> > Public GridColumnHeaders As New Collection
> >
> > 'define the public properties for a grid
> > Private GridStartTime As Date
> > Private GridEndTime As Date
> > Private GridResolution As Date
> > Private GridFrame As MSForms.Frame
> > Private RowCount As Integer
> > Private RowHeight As Integer
> >
> > 'internal properties
> > Private ColsPerHour As Integer
> > Private ColCount As Integer
> > Private ColWidth As Integer
> >
> > Private Const TopBorderHeight As Integer = 15
> > Private Const LeftBorderWidth As Integer = 30
> >
> > '**DEFINE PROPETIES**
> > 'StartTime
> > Property Let StartTime(myStartTime As Date)
> > GridStartTime = myStartTime
> > End Property
> > Property Get StartTime() As Date
> > StartTime = GridStartTime
> > End Property
> > 'EndTime
> > Property Let EndTime(myEndTime As Date)
> > GridEndTime = myEndTime
> > End Property
> > Property Get EndTime() As Date
> > EndTime = GridEndTime
> > End Property
> > 'Resolution
> > Property Let Resolution(myResolution As Date)
> > GridResolution = myResolution
> > End Property
> > Property Get Resolution() As Date
> > Resolution = GridResolution
> > End Property
> > 'FrameContainer
> > Property Set FrameContainer(myFrame As MSForms.Frame)
> > Set GridFrame = myFrame
> > End Property
> > Property Get FrameContainer() As MSForms.Frame
> > Set FrameContainer = GridFrame
> > End Property
> > 'Number of Rows
> > Property Let RowsCount(NoOfRows As Integer)
> > RowCount = NoOfRows
> > End Property
> > Property Get RowsCount() As Integer
> > RowsCount = RowCount
> > End Property
> > 'Height of Rows
> > Property Let RowsHeight(HeightOfRows As Integer)
> > RowHeight = HeightOfRows
> > End Property
> > Property Get RowsHeight() As Integer
> > RowsHeight = RowHeight
> > End Property
> >
> > 'Initialise our grid
> > Private Sub Class_Initialize()
> >
> > End Sub
> >
> > Sub CreateGrid()
> >
> > Dim myLbl As MSForms.Label
> > Dim myCol As clsGridColumn
> > Dim iCol As Integer
> >
> > 'work out how many columns we have per hour
> > ColsPerHour = #1:00:00 AM# / GridResolution
> > ColCount = (GridEndTime - GridStartTime) / GridResolution
> >
> > 'work out the width of each column
> > ColWidth = (GridFrame.Width - LeftBorderWidth) / ColCount
> >
> > 'add the columns and column headers to the frame
> > With GridFrame
> >
> > 'now create a label for each column
> > For iCol = 0 To ColCount - 1
> > 'place a new label on our frame
> > Set myLbl = .Controls.Add("FORMS.LABEL.1", _
> > fcnCreateColumnName(iCol))
> >
> > 'position on grid and format as necessary
> > With myLbl
> > .Top = TopBorderHeight '+ 1 - make it slightly
> > 'under, so the top borders don't show
> > .Height = RowCount * RowHeight
> > .Left = LeftBorderWidth + (iCol * ColWidth)
> > .Width = ColWidth + 1
> > .TextAlign = fmTextAlignCenter
> > .BackColor = RGB(255, 255, 255)
> > .SpecialEffect = fmSpecialEffectRaised
> > 'black if this is the top of the hour else grey
> > .BorderColor = IIf(iCol Mod ColsPerHour = 0, _
> > RGB(0, 0, 0), RGB(200, 200, 200))
> > .BorderStyle = fmBorderStyleSingle
> > End With
> >
> > 'make our new class
> > Set myCol = New clsGridColumn
> > Set myCol.GRDCOL = myLbl
> >
> > Set myCol.ParentGrid = Me
> >
> > 'add this label to our collection
> > GridColumns.Add myCol, myLbl.Name
> >
> > Next iCol
> >
> > 'create column headers - just one per hour.
> > For iCol = 0 To (ColCount / ColsPerHour) - 1
> > 'place a new label on our frame
> > Set myLbl = .Controls.Add("FORMS.LABEL.1", "ColHeader_" & iCol)
> > 'format as required
> > With myLbl
> > .Top = 0
> > .Height = TopBorderHeight + 1
> > .Left = LeftBorderWidth + iCol * ColWidth * ColsPerHour
> > .Width = ColWidth * ColsPerHour
> > .Caption = Format(GridStartTime + _
> > TimeSerial(iCol, 0, 0), "hh:nn ampm")
> > .TextAlign = fmTextAlignCenter
> > .BackColor = RGB(255, 255, 255)
> > .SpecialEffect = fmSpecialEffectRaised
> > End With
> >
> > 'add this label to our collection - not that we really need
> > GridColumnHeaders.Add myCol, myLbl.Name
> >
> > Next iCol
> >
> > Set myLbl = Nothing
> >
> > 'let's make sure we have a nice snug fit within the frame,
> > 'we may be slightly under or over depending on the original '
> > 'width of the frame.
> > .Width = LeftBorderWidth + iCol * ColWidth * ColsPerHour + 2
> >
> > End With 'GridFrame
> >
> >
> > End Sub
> >
> > Private Function fcnCreateColumnName(ColNo As Integer) As String
> > 'just makes the column name - I place it in a function to make
> > 'it easy to update the format later.
> > fcnCreateColumnName = "BKCol_" & Format(ColNo, "000")
> > End Function
> >
> >
> > '--------------------------
> > 'In clsGridColumn
> >
> > Public WithEvents GridColumn As MSForms.Label
> > Private myParent As clsGrid
> >
> > Private CurrentRow As Integer
> >
> > Property Set ParentGrid(myGrid As clsGrid)
> > Set myParent = myGrid
> > End Property
> > Property Get ParentGrid() As MSForms.Frame
> > Set ParentGrid = myParent
> > End Property
> >
> >
> > Private Sub GridColumn_Click()
> >
> >
> > End Sub

[Gareth]

Hi Peter,

No need to feel guilty! Your code and comments were very useful and
really helped me get my head around all of this.

I really appreciate you taking the time out to tackle the problem. Your
solution is really neat - I love the way the mouse icon changes when
you select or go outside the grid. And it's compact too.

In the meantime I'd made a good start on the grid and got it behaving
pretty much as I wanted so far. I shall upgrade it later to incorporate
your suggestions.

For what it's worth I've made what I've done before seeing your new
version available at:

http://www.garhoo.com/vba/GridPlay.xls

If you fancy having a look there it will save you copying and pasting
code (I don't think there's any benefit to the NG for me to post mine
now). I wouldn't suggest for a minute you trawl through my code but if
you like you could run userform1. It finally looks like it should now -
a bit prettier now I've sized and labeled it properly although it's
still a mess. Things of note:

- Demonstrates multiple grids of differing sizes on the same form.
(No, that's not probably how I would use it in real life!! Just an
interesting exercise...)

- I've placed it in a frame now so (a) when I use it for real I can
position it on the form roughly at design time and then let it size
itself more accurately and (b) I can use it as a holder for all the
labels etc. in addition to the core grid.

- There's a few buttons to zoom in and out / expand and contract the y
axis. Just an experiment - it doesn't work that well yet. I think that's
a can of worms I might leave shut.

- You can replace a selection with a "slot" now. and then select one
of the slots. Doesn't it get exciting?

Clearly there's much to be done, it just requires a bit more work!

Once again, thanks very much for your kind help.

Gareth


Peter T wrote:
> Hi Gareth,
>
> I'm feeling guilty firstly for having expected you to "read my mind" (my
> previous scant notes) and totally forgetting that mousemove doesn't fire
> when the button is down. Or rather it does but in a different way!
>
> re your earlier post
>
>
>>(a) I don't understand why you placed the colLbls and colRedLbls
>>collections in a standard module.
>
>
> - but I did also suggest putting these in your clsGrid
>
> =====================
>
> I shouldn't have tried to work something into your existing code. Following
> rewritten from scratch but borrowing some of your code. Draws selection
> labels triggered by dragging over the vertical grid labels.
>
> A Userform, a normal module, and two class's named clsGrid & clsGrid2
>
> Drag left or right on the grid. Click the red selection label(s)
>
> '' Userform code
> Option Explicit
> Private Sub UserForm_Initialize()
>
> With Me
> .Height = 300
> .Width = 500
> End With
> Set clsDraw.propForm = Me
> clsDraw.DrawLabels
> End Sub
>
> Private Sub UserForm_Terminate()
> Set clsDraw = Nothing
> End Sub
> '''''''''''''''''
>
> '' in a normal module
> Option Explicit
>
> Public clsDraw As New clsGrid
>
> Sub FormShow()
> UserForm1.Show
> End Sub
> '''''''''''''''''''
>
> '' code in class named "clsGrid"
>
> Option Explicit
>
> Private Const GRID_START_Y As Integer = 20
> Private Const GRID_START_X As Integer = 50
> Private Const GRID_ROW_HEIGHT As Integer = 20
> Private Const GRID_COL_WIDTH As Integer = 25
> ' change these constants as required
> Private Const GRID_NO_OF_ROWS As Integer = 10
> Private Const GRID_NO_OF_COLS As Integer = 16
>
> Dim aclsLabs(1 To GRID_NO_OF_COLS) As New clsGrid2
> Dim abSelLabs(1 To GRID_NO_OF_COLS) As Boolean
>
> Dim colGridSelection As New Collection
>
> Dim frm As UserForm ' could just use form name
> Dim nStartCol As Long
> Dim nEndCol As Long
> Dim bGotSelection As Boolean
> Dim nRow As Long
>
> Public Property Set propForm(uf As UserForm)
> Set frm = uf
> End Property
> Public Property Let propLoc(ngY As Single, nC As Long)
>
> If bGotSelection Then
> nEndCol = nC
> Else:
> If nStartCol = 0 Then nStartCol = nC
> nRow = fcnCalculateGridRowFromY(ngY)
> End If
> End Property
> Public Property Get propLocB(nr As Long, nColSt As Long) As Long
> If nStartCol < nEndCol Then
> propLocB = nStartCol
> nColSt = nEndCol
> Else
> propLocB = nEndCol
> nColSt = nStartCol
> End If
> nr = nRow
>
> End Property
>
>
> Public Function DrawLabels()
> Dim i As Long
> Dim lbl As MSForms.Label
>
>
> Set lbl = frm.Controls.Add("Forms.Label.1", "GRID", True)
> 'this label only cosmetic, no events
> With lbl
> .Left = GRID_START_X - 3
> .Top = GRID_START_Y - 3
> .Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT + 6
> .Width = GRID_NO_OF_COLS * GRID_COL_WIDTH + 6
> .BorderStyle = fmBorderStyleSingle
> .BorderColor = RGB(0, 0, 0)
> .SpecialEffect = fmSpecialEffectSunken
> '.BackStyle = fmBackStyleTransparent
> End With
>
>
> For i = 1 To GRID_NO_OF_COLS
> Set lbl = frm.Controls.Add("Forms.Label.1", _
> "BackDrop_Col" & i, True)
> With lbl
> .Left = GRID_START_X + (GRID_COL_WIDTH * (i - 1))
> .Width = GRID_COL_WIDTH
> .Top = GRID_START_Y
> .Height = GRID_NO_OF_ROWS * GRID_ROW_HEIGHT
> .BorderStyle = fmBorderStyleSingle
> .BorderColor = RGB(0, 0, 180)
> .BackColor = RGB(255, 255, 255)
>
> Set aclsLabs(i).lbl = lbl
> aclsLabs(i).propColID = i
> End With
> Next
> End Function
>
>
> Function fcnAddNewSelectionLabel(nC As Long) As Boolean
> Dim myLbl As MSForms.Label
> Dim iCol As Integer
> Dim sName As String
> Dim nStep As Long
>
> If nStartCol > nC Then nStep = -1 Else nStep = 1
>
> For iCol = nStartCol To nC Step nStep
>
> sName = "R" & nRow & "C" & iCol
>
> If Not abSelLabs(iCol) Then
> Set myLbl = frm.Controls.Add("Forms.Label.1", _
> sName, True)
> With myLbl
> .Left = GRID_START_X + (iCol - 1) * GRID_COL_WIDTH
> .Top = GRID_START_Y + nRow * GRID_ROW_HEIGHT
> .Height = GRID_ROW_HEIGHT
> .Width = GRID_COL_WIDTH
> .BorderStyle = fmBorderStyleSingle
> .BorderColor = RGB(200, 0, 0)
> .BackColor = RGB(255, 0, 0)
> End With
>
> abSelLabs(iCol) = True
>
> colGridSelection.Add New clsGrid2, sName
> Set colGridSelection(sName).lbl = myLbl
>
> colGridSelection(sName).propColID = iCol
> colGridSelection(sName).propRed = True
> bGotSelection = True
>
> End If
>
> Next iCol
> nEndCol = iCol - nStep
> sName = "Row " & nRow + 1 & " Start-Col " & nStartCol & _
> " End-Col " & nEndCol
> If UserForm1.Caption <> sName Then UserForm1.Caption = sName
>
> End Function
> Function fcnCalculateGridRowFromY(Y As Single) As Integer
> fcnCalculateGridRowFromY = CInt(Y / GRID_ROW_HEIGHT - 0.499999)
> End Function
>
> Public Function DelSelection()
> Dim i As Long
> Dim s As String
> If bGotSelection Then
> For i = colGridSelection.Count To 1 Step -1
> s = colGridSelection(i).lbl.Name
> Set colGridSelection(i).lbl = Nothing
> colGridSelection.Remove i
> frm.Controls.Remove s
> Next
> Set colGridSelection = Nothing
> Erase abSelLabs
> End If
>
> nStartCol = 0
> nRow = 0
> nEndCol = 0
>
> bGotSelection = False
> End Function
> ''''''''''''''''''''''''''
>
> '' in a class named "clsGrid2"
>
> Option Explicit
> Public WithEvents lbl As MSForms.Label
> Dim nColID As Long
> Dim bRedLabel As Boolean
> Dim Xold As Single
>
> Public Property Let propColID(n As Long)
> nColID = n
> End Property
> Public Property Let propRed(b As Boolean)
> bRedLabel = b
> End Property
>
> Private Sub lbl_BeforeDragOver( _
> ByVal Cancel As MSForms.ReturnBoolean, _
> ByVal Data As MSForms.DataObject, _
> ByVal X As Single, ByVal Y As Single, _
> ByVal DragState As MSForms.fmDragState, _
> ByVal Effect As MSForms.ReturnEffect, _
> ByVal Shift As Integer)
>
> If bRedLabel = False Then
> clsDraw.fcnAddNewSelectionLabel nColID
> End If
>
> Cancel = True
> Effect = 1
>
> ' use lbl_BeforeDropOrPaste event if need to know when/where
> ' dragdrop finished & button is up
> End Sub
>
> Private Sub lbl_Click()
> Dim nC1 As Long, nC2 As Long, nr As Long
> Dim s As String
> If bRedLabel Then
> nC1 = clsDraw.propLocB(nr, nC2)
> s = "Row " & nr + 1 & vbCr & "Cols " & nC1 & " to " & nC2
> MsgBox s
> End If
>
> End Sub
>
> Private Sub lbl_MouseMove(ByVal Button As Integer, _
> ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
> Dim MyDataObject As DataObject
> Dim Effect As Integer
>
> If Button = 1 And Not bRedLabel Then
> clsDraw.DelSelection
> clsDraw.propLoc(Y) = nColID
>
> Set MyDataObject = New DataObject
> 'optional if needed for later
> MyDataObject.SetText CStr(nColID)
>
> Effect = MyDataObject.StartDrag
> End If
>
> End Sub
>
>
> I'm not suggesting this works better than what you originally had, however I
> think it's adaptable, expandable and portable.
>
> Regards,
> Peter T

[Peter T]

Hi Gareth,

Glad it worked and thank you for your kind comments.

A minor mod, in clsGrid2 lbl_MouseMove, could change

clsDraw.DelSelection
to
'if user holds Ctrl - extend previous selection
If Shift <> 2 Then clsDraw.DelSelection

but where to stop...

I like the demo file you uploaded. As you are setting a parent class it
occurs to me could also "RaiseEvents" from the child class to back to
parent. But that's another story.

I had a slight problem running your file in IE. Couldn't save it and closing
IE left me with an invisible instance of Excel, do doubt me missing
something obvious. Any chance you could mail (see below) a zipped copy - I
might nick some of your ideas!

Regards,
Peter T
pmbthornton gmail com


"Gareth" <nah> wrote in message
news:#[email protected]...
> Hi Peter,
>
> No need to feel guilty! Your code and comments were very useful and
> really helped me get my head around all of this.
>
> I really appreciate you taking the time out to tackle the problem. Your
> solution is really neat - I love the way the mouse icon changes when
> you select or go outside the grid. And it's compact too.
>
> In the meantime I'd made a good start on the grid and got it behaving
> pretty much as I wanted so far. I shall upgrade it later to incorporate
> your suggestions.
>
> For what it's worth I've made what I've done before seeing your new
> version available at:
>
> http://www.garhoo.com/vba/GridPlay.xls
>
> If you fancy having a look there it will save you copying and pasting
> code (I don't think there's any benefit to the NG for me to post mine
> now). I wouldn't suggest for a minute you trawl through my code but if
> you like you could run userform1. It finally looks like it should now -
> a bit prettier now I've sized and labeled it properly although it's
> still a mess. Things of note:
>
> - Demonstrates multiple grids of differing sizes on the same form.
> (No, that's not probably how I would use it in real life!! Just an
> interesting exercise...)
>
> - I've placed it in a frame now so (a) when I use it for real I can
> position it on the form roughly at design time and then let it size
> itself more accurately and (b) I can use it as a holder for all the
> labels etc. in addition to the core grid.
>
> - There's a few buttons to zoom in and out / expand and contract the y
> axis. Just an experiment - it doesn't work that well yet. I think that's
> a can of worms I might leave shut.
>
> - You can replace a selection with a "slot" now. and then select one
> of the slots. Doesn't it get exciting?
>
> Clearly there's much to be done, it just requires a bit more work!
>
> Once again, thanks very much for your kind help.
>
> Gareth
>
< snip >

[Gareth]

Hi Peter,

File on the way - with comments. Zip file placed online:

www.garhoo.com\vba\gridplay.zip

Thanks for all your help and input!

Gareth



Peter T wrote:
> Hi Gareth,
>
> Glad it worked and thank you for your kind comments.
>
> A minor mod, in clsGrid2 lbl_MouseMove, could change
>
> clsDraw.DelSelection
> to
> 'if user holds Ctrl - extend previous selection
> If Shift <> 2 Then clsDraw.DelSelection
>
> but where to stop...
>
> I like the demo file you uploaded. As you are setting a parent class it
> occurs to me could also "RaiseEvents" from the child class to back to
> parent. But that's another story.
>
> I had a slight problem running your file in IE. Couldn't save it and closing
> IE left me with an invisible instance of Excel, do doubt me missing
> something obvious. Any chance you could mail (see below) a zipped copy - I
> might nick some of your ideas!
>
> Regards,
> Peter T
> pmbthornton gmail com
>
>
> "Gareth" <nah> wrote in message
> news:#[email protected]...
>
>>Hi Peter,
>>
>>No need to feel guilty! Your code and comments were very useful and
>>really helped me get my head around all of this.
>>
>>I really appreciate you taking the time out to tackle the problem. Your
>>solution is really neat - I love the way the mouse icon changes when
>>you select or go outside the grid. And it's compact too.
>>
>>In the meantime I'd made a good start on the grid and got it behaving
>>pretty much as I wanted so far. I shall upgrade it later to incorporate
>>your suggestions.
>>
>>For what it's worth I've made what I've done before seeing your new
>>version available at:
>>
>>http://www.garhoo.com/vba/GridPlay.xls
>>
>>If you fancy having a look there it will save you copying and pasting
>>code (I don't think there's any benefit to the NG for me to post mine
>>now). I wouldn't suggest for a minute you trawl through my code but if
>>you like you could run userform1. It finally looks like it should now -
>>a bit prettier now I've sized and labeled it properly although it's
>>still a mess. Things of note:
>>
>> - Demonstrates multiple grids of differing sizes on the same form.
>>(No, that's not probably how I would use it in real life!! Just an
>>interesting exercise...)
>>
>> - I've placed it in a frame now so (a) when I use it for real I can
>>position it on the form roughly at design time and then let it size
>>itself more accurately and (b) I can use it as a holder for all the
>>labels etc. in addition to the core grid.
>>
>> - There's a few buttons to zoom in and out / expand and contract the y
>>axis. Just an experiment - it doesn't work that well yet. I think that's
>> a can of worms I might leave shut.
>>
>> - You can replace a selection with a "slot" now. and then select one
>>of the slots. Doesn't it get exciting?
>>
>>Clearly there's much to be done, it just requires a bit more work!
>>
>>Once again, thanks very much for your kind help.
>>
>>Gareth
>>
>
> < snip >
>
>

[Peter T]

Got it - thanks

Regards,
Peter T

"Gareth" <nah> wrote in message
news:[email protected]...
> Hi Peter,
>
> File on the way - with comments. Zip file placed online:
>
> www.garhoo.com\vba\gridplay.zip
>
> Thanks for all your help and input!
>
> Gareth