Re: Get return from form in ActiveX dll

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

frmMB

Yes, that was a remnant from another project where it was needed.

Worked it all round, but now on pressing a button nothing happens:

In Excel:
-------------
-----------------

Normal Module:
---------------------
Sub Test()

Dim MSB As clsMsg
Set MSB = New clsMsg

MSB.LoadMsgBox

End Sub

Class Module:
------------------
Option Explicit
Private WithEvents MB As MsgBoxDLL.clsMsgBox

Public Sub LoadMsgBox()
MsgBoxLoad Application.Hwnd, "prompt", "title", "OK"
End Sub

Private Sub MB_evtButton(strCaption As String)
MsgBox strCaption
End Sub


VB6:
---------
----------

Form:
---------
Option Explicit
Private cMB As clsMsgBox

Private Sub cmdButton1_Click()
'strReturn = cmdButton1.Caption
'cMB.strButtonReturn = cmdButton1.Caption
cMB.RaiseClickEvent cmdButton1.Caption
Unload Me
End Sub

Private Sub Form_Load()
Set cMB = New clsMsgBox
End Sub

Class module:
------------------
Option Explicit
Public Event evtButton(strCaption As String)
Private Const GWL_HWNDPARENT As Long = -8
Private mxlApp As Excel.Application
Private mlXLhWnd As Long
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Property Set ExcelApp(ByRef xlApp As Excel.Application)
Set mxlApp = xlApp
mlXLhWnd = FindWindow(vbNullString, mxlApp.Caption)
End Property

Public Sub RaiseClickEvent(strCaption As String)
RaiseEvent evtButton(strCaption)
End Sub

Public Sub MsgBoxLoad(lHwnd As Long, _
strPrompt As String, _
strTitle As String, _
Optional strButton1 As String = "OK", _
Optional strButton2 As String, _
Optional strButton3 As String, _
Optional strButton4 As String, _
Optional btDefault As Byte = 1, _
Optional lFormColour As Long, _
Optional lLabelColour As Long, _
Optional lButtonColour As Long)

Dim frmMB As frmMsgBox

Set frmMB = New frmMsgBox

Load frmMB
SetWindowLong frmMB.hWnd, GWL_HWNDPARENT, lHwnd
frmMB.Show

End Sub

Private Sub Class_Terminate()
Set mxlApp = Nothing
End Sub


Any further suggestions?


RBS


"Karl E. Peterson" <karl@xxxxxxxx> wrote in message news:%23m2SmIpLGHA.2628@xxxxxxxxxxxxxxxxxxxxxxx
Well, offhand, I don't think you need to be messing with events. Sounds
like they're triggering non-stop. Also, why is frmMB declared Public?
--
Working without a .NET?
http://classicvb.org/


RB Smissaert wrote:
Now got the following code, but get an out of stack space error when
I press a button on the custom MsgBox.
The VB6 form load fine though.


In Excel VBA
-----------------
-------------------

In a normal module:
------------------------

Public Sub LoadMsgBox()
MsgBoxDLL.MsgBoxLoad Application.Hwnd, "prompt", "title", "OK"
End Sub

In a class module called clsMsg:
--------------------------------------------
Option Explicit
Private WithEvents MB As MsgBoxDLL.clsMsgBox

Private Sub MB_evtButton()
MsgBox MB.strButtonReturn
End Sub


In a VB6 ActiveX dll:
--------------------------
------------------------------

In a normal module:
-------------------------

Option Explicit
Public frmMB As frmMsgBox

In a form called frmMsgBox:
-------------------------------------
Option Explicit
Private WithEvents cMB As clsMsgBox

Private Sub cmdButton1_Click()
cMB.strButtonReturn = cmdButton1.Caption
Unload Me
End Sub

Private Sub Form_Load()
Set cMB = New clsMsgBox
End Sub


In a class module called clsMsgBox:
--------------------------------------------
Option Explicit
Option Base 0
Option Compare Binary
Public Event evtButton()
Private strReturn As String
Private Const GWL_HWNDPARENT As Long = -8
Private mxlApp As Excel.Application
Private mlXLhWnd As Long
Private Declare Function FindWindow _
Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong _
Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Property Set ExcelApp(ByRef xlApp As Excel.Application)
Set mxlApp = xlApp
mlXLhWnd = FindWindow(vbNullString, mxlApp.Caption)
End Property

Public Property Get strButtonReturn() As String
strButtonReturn = strReturn
End Property

Property Let strButtonReturn(strReturn As String)
strButtonReturn = strReturn
RaiseEvent evtButton
End Property

Public Sub MsgBoxLoad(lHwnd As Long, _
strPrompt As String, _
strTitle As String, _
Optional strButton1 As String = "OK", _
Optional strButton2 As String, _
Optional strButton3 As String, _
Optional strButton4 As String, _
Optional btDefault As Byte = 1, _
Optional lFormColour As Long, _
Optional lLabelColour As Long, _
Optional lButtonColour As Long)

Set frmMB = New frmMsgBox

strReturn = ""
Load frmMB
SetWindowLong frmMB.hWnd, GWL_HWNDPARENT, lHwnd
frmMB.Show

End Sub

Private Sub Class_Terminate()
Set mxlApp = Nothing
End Sub


Thanks for any assistance in showing me where I am going wrong.


RBS



"Karl E. Peterson" <karl@xxxxxxxx> wrote in message
news:eGgEw0mLGHA.3856@xxxxxxxxxxxxxxxxxxxxxxx
RB Smissaert wrote:
Not sure I buy it

OK, but you can see the benefit in being able to call it from other
projects.

Oh yeah. But that comes with its own drawbacks as well, such as the
need to
maintain binary compatability. It's never clear-cut. Reuse in VBA,
afterall, is as simple as saying "Import File...", eh? (Not that
there aren't "issues" with that, too! Versioning being #1.)
--
Working without a .NET?
http://classicvb.org/




.

Quantcast