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