'Public Property Variables
Private mobjInterface As IControl
Private miIndex As Integer
Private msArrayID As String
Private meControlType As ControlTypes
'A list of controls that require support
Private WithEvents mobjButton As CommandButton
Private WithEvents mobjTBox As TextBox
'The types of controls above
Public Enum ControlTypes
ctInvalidType
ctTextBox
ctCommandButton
End Enum
'Remaining declarations are for GUID creation (AddControl Method)
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As String * 1
End Type
Private Declare Function CoCreateGuid _
Lib "ole32.dll" (tGUIDStructure As GUID) As Long
Private Declare Function StringFromGUID2 _
Lib "ole32.dll" (rguid As Any, _
ByVal lpstrClsId As Long, _
ByVal cbMax As Long) As Long
Public Function AddControl(ByRef Frm As Form, _
ByRef CInterface As IControl, _
ByVal ControlType As ControlTypes, _
Optional ByVal ArrayName As String, _
Optional ByVal Index As Integer = -1, Optional Container As Control) As Control
Static bHere As Boolean
If Not bHere Then
bHere = True
Set mobjInterface = CInterface
msArrayID = ArrayName
miIndex = Index
Select Case ControlType
Case ControlTypes.ctTextBox
If Container Is Nothing Then
Set mobjTBox = Frm.Controls.Add("VB.TextBox", "c" & GenateID)
Else
Set mobjTBox = Frm.Controls.Add("VB.TextBox", "c" & GenateID, Container)
End If
meControlType = ctTextBox
Set AddControl = mobjTBox
Case ControlTypes.ctCommandButton
If Container Is Nothing Then
Set mobjButton = Frm.Controls.Add("VB.CommandButton", "c" & GenateID)
Else
Set mobjButton = Frm.Controls.Add("VB.CommandButton", "c" & GenateID, Container)
End If
meControlType = ctCommandButton
Set AddControl = mobjButton
Case Else
meControlType = ctInvalidType
Err.Raise 13
End Select
Else
'Since this method can only be called once, raise an error
Err.Raise 360, "AddControl", "Object Already Loaded"
End If
End Function
Public Property Get ArrayID() As String
ArrayID = msArrayID
End Property
Public Property Get ButtonObject() As CommandButton
'Allows direct access to the commandbutton object
Set ButtonObject = mobjButton
End Property
Public Property Get ControlObject() As Control
'This property gives a way to get generic
'control information without knowing
'the type of control
Select Case meControlType
Case ctCommandButton
Set ControlObject = mobjButton
Case ctTextBox
Set ControlObject = mobjTBox
End Select
End Property
Public Property Get TextBoxObject() As TextBox
'Allows direct access to the textbox object
Set TextBoxObject = mobjTBox
End Property
Public Property Get ControlType() As ControlTypes
ControlType = meControlType
End Property
Public Property Get Index() As Integer
Index = miIndex
End Property
'Overhead code
Private Function GenateID() As String
Const clLen As Long = 50
Dim sGUID As String 'store result here
Dim tGUID As GUID 'get into this structure
Dim bGuid() As Byte 'get formatted string here
Dim lRtn As Long
If CoCreateGuid(tGUID) = 0 Then 'use API to get the GUID
bGuid = String(clLen, 0)
lRtn = StringFromGUID2(tGUID, VarPtr(bGuid(0)), clLen) 'use API to
'Format it
If lRtn > 0 Then 'truncate nulls
sGUID = Mid$(bGuid, 1, lRtn - 1)
End If
'Strip extra stuff off of the GUID
sGUID = Replace(sGUID, "{", "")
sGUID = Replace(sGUID, "}", "")
sGUID = Replace(sGUID, "-", "")
GenateID = sGUID
End If
End Function
Private Sub Class_Terminate()
Set mobjButton = Nothing
Set mobjTBox = Nothing
End Sub
'*************************************
'*****Command Button Events
'*************************************
Private Sub mobjButton_Click()
Call mobjInterface.Click(Me)
End Sub
Private Sub mobjButton_GotFocus()
Call mobjInterface.GotFocus(Me)
End Sub
Private Sub mobjButton_LostFocus()
Call mobjInterface.LostFocus(Me)
End Sub
'*************************************
'*****Textbox Events
'*************************************
Private Sub mobjTBox_Change()
Call mobjInterface.Change(Me)
End Sub
Private Sub mobjTBox_GotFocus()
'Do some stuff to the control before running code in the form
mobjTBox.BackColor = RGB(Rnd * 127, Rnd * 127, Rnd * 127)
mobjTBox.ForeColor = vbWhite
Call mobjInterface.GotFocus(Me)
End Sub
Private Sub mobjTBox_LostFocus()
'Do some stuff to the control before running code in the form
mobjTBox.BackColor = vbWindowBackground
mobjTBox.ForeColor = vbWindowText
Call mobjInterface.LostFocus(Me)
End Sub