VBA: WithEvents puzzle - events

I have a UserForm, xForm, that is being instantiated in a class module (let's say TestClass) as:
'TestClass
Dim Form as New xForm
Private WithEvents EvForm as MSForms.UserForm
Set EvForm = Form
At the class module of the xForm itself I have some code that must be executed on Form Closing, ONLY if the form actually closes:
'xForm class module
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Do some cleanup, otherwise the app would hang
'If not closing, don't cleanup anything, otherwise the app would hang
End Sub
The QueryClose event is also treated in TestClass, and could avoid the form from closing:
'TestClass
Private Sub EvForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Verify if closing is allowed based on User Control values
Cancel = Not ClosingIsAllowed '<-- Pseudocode on the right side of "="
End Sub
How can I test for Cancel = True, set in TestClass, in the xForm class module?
Let's rephrase it: If Cancel is set to True in TestClass, I must not do the cleanup code in the xForm class module. How can I accomplish that?
Until now, I have thought off of implementing another event in the xForm class (My_QueryClose?) and raise it on the QueryClose event. Outside the Code Behind Form I would deal only with the My_QueryClose event, so taking full control over what is happening. Is this a viable/better approach?

Can't make heads or tails of your custom event idea, but the way to get one class to talk to another (form or anything else, doesn't matter) is to link them up; here's a clean example:
Basic TestClass holds form object (no events needed here, let the form handle that)
'TestClass code
Private MyForm As UserForm
Private mbleCanClose As Boolean
Public Property Get CanClose() As Boolean
CanClose = mbleCanClose
End Property
Public Property Let CanClose(pbleCanClose As Boolean)
mbleCanClose = pbleCanClose
End Property
Public Property Get MyFormProp() As UserForm1
Set MyFormProp = MyForm
End Property
Add a custom object and property to the form itself
'UserForm1 code
Private mParent As TestClass
Public Property Get Parent() As TestClass
Set Parent = mParent
End Property
Public Property Set Parent(pParent As TestClass)
Set mParent = pParent
End Property
Invoking the form on TestClass creation looks like this:
'TestClass code
Private Sub Class_Initialize()
Set MyForm = New UserForm1
Load MyForm
Set MyForm.Parent = Me
End Sub
And then when it's time to close the form, you check whether you can:
'UserForm1 code
Public Function WillMyParentLetMeClose() As Boolean
If Not (mParent Is Nothing) Then
WillMyParentLetMeClose = mParent.CanClose
End If
End Function
Private Sub CommandButton1_Click()
If WillMyParentLetMeClose = True Then
Unload Me
End If
End Sub
Here's what it would like to invoke
'standard module code
Public Sub Test_TestClass()
Dim myclass As TestClass
Set myclass = New TestClass
myclass.MyFormProp.Show
End Sub

A work around declaring another event
The code bellow do what I was expecting, although it is not as neat as I wish it could be.
In the UserForm1 code:
'***** UserForm1
Public Event MyQueryClose(ByRef Cancel As Integer, ByRef CloseMode As Integer, ByRef Status As String)
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim Status As String
Cancel = True
Status = "QueryClose"
Debug.Print "Entered QueryClose"
Debug.Print "Cancel = " & Cancel
Debug.Print "Status = " & Status
Debug.Print "Just before raising MyQueryClose"
RaiseEvent MyQueryClose(Cancel, CloseMode, Status)
Debug.Print "Just got back from MyQueryClose"
Debug.Print "Cancel = " & Cancel
Debug.Print "Status = " & Status
End Sub
In the Class1 code:
'***** Class1
Dim UserForm As New UserForm1
Private WithEvents UF As UserForm1
Sub DoIt()
Set UF = UserForm
UserForm.Show
End Sub
Private Sub UF_MyQueryClose(Cancel As Integer, CloseMode As Integer, Status As String)
Debug.Print "Just entered MyQueryClose"
Cancel = False
Status = "MY QueryClose"
End Sub
In a basic module, to test the Class:
'***** Basic module
Sub TestClass()
Dim C As New Class1
C.DoIt
End Sub
And here's the end result (debug window):
TestClass
Entered QueryClose
Cancel = -1
Status = QueryClose
Just before raising MyQueryClose
Just entered MyQueryClose
Just got back from MyQueryClose
Cancel = 0
Status = MY QueryClose

