Class not showing onMouseClick Event - vb.net

I am trying to get onMouseclick event in my Class which I am writing to get user interaction and capture the click on the screen to get the coordinates
The options which I see for m_mouse are Terminate, suspend, Resume and Help only
Might be a simple thing.
More information :
I am trying to get mouseclick in Autodesk Inventor (3D modeling) software application in the drawings interface
Public Class Cls_GetDrawingPickPoint
Private WithEvents m_interaction As Inventor.InteractionEvents
Private WithEvents m_mouse As InteractionEvents
Private m_position As Point2d
Private m_button As MouseButtonEnum
Private m_continue As Boolean
Public Sub New()
End Sub
Public Function GetDrawingPoint(Prompt As String, button As MouseButtonEnum) As Point2d
m_position = Nothing
m_button = button
' Start selection.
m_interaction = g_inventorApplication.CommandManager.CreateInteractionEvents
m_mouse = m_interaction.MouseEvents
m_interaction.StatusBarText = Prompt
m_interaction.Start()
Do While m_continue
g_inventorApplication.UserInterfaceManager.DoEvents()
Loop
m_interaction.Stop()
GetDrawingPoint = m_position
Return GetDrawingPoint
'Debug.Print("GetDrawingPoint: " & GetDrawingPoint.X & "," & GetDrawingPoint.Y)
End Function
Private Sub m_mouse_OnMouseClick(button As MouseButtonEnum, ShiftKeys As ShiftStateEnum, ModelPosition As Point, ViewPosition As Point2d, View As Inventor.View) Handles m_mouse.OnMouseClick
If button = m_button Then
m_position = g_inventorApplication.TransientGeometry.CreatePoint2d(ModelPosition.X, ModelPosition.Y)
Debug.Print(m_position.X & "," & m_position.Y)
End If
m_continue = False
' MsgBox("Mouse clicked: " & m_position.X & "," & m_position.Y)
End Sub
Private Sub m_interaction_OnTerminate() Handles m_interaction.OnTerminate
m_continue = False
m_interaction.Stop()
End Sub
Private Sub m_interaction_OnActivate() Handles m_interaction.OnActivate
m_continue = True
End Sub
End Class

It appears that the actual object is type MouseEvents, which inherits InteractionEvents, and OnMouseDown is a member of that type. The m_mouse field needs to be declared as that type in order to access members of that type.

Related

.NET events not visible/working for use with vb6(vba)?

