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