Related

show confirm close message in all project forms vb.net?

I have Project containing multi forms
main page and others inside main page
used next code to make confirm close in main page
Public Sub MyForm_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles MyBase.FormClosing
If MessageBox.Show("Do you want to close the form?", "Confirm", MessageBoxButtons.YesNo) <> DialogResult.Yes Then
e.Cancel = True
End If
End Sub
and want the confirm message to show in all forms not only main page !
Here is a process I use because MessageBox while it is nice I like to design my own.
You will see some variables in the code that look like this
Public gvalertType As String
Public gvRESEdit As String
These are declared in a Module
Now we need some code for the frmAlert You will use If and ElseIf to trap multiple errors. I will post a screen shot of the frmAlert
Private Sub frmAlert_Load(sender As Object, e As EventArgs) Handles MyBase.Load
If gvalertType = "10" Then
btnNO.Visible = True
lblAI.Text = " Caution "
tbAlert.Text = "OK To Delete " & vbCrLf & vbCrLf & "NO Do NOT Delete"
End If
End Sub
Private Sub btnOK_Click(sender As Object, e As EventArgs) Handles btnOK.Click
If btnNO.Visible = True Then
gvRESDelete = "YES"
End If
Close()
End Sub
Private Sub btnNO_Click(sender As Object, e As EventArgs) Handles btnNO.Click
gvRESDelete = "NO"
Close()
End Sub
OK Now on the form and button click that calls the frmAlert.
Because you are changing forms this is why the variables are declared in a Module.
Private Sub btnDelete_Click(sender As Object, e As EventArgs) Handles btnDelete.Click
gvalertType = "10"
frmAlert.ShowDialog()
If gvRESDelete = "NO" Then
btnBack.Focus()
Return
End If
If gvRESDelete = "YES" Then
DeleteSiteData()
End If
End Sub

VB6 How to return a string value from form2 to form 1

in my project there are two forms:
first form i named it frmSettings , i will use text boxes to save values in INI file.
second form i named it frmSelectFolder , i had included with DirListBox and 2 Command buttons
as shown in attached image above in Settings form i have 8 text boxes and 8 command buttons to browse for folder path that it will be selected from frmSelectFolder
how to use frmSelectFolder for all text boxes without duplicating this form per each command button to return DirlistBox Control value ?
Here is some sample code for secondary frmSelectFolder form
Option Explicit
Private m_bConfirm As Boolean
Public Function Init(sPath As String) As Boolean
Dir1.Path = sPath
Show vbModal
If m_bConfirm Then
sPath = Dir1.Path
'--- success
Init = True
End If
Unload Me
End Function
Private Sub cmdOk_Click()
If LenB(Dir1.Path) = 0 Then
MsgBox "Please select a path!", vbExclamation
Exit Sub
End If
m_bConfirm = True
Visible = False
End Sub
Private Sub cmdCancel_Click()
Visible = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode <> vbFormCode Then
Cancel = 1
Visible = False
End If
End Sub
Here is how to call Init method above from primary frmSettings
Option Explicit
Private Sub cmdStartupPath_Click()
Dim sPath As String
Dim oFrmSelector As New frmSelectFolder
sPath = txtStartupPath.Text
If oFrmSelector.Init(sPath) Then
txtStartupPath.Text = sPath
txtStartupPath.SetFocus
End If
End Sub
Private Sub cmdDownloadPath_Click()
Dim sPath As String
Dim oFrmSelector As New frmSelectFolder
sPath = txtDownloadPath.Text
If oFrmSelector.Init(sPath) Then
txtDownloadPath.Text = sPath
txtDownloadPath.SetFocus
End If
End Sub
Here is a link to a complete sample project for you to research: SelectFolder.zip

VBA Custom Event Not Found when Raised in UserForm

