個々のコントロールのイベントを捕捉するクラス
ボタン・ラベル・テキストストボックスなど、必要に応じて加除します。
下のクラス C_ObjControl を親とする子クラスです。 クラス名C_Labelとして使っています。フォームのイベントを捕まえて 親クラスのプロシージャを動かしています。
Option Explicit
'********************************************************************
Private WithEvents myLabel As MSForms.Label
Private myParent As C_ObjControl
Private myIndex As Long
'********************************************************************
Private Sub Class_Terminate()
Set myLabel = Nothing
Set myParent = Nothing
End Sub
'--------------------------------------------------------------------
Public Property Let Item(ByRef val As MSForms.Label)
Set myLabel = val
End Property
'--------------------------------------------------------------------
Public Property Get Item() As MSForms.Label
Set Item = myLabel
End Property
'--------------------------------------------------------------------
Public Property Let Parent(ByRef val As Object)
Set myParent = val
End Property
'--------------------------------------------------------------------
Public Property Let Index(ByVal val As Long)
myIndex = val
End Property
'--------------------------------------------------------------------
Public Property Get Index() As Long
Index = myIndex
End Property
'--------------------------------------------------------------------
Public Property Get Self() As Object
Set Self = Me
End Property
'--------------------------------------------------------------------
Private Sub myLabel_Click()
Call myParent.onClick(myIndex)
End Sub
'--------------------------------------------------------------------
Private Sub myLabel_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
Call myParent.onDblClick(myIndex)
End Sub
'--------------------------------------------------------------------
Private Sub myLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call myParent.onMouseMove(myIndex)
End Sub
個々のコントロールのクラスを管理するクラス
子クラス C_Label をコントロールするクラスでクラス名を C_ObjControl として使っています。 ラベルの大きさ配置などを管理して、さらに子クラスのプロシージャを管理しています。
Option Explicit
'*******************************************************************
Private Type Posi
Top As Double
Left As Double
End Type
Public Event Click(ByVal Index As Long)
Public Event DblClick(ByVal Index As Long)
Public Event MouseMove(ByVal Index As Long)
Private Obj() As C_Label
Private DefPosi() As Posi
Private myItems As Object
Private myParent As Object
Private AllRows As Long
Private AllColumns As Long
Private AllTop As Double
Private AllLeft As Double
Private HIntv As Double
Private VIntv As Double
Private LabCount As Long
Private Size As Long
Private PHeight As Double
Private PWidth As Double
Private offrow As Double
Private offcol As Double
'*******************************************************************
Public Property Let Parent(ByRef val As Object)
Set myParent = val
End Property
'--------------------------------------------------------------------
Public Property Get Items() As Object
Set Items = myItems
End Property
'--------------------------------------------------------------------
Public Property Let Rows(ByVal val As Long)
AllRows = val
AllColumns = 0
End Property
'--------------------------------------------------------------------
Public Property Let Columns(ByVal val As Long)
AllColumns = val
AllRows = 0
End Property
'--------------------------------------------------------------------
Public Property Let Top(ByVal val As Double)
AllTop = val
End Property
'--------------------------------------------------------------------
Public Property Let Count(ByVal val As Double)
LabCount = val
End Property
'--------------------------------------------------------------------
Public Property Let Left(ByVal val As Double)
AllLeft = val
End Property
'--------------------------------------------------------------------
Public Property Let HoriIntv(ByVal val As Double)
HIntv = val
End Property
'--------------------------------------------------------------------
Public Property Let VertIntv(ByVal val As Double)
VIntv = val
End Property
'--------------------------------------------------------------------
Public Property Let Height(ByVal val As Double)
PHeight = val
End Property
'--------------------------------------------------------------------
Public Property Get Height() As Double
Height = PHeight
End Property
'--------------------------------------------------------------------
Public Property Let Width(ByVal val As Double)
PWidth = val
End Property
'--------------------------------------------------------------------
Public Property Get Width() As Double
Width = PWidth
End Property
'--------------------------------------------------------------------
Public Property Let FontSize(ByVal val As Long)
Size = val
End Property
'--------------------------------------------------------------------
Private Sub Class_Initialize()
AllRows = 0
AllColumns = 0
AllTop = 0
AllLeft = 0
HIntv = 0
VIntv = 0
PHeight = 0
PWidth = 0
LabCount = 0
Size = 10
End Sub
'--------------------------------------------------------------------
Private Sub Class_Terminate()
Dim I As Long
For I = 1 To UBound(Obj)
Set Obj(I) = Nothing
Next I
Set myParent = Nothing
Set myItems = Nothing
End Sub
'--------------------------------------------------------------------
Public Sub onClick(ByVal Index As Long)
RaiseEvent Click(Index)
End Sub
'--------------------------------------------------------------------
Public Sub onDblClick(ByVal Index As Long)
RaiseEvent DblClick(Index)
End Sub
'--------------------------------------------------------------------
Public Sub onMouseMove(ByVal Index As Long)
RaiseEvent MouseMove(Index)
End Sub
'--------------------------------------------------------------------
Public Sub Init(ByRef Dic As Object)
Dim Ctrl As Control
Dim I As Long
Dim Key As Variant
If Dic.Count > 0 Then
LabCount = Dic.Count
End If
If LabCount = 0 Then
Exit Sub
End If
Set myItems = New Collection
ReDim Obj(1 To Dic.Count)
ReDim DefPosi(1 To Dic.Count)
With myParent
I = 1
'-----
For Each Key In Dic.keys
'-----コントロールの追加
Set Ctrl = .Controls.Add("Forms.Label.1", Dic(Key))
'-----コントロールの整形
With Ctrl
.Visible = True
'.Enabled = False
.Caption = Dic(Key)
If AllRows > 0 Then
.Top = AllTop + ((I - 1) Mod AllRows) * (PHeight + VIntv)
.Left = AllLeft + ((I - 1) \ AllRows) * (PWidth + HIntv)
End If
If AllColumns > 0 Then
.Top = AllTop + ((I - 1) \ AllColumns) * (PHeight + VIntv)
.Left = AllLeft + ((I - 1) Mod AllColumns) * (PWidth + HIntv)
End If
.Font.Size = Size
.Height = PHeight
.Width = PWidth
.SpecialEffect = fmSpecialEffectRaised
DefPosi(I).Top = .Top
DefPosi(I).Left = .Left
End With
'-----コントロールのイベントクラスの作成
Set Obj(I) = New C_Label
With Obj(I)
.Item = Ctrl
.Index = Key
.Parent = Me
End With
myItems.Add Obj(I)
I = I + 1
Next Key
End With
End Sub
'*******************************************************************
Public Sub OffSet(ByVal offtop As Double, _
ByVal offleft As Double)
Dim I As Long
For I = 1 To UBound(Obj)
With Obj(I).Item
.Top = DefPosi(I).Top + offtop
.Left = DefPosi(I).Left + offleft
End With
Next I
End Sub