I have written an vb.net class which I want to make COM-visible for VB6. I have an old application which was developed in VB6, and I am in the process of rewrite it entirely for .net, but in the meantime I need to get this class working and get it usable together with VB6.
All the methods exposed to COM seems to work as they should, but I can't get the event to work with VB6. I have crawled the net for weeks now, and have found a lot of information which have helped me to the point I am now. The problem is when I try to select the class in the dropdown list inside the VB6 IDE, the IDE creates an eventhandler directly(in my case sub tc_Pls_changeprice()). What's strange is that it's not possible for me to select or mark the actual class, and then pick the event from the event dropdown list.
If I doesn't try to select the class first, but select the event directly from the event dropdownlist, I am able to select it(but the name of it is tc_Pls_changeprice, and not Pls_changeprice as I should expect)
If I select it two or more times, the IDE generates new eventhandlers rather than jump into the already created eventhandler.
When I try to put code inside the eventhandler, my vb6 testapplication compiles and run, but the event doesn't fire.
I have attached my .net code and my vb6 testapplication code.
The .dll has been compiled with ComVisible activated, but not register as com-interop(since I need to register the dll on other machines). I register the dll on the host machines with regasm /TLB /codebase option, and the TLB that is generated is located together with the DLL inside same directory as my vb6 source directory.
Duplicate eventhandlers:
This picture shows that its something wrong with the event dropdown event list, and I'm not able to first select the class from the left dropdown list:
Have anybody any ideas of what's wrong?
Here is my .net code for the class:
Imports System.IO.Ports
Imports System.Timers
<Guid("ABEF0C71-17CE-4d38-BEFD-71770E7D50B4")>
<InterfaceType(ComInterfaceType.InterfaceIsDual)>
<ComVisible(True)>
Public Interface Itaxcomm
<DispId(1)> Property commport As String
<DispId(2)> ReadOnly Property taxstatus As String
<DispId(3)> Function open() As Integer
<DispId(4)> Function close() As Integer
<DispId(5)> Sub testevent()
<DispId(6)> Sub Reset()
<DispId(7)> Sub ChangepriceOK()
<DispId(8)> Sub Triggerstartbutton()
<DispId(9)> Sub TaxState()
End Interface
<Guid("A68C5882-21B2-4827-AA0F-A8D6538D1AE3")>
<InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>
<ComVisible(True)>
Public Interface ItaxcommEvents
<DispId(10)> Sub Pls_changeprice()
End Interface
<ComVisible(True)>
<ClassInterface(ClassInterfaceType.None)>
<ComDefaultInterface(GetType(Itaxcomm))>
<ComSourceInterfaces(GetType(ItaxcommEvents))>
<Guid("0F998406-B0CF-440a-8A78-262015480C90")>
<ProgId("Taxcomm.taxcomm")>
Public Class taxcomm
Implements Itaxcomm
Public Status As String
<ComVisible(False)>
Public Delegate Sub pls_changepricedelegate()
Public Event Pls_changeprice As pls_changepricedelegate
Private _comport As String
Private _taxmode As String
Private rxByte(4096) As Byte
Private WithEvents statetimer As New Timer
Private WithEvents sp As New SerialPort
Private Property Itaxcomm_commport As String Implements Itaxcomm.commport
Get
Return _comport
End Get
Set(ByVal value As String)
_comport = value
End Set
End Property
Private ReadOnly Property Itaxcomm_taxstatus As String Implements Itaxcomm.taxstatus
Get
Return _taxmode
End Get
End Property
Private Sub sp_DataReceived(sender As Object, e As SerialDataReceivedEventArgs) Handles sp.DataReceived
Dim s As String = ""
If sp.BytesToRead < 7 Then Exit Sub
sp.Read(rxByte, 0, 7)
For i = 0 To 20
s = s + (rxByte(i).ToString) & " "
Next i
If rxByte(0) = &H48 And rxByte(6) = &H54 And rxByte(5) = (rxByte(0) Xor rxByte(1) Xor rxByte(2) Xor rxByte(3) Xor rxByte(4)) Then
Select Case rxByte(3)
Case 0
Select Case rxByte(4)
Case 0 ''Normal_mode(with tax)
_taxmode = 1
Case 1 ''!Normal_mode(Ex tax)
_taxmode = 0
End Select
Case 1
Select Case rxByte(4)
Case 0 ''Pls_changeprice
RaiseEvent Pls_changeprice()
Case 1
End Select
Case 253
Select Case rxByte(4)
Case 0 ''Buffer overflow
Status = "Tax rx:Buffer overflow"
End Select
Case 255
Select Case rxByte(4)
Case 0
Case 1 ''Command unknown
Status = "Tax rx:Command unknown"
Case 2 ''ERROR_CRC
Status = "Tax rx:ERROR or CRC error"
End Select
End Select
End If
End Sub
Private Sub TestEvent() Implements Itaxcomm.testevent
RaiseEvent Pls_changeprice()
End Sub
Private Sub sp_Disposed(sender As Object, e As EventArgs) Handles sp.Disposed
End Sub
Private Sub sp_ErrorReceived(sender As Object, e As SerialErrorReceivedEventArgs) Handles sp.ErrorReceived
Status = "TAX commerror:" & e.ToString
End Sub
Private Sub Taxstate() Implements Itaxcomm.TaxState
Dim txarray = New Byte() {&H16, &H6, &H63, &H1, &H72, &H54}
sptx(txarray)
End Sub
Public Sub Triggerstartbutton() Implements Itaxcomm.Triggerstartbutton
Dim txarray = New Byte() {&H16, &H6, &H63, &H4, &H77, &H54}
sptx(txarray)
End Sub
Public Sub ChangepriceOK() Implements Itaxcomm.ChangepriceOK
Dim txarray = New Byte() {&H16, &H6, &H63, &H2, &H71, &H54}
sptx(txarray)
End Sub
Public Sub Reset() Implements Itaxcomm.Reset
Dim txarray = New Byte() {&H16, &H6, &H63, &H3, &H70, &H54}
sptx(txarray)
End Sub
Private Sub statetimer_Elapsed(sender As Object, e As ElapsedEventArgs) Handles statetimer.Elapsed
If sp.IsOpen Then Taxstate()
End Sub
Private Sub sptx(a() As Byte)
Do Until sp.BytesToWrite = 0
Loop
sp.Write(a, 0, a.Count)
End Sub
Public Function open() As Integer Implements Itaxcomm.open
Try
sp.BaudRate = 9600
sp.DataBits = 8
sp.Handshake = IO.Ports.Handshake.None
sp.Parity = IO.Ports.Parity.None
sp.RtsEnable = True
sp.ReceivedBytesThreshold = 1
sp.StopBits = IO.Ports.StopBits.One
If _comport <> "" And Not sp.IsOpen Then
sp.PortName = _comport
sp.Open()
statetimer.Interval = 1000
statetimer.Enabled = True
Return 0
Else
Return 1
End If
Catch ex As Exception
Status = "Serialport open:" & Err.Description
Return 1
End Try
End Function
Public Function close() As Integer Implements Itaxcomm.close
Try
If sp.IsOpen Then sp.Close()
statetimer.Enabled = False
Return 0
Catch ex As Exception
Status = "Serialport close:" & Err.Description
Return 1
End Try
End Function
Public Sub New()
MyBase.New()
End Sub
End Class:
and here is my vb6 testapplication code:
Option Explicit
Private WithEvents tc As taxcomm.taxcomm
Private Sub Command1_Click()
On Error GoTo errhandler
tc.Triggerstartbutton
Exit Sub
errhandler:
Text1.Text = Err.Number & Err.Description
End Sub
Private Sub Command2_Click()
On Error GoTo errhandler
tc.Reset
Exit Sub
errhandler:
Text1.Text = Err.Number & Err.Description
End Sub
Private Sub Command3_Click()
tc.testevent
End Sub
Private Sub Form_Load()
On Error GoTo errhandler
Set tc = CreateObject("Taxcomm.taxcomm")
tc.commport = "COM5"
If tc.Open = 0 Then
MsgBox "Active"
Else
MsgBox "Not active"
tc.Close
End If
Exit Sub
errhandler:
MsgBox Err.Number & " " & Err.Description
Resume Next
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
tc.Close
End Sub
Private Sub Form_Terminate()
tc.Close
End Sub
Private Sub tc_Pls_changeprice()
MsgBox "test"
End Sub
Private Sub Timer1_Timer()
On Error GoTo errhandler
Text1.Text = tc.taxstatus
Exit Sub
errhandler:
Text1.Text = Err.Number & Err.Description
tc.Close
End Sub
The .net class and the vb6 testapplication compiles as it should, but it seems to be something wrong with the generation of the TLB(due to something wrong in my .net code) so the event doesn't fire, and/or the exposed event are not correctly registered inside VB6 IDE.
This was originally in a comment, but putting this here to make clear what the answer was:
Surprising as it may sound, I've found that VB6 has some limitations when dealing with underscores in method and event names when doing some more advanced COM component / COM interop type stuff. This was years ago, so I cannot recall what pain point I specifically hit. A bit of a longshot, but just for the heck of it, try to rename you event to avoid the underscore

update listbox in GUI from other classes

I have a listbox on my main vb.net form which I am using to display status messages from the server program I am running. My actual program consists of many different classes (in separate files) and what I would like to be able to do is to call the Sub frm.UpdateList("With Info in Here") from each of the classes to write to the listbox.
If I call the frm.UpdateList or UpdateList from the frm class, it writes to the listbox fine, but if I call it from any other class nothing happens (I don't get an error either).
I have tried with and without making it shared (and changing frm to me) but neither works as I would hope.
Would anyone be able to help me understand why this is not working, I have invoked the item, and it does get added to but just not from a separate class (which is what I need it to do).
Many Thanks!
Private Delegate Sub UpdateListDelegate(ByVal itemName As String)
Public Shared Sub UpdateList(ByVal itemName As String)
If frm.InvokeRequired Then
frm.Invoke(New UpdateListDelegate(AddressOf UpdateList), itemName)
Else
frm.ListBox1.Items.Insert(0, DateTime.Now.ToString & ": " & itemName)
End If
End Sub
Edit: Try 2, with the following thanks to Idle_Mind works on the frm class (frm is the main form and only form) but it still does not write to the listbox when called from other classes (and no errors occur):
Public Shared Sub UpdateList(ByVal itemName As String)
Dim frm As Form = My.Application.ApplicationContext.MainForm
If Not IsNothing(frm) Then
Dim matches() As Control = frm.Controls.Find("ListBox1", True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is ListBox Then
Dim LB As ListBox = DirectCast(matches(0), ListBox)
LB.Invoke(New MethodInvoker(Sub() LB.Items.Insert(0, DateTime.Now.ToString & ": " & itemName)))
End If
End If
End Sub
I have a listbox on my main vb.net form
This will only work on the startup form, and is not really a good design. Consider other approaches as well:
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim soc As New SomeOtherClass
soc.Foo()
End Sub
End Class
Public Class SomeOtherClass
Public Sub Foo()
Dim msg As String = "Hello?!"
Helper.UpdateList(msg) ' <-- You can do this from any class...
End Sub
End Class
Public Class Helper
Public Shared Sub UpdateList(ByVal itemName As String)
Dim frm As Form = My.Application.ApplicationContext.MainForm
If Not IsNothing(frm) Then
Dim matches() As Control = frm.Controls.Find("ListBox1", True)
If matches.Length > 0 AndAlso TypeOf matches(0) Is ListBox Then
Dim LB As ListBox = DirectCast(matches(0), ListBox)
LB.Invoke(New MethodInvoker(Sub() LB.Items.Insert(0, DateTime.Now.ToString & ": " & itemName)))
End If
End If
End Sub
End Class
Other correct approaches, which would require more work on your part, might include:
(1) Pass a reference to your main form into the other classes as you create them. Then those classes can either up the ListBox directly, or possibly call a method in it as suggested by Plutonix. Here's an example of this in action:
Public Class Form1
Public Sub UpdateList(ByVal itemName As String)
ListBox1.Invoke(New MethodInvoker(Sub() ListBox1.Items.Insert(0, DateTime.Now.ToString & ": " & itemName)))
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim soc As New SomeOtherClass(Me)
soc.Foo()
End Sub
End Class
Public Class SomeOtherClass
Private _Main As Form1
Private Sub New()
End Sub
Public Sub New(ByVal MainForm As Form1)
_Main = MainForm
End Sub
Public Sub Foo()
If Not IsNothing(_Main) Then
_Main.UpdateList("Hello?!")
End If
End Sub
End Class
You'd have to modify all of your other classes in a similar fashion so that they can receive an instance of your form.
(2) Make the other classes raise a custom event that the main form subscribes to when those classes are created.

Why does my new form keep moving to the back?

Visual Basic .NET using Visual Studio 2013
I have a form that I open from another form, but when I do, it always goes behind the form that opened it. Al code that passes to the new form, gets passed before the form.Show().
Here is the code that opens the new form.
Private Sub OpenContentWindow(strNewNavigation As String)
Dim newContent As New FContent
newContent.SetIETMPath(strIETMPath)
newContent.SetIETMName(strIETMName)
newContent.SetIETMMan(strNewNavigation)
newContent.SetIETMIcon(strIETMIcon)
newContent.SetPageToLaunch(strNewNavigation)
newContent.Show()
End Sub
Here is the code from the new form.
Public Class FContent
#Region "Variables/Class Instances"
Private logger As New CDataLogger
Private pathing As New CPaths
Private annotes As New CAnnotes
Private mouser As New CMouse
Private strIETMPath As String
Private strIETMName As String
Private strIETMMan As String
Private strIETMIcon As String
Private strPageToLaunch As String
#End Region
#Region "Load Sub Routines"
' Form Load
Private Sub FContent_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Text = strIETMName
Me.Icon = New System.Drawing.Icon(strIETMIcon)
StartNavigation(strPageToLaunch)
End Sub
' Just pass in the file you want to view
Public Sub StartNavigation(strFileToNavigate As String)
StartNavigation(strFileToNavigate, True)
End Sub
' Just pass in the file you want to view ( if a manual change it will load TOCs also )
Public Sub StartNavigation(strFileToNavigate As String, blnManual As Boolean)
If blnManual Then
wbContent.Navigate(New Uri(strIETMPath & strFileToNavigate))
wbTOC.Navigate(New Uri(strIETMPath & strIETMMan & "\toc.html"))
wbLOF.Navigate(New Uri(strIETMPath & strIETMMan & "\lof.html"))
wbLOT.Navigate(New Uri(strIETMPath & strIETMMan & "\lot.html"))
wbLOC.Navigate(New Uri(strIETMPath & strIETMMan & "\loc.html"))
Else
wbContent.Navigate(New Uri(strIETMPath & strFileToNavigate))
End If
End Sub
#End Region
#Region "Set Sub Routines"
' Set IETM Path
Public Sub SetIETMPath(strNewIETM As String)
strIETMPath = strNewIETM
End Sub
' Set IETM Name
Public Sub SetIETMName(strNewIETM As String)
strIETMName = strNewIETM
End Sub
' Set IETM Manual
Public Sub SetIETMMan(strNewIETM As String)
strIETMMan = strNewIETM.Substring(0, strNewIETM.IndexOf("/"))
End Sub
' Set IETM Icon
Public Sub SetIETMIcon(strNewIETM As String)
strIETMIcon = strNewIETM
End Sub
' Set Page To Launch
Public Sub SetPageToLaunch(strNewPage As String)
strPageToLaunch = strNewPage
End Sub
#End Region
The easiest way to ensure the display above the calling form is to set the Owner property of the called form to the instance of the calling form.
So, supposing that this OpenContentWindow method is inside the class code of the form that want to create the instance of an FContent you could call the Show method passing the reference to the current form instance
Private Sub OpenContentWindow(strNewNavigation As String)
Dim newContent As New FContent
newContent.SetIETMPath(strIETMPath)
newContent.SetIETMName(strIETMName)
newContent.SetIETMMan(strNewNavigation)
newContent.SetIETMIcon(strIETMIcon)
newContent.SetPageToLaunch(strNewNavigation)
newContent.Show(Me)
End Sub
In the link above (MSDN) you could read
When a form is owned by another form, it is closed or hidden with the
owner form. For example, consider a form named Form2 that is owned by
a form named Form1. If Form1 is closed or minimized, Form2 is also
closed or hidden. Owned forms are also never displayed behind their
owner form. You can use owned forms for windows such as find and
replace windows, which should not disappear when the owner form is
selected. To determine the forms that are owned by a parent form, use
the OwnedForms property.
Did you try "newContent.BringToFront()" after newContent.Show () or newContent.TopMost =true ?

Parse Control name to Variable name

I have a var called as "Cheat_Enabled":
Dim Cheat_Enabled As Boolean
And a Checkbox called as "CheckBox_Cheat" with the tag "Cheat"
Now I want to do a dynamic method to change the value of the var by spliting (or something) the name of the control.
For example, something like this (the code obviouslly don't work):
Private Sub CheckBoxes_CheckedChanged(sender As Object, e As EventArgs) Handles _
CheckBox_Cheat.CheckedChanged
Dim SenderVarEquivalent As Object = _
Me.variables.Find(sender.Tag & "_Enabled")(0)
If sender.Checked Then SenderVarEquivalent = True _
Else SenderVarEquivalent = False
End Sub
' Info:
' Sender.Tag = "Cheat"
' Sender.Name = "CheckBox_Cheat"
' VariableName = "Cheat_Enabled"
I think this can be done with one CType or DirectCast or GetObject but I don't know exactly how to do it.
UPDATE:
This is a similar easy code but instead of converting ControlName to VariableName it is converting the control tag to the ControlName Object of the Checkbox:
Public Class Form1
Dim Cheat_Enabled As Boolean = True
Private Sub CheckBox_Cheat_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox_Cheat.CheckedChanged
CType(Controls("CheckBox" & "_" & sender.tag), CheckBox).Checked = Cheat_Enabled
End Sub
End Class
I hope if I can do the same to CType the control name to catch the variablename and use it, for example like this:
Dim Cheat_Enabled As Boolean
Private Sub CheckBox_Cheat_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox_Cheat.CheckedChanged
' Sender.name is : "CheckBox_Cheat"
' Sender.tag is : "Cheat"
' Variable name is: "Cheat_Enabled"
If sender.checked Then
CType(Variable(sender.tag & "_Enabled"), Boolean) = True
Else
CType(Variable(sender.tag & "_Enabled"), Boolean) = False
End If
End Sub
In MSDN you can find a VB.Net example how to enumerate all members of a given class:
Imports System
Imports System.Reflection
Imports Microsoft.VisualBasic
Class MyFindMembersClass
Public Shared Sub Main()
Dim objTest As New Object()
Dim objType As Type = objTest.GetType()
Dim arrayMemberInfo() As MemberInfo
Try
'Find all static or public methods in the Object
'class that match the specified name.
arrayMemberInfo = objType.FindMembers(MemberTypes.Method, _
BindingFlags.Public Or BindingFlags.Static _
Or BindingFlags.Instance, _
New MemberFilter(AddressOf DelegateToSearchCriteria), _
"ReferenceEquals")
Dim index As Integer
For index = 0 To arrayMemberInfo.Length - 1
Console.WriteLine("Result of FindMembers -" + ControlChars.Tab + _
arrayMemberInfo(index).ToString() + ControlChars.Cr)
Next index
Catch e As Exception
Console.WriteLine("Exception : " + e.ToString())
End Try
End Sub 'Main
Public Shared Function DelegateToSearchCriteria _
(ByVal objMemberInfo As MemberInfo, _
ByVal objSearch As Object) As Boolean
' Compare the name of the member function with the filter criteria.
If objMemberInfo.Name.ToString() = objSearch.ToString() Then
Return True
Else
Return False
End If
End Function 'DelegateToSearchCriteria
End Class 'MyFindMembersClass
Another alternative would be to put all your boolean variables into one Dictionary object. This would allow you to access the boolean values "by name" without using Reflection.
Example for illustration:
Imports System.Collections.Generic
Module vbModule
Class Example
Private _dictionary
Public Sub New()
' Allocate and populate the field Dictionary.
Me._dictionary = New Dictionary(Of String, Boolean)
Me._dictionary.Add("v1", False)
Me._dictionary.Add("v2", True)
End Sub
Public Function GetValue(name as String) As Boolean
' Return value from private Dictionary.
Return Me._dictionary.Item(name)
End Function
Public Sub SetValue(name as String, val as Boolean)
Me._dictionary.Item(name) = val
End Sub
End Class
Sub Main()
' Allocate an instance of the class.
Dim example As New Example
' Write a value from the class.
Console.WriteLine(example.GetValue("v1"))
Console.WriteLine(example.GetValue("v2"))
example.SetValue("v1", true)
Console.WriteLine(example.GetValue("v1"))
End Sub
End Module

Programmatically adding a commandbutton to a userform

In excel vba I have added a commandbutton to userform... like below
Set ctrl = Me.Controls.Add( _
bstrProgID:="Forms.CommandButton.1", _
Name:="CommandButton1", Visible:=True)
Now I wanted to know how would I tell it what to do when it is clicked?
This is one of those techniques that vba will let you do, but you probably shouldn't. For all the same reasons you shouldn't use code that alters your code.
That said, here is how to do what you want. First insert a class module and name it DynBtn, then paste this code into it:
Private WithEvents mobjBtn As MSForms.CommandButton
Private msOnAction As String
''// This has to be generic or call by name won't be able to find the methods
''// in your form.
Private mobjParent As Object
Public Property Get Object() As MSForms.CommandButton
Set Object = mobjBtn
End Property
Public Function Load(ByVal parentFormName As Object, ByVal btn As MSForms.CommandButton, ByVal procedure As String) As DynBtn
Set mobjParent = parentFormName
Set mobjBtn = btn
msOnAction = procedure
Set Load = Me
End Function
Private Sub Class_Terminate()
Set mobjParent = Nothing
Set mobjBtn = Nothing
End Sub
Private Sub mobjBtn_Click()
CallByName mobjParent, msOnAction, VbMethod
End Sub
Now to use this in your form, create a blank user form and paste this code into it:
Private Const mcsCmdBtn As String = "Forms.CommandButton.1"
Private mBtn() As DynBtn
Private Sub UserForm_Initialize()
Dim i As Long
ReDim mBtn(1) As DynBtn
For i = 0 To UBound(mBtn)
Set mBtn(i) = New DynBtn
Next
''// One Liner
mBtn(0).Load(Me, Me.Controls.Add(mcsCmdBtn, "Btn1", True), "DoSomething").Object.Caption = "Test 1"
''// Or using with block.
With mBtn(1).Load(Me, Me.Controls.Add(mcsCmdBtn, "Btn2", True), "DoSomethingElse").Object
.Caption = "Test 2"
.Top = .Height + 10
End With
End Sub
Public Sub DoSomething()
MsgBox "It Worked!"
End Sub
Public Sub DoSomethingElse()
MsgBox "Yay!"
End Sub
Private Sub UserForm_Terminate()
Erase mBtn
End Sub