I was following this MSDN guide on creating custom events. I feel like I understand the process now, but I cannot figure out why I am getting a Compile Error: Event Not Found for RaiseEvent ItemAdded. The weird thing is, the ItemAdded event is recognized by the IDE (I can type it in all lowercase and it is then automatically formatted properly), so I know that it is recognized by VB.
DataComboBox Class Module Code:
Public Event ItemAdded(sItem As String, fCancel As Boolean)
Private pComboBox As Control
Public Property Set oComboBox(cControl As Control)
Set pComboBox = cControl
End Property
Public Property Get oComboBox() As Control
oComboBox = pComboBox
End Property
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
End Sub
The UserForm contains two controls - a CommandButton named btnAdd and a ComboBox named cboData.
UserForm Code:
Private WithEvents mdcbCombo As DataComboBox
Private Sub UserForm_Initialize()
Set mdcbCombo = New DataComboBox
Set mdcbCombo.oComboBox = Me.cboData
End Sub
Private Sub mdcbCombo_ItemAdded(sItem As String, fCancel As Boolean)
Dim iItem As Long
If LenB(sItem) = 0 Then
fCancel = True
Exit Sub
End If
For iItem = 1 To Me.cboData.ListCount
If Me.cboData.List(iItem) = sItem Then
fCancel = True
Exit Sub
End If
Next iItem
End Sub
Private Sub btnAdd_Click()
Dim sItem As String
sItem = Me.cboData.Text
AddDataItem sItem
End Sub
Private Sub AddDataItem(sItem As String)
Dim fCancel As Boolean
fCancel = False
RaiseEvent ItemAdded(sItem, fCancel)
If Not fCancel Then Me.cboData.AddItem (sItem)
End Sub
You cannot raise an event outside the classes file level.
Add a routine like this inside "DataComboBox1" to allow you to raise the event externally.
Public Sub OnItemAdded(sItem As String, fCancel As Boolean)
RaiseEvent ItemAdded(sItem, fCancel)
End Sub
Then call the OnItemAdded with the current object.
Example...
Private WithEvents mdcbCombo As DataComboBox
...
mdcbCombo.OnItemAdded(sItem, fCancel)

Custom MsgBox without form activate being fired

I have developed a custom MsgBox that works fine in almost every way. The only problem is that when the MsgBox closes the parent form runs the Form_Activate code. A normal MsgBox does not run that code (again).
I know i could add a boolean variable to Form_Activate to check if it has fired already, but that's not the best solution when you have a dozen forms.
So, is there a way to not run Form_Activate after closing my custom MsgBox? Does the MsgBox form need to be of some special type or something? I tried all BorderStyles but that doesn't make any difference.
Are you using another form to make custom MsgBox?
You shouldn't use directly other form to show a custom messagebox.
You should create an Activex control, and Activate event won't fire again when the MsgBox is closed.
Within the control you can use a form if you want it. (Probably just have to place your code inside an ActiveX control project and use it in your forms)
I use it that way.
This is a custom MsgBox example using Activex Control, with a test form too.
http://www.codeguru.com/code/legacy/vb_othctrl/2166_CustomMsgBox.zip
I created a Class for a Custom MsgBox.
Public Class CustomMsgBox
'Creates the Main form
Dim Main As New Form
'Creates the buttons
Dim Btn1, Btn2, Btn3 As New Button
'Creates the label
Dim Lbl As New Label
'Creates the Output variable
Dim Output As Integer = 0
Private Sub Load()
'Btn1 properties
Btn1.Location = New Point(168, 69)
Btn1.AutoSize = True
Btn1.AutoSizeMode = AutoSizeMode.GrowOnly
'Btn2 properties
Btn2.Location = New Point(87, 69)
Btn1.AutoSize = True
Btn1.AutoSizeMode = AutoSizeMode.GrowOnly
'Btn3 properties
Btn3.Location = New Point(6, 69)
Btn1.AutoSize = True
Btn1.AutoSizeMode = AutoSizeMode.GrowOnly
'Lbl properties
Lbl.Location = New Point(12, 19)
Lbl.AutoSize = True
Lbl.AutoEllipsis = True
'Main form properties
Main.Size = New Size(211, 129)
Main.AutoSize = True
Main.AutoSizeMode = AutoSizeMode.GrowOnly
Main.ShowIcon = False
Main.Controls.Add(Btn1)
Main.Controls.Add(Btn2)
Main.Controls.Add(Btn3)
Main.Controls.Add(Lbl)
'Adds Handlers to the buttons
AddHandler Btn1.Click, AddressOf btn1_Click
AddHandler Btn2.Click, AddressOf btn2_Click
AddHandler Btn3.Click, AddressOf btn3_Click
End Sub
Function CstMsgBox(ByRef Msg As String, ByRef Title As String, ByRef B1 As String, Optional ByRef B2 As String = Nothing, Optional ByRef B3 As String = Nothing) As Integer
'Runs the Load() Sub
Load()
'Sets the values
Lbl.Text = Msg
Btn1.Text = B1
Btn2.Text = B2
Btn3.Text = B3
Main.Text = Title
'Checks if there is a value set to Btn2 and Btn3
If Btn2.Text = Nothing Then
Btn2.Hide()
End If
If Btn3.Text = Nothing Then
Btn3.Hide()
End If
'Shows the MsgBox
Main.Show()
'Waits until a button is pressed
Do Until Output <> 0
Application.DoEvents()
Loop
'Closes the MsgBox
Main.Close()
Return Output
End Function
Private Sub btn1_Click(ByVal sender As Object, ByVal e As EventArgs)
'Sets the Output value to 1
Output = 1
End Sub
Private Sub btn2_Click(ByVal sender As Object, ByVal e As EventArgs)
'Sets the Output value to 2
Output = 2
End Sub
Private Sub btn3_Click(ByVal sender As Object, ByVal e As EventArgs)
'Sets the Output value to 3
Output = 3
End Sub
End Class
You can use it by typing this:
Dim CMB As New CustomMsgBox
CCMB.CstMsgBox('MSG, 'TITLE, 'BUTTON1, 'Optional: BUTTON2, 'Optional: BUTTON3)
OR
Dim CMB As New CustomMsgBox
Select Case CMB.CstMsgBox('MSG, 'TITLE, 'BUTTON1, 'Optional: BUTTON2, 'Optional: BUTTON3)
Case 1
'Code to execute when button1 is pressed
Case 2
'Code to execute when button2 is pressed
Case 3
'Code to execute when button3 is pressed
End Select

visual basic 6 Image Class

The following code is the Form code which changes an image or informs the user if the image has already changed. In the form, I have an Image control named Image1 whose Picture property has to be changed. I'm just asking for help on how to make a class module(.cls) from this code.
Private Image1Color As String
Private Sub Form_Load()
Image1Color = "Green"
End Sub
Private Sub CheckIn1_Click()
If Image1Color = "Green" Then
Image1.Picture = LoadPicture ("Color\red1.jpg")
Image1Color = "Red"
Else
MsgBox ("This table is already occupied")
End If
End Sub
If you want to literally reuse your form code you can do the following:
ImageControlWrapper.cls:
Private m_ksColor_Green As String = "Green"
Private m_ksColor_Red As String = "Red"
Private m_sImageColor As String
Private WithEvents m_oImageControl As Image
Private Sub Class_Initialize()
m_sImageColor = m_ksColor_Green
End Sub
Public Sub Attach(ByRef in_oImageControl As VB.Image)
Set m_oImageControl = in_oImageControl
End Sub
Private Sub m_oImageControl_Click()
If m_sImageColor = m_ksColor_Green Then
Set m_oImageControl.Picture = LoadPicture("Color\red1.jpg")
m_sImageColor = m_ksColor_Red
Else
MsgBox "This table is already occupied"
End If
End Sub
Test.frm:
Private m_oImageControlWrapper As ImageControlWrapper
Private Sub Form_Load
Set m_oImageControlWrapper = New ImageControlWrapper
m_oImageControlWrapper.Attach Image1
End Sub
I used string constants for the color purely so that the compiler can pick up a mistake if you mispell the constant. If you mispell the actual string, that's an annoying bug to fix. However, if you don't really need to use the string, you would be better off turning m_sImageColor into a Boolean or an enumerated type.

Resources