Using CreateDialog in VBA in an Attempt to Create Modeless Dialog Boxes

Question

I want to create a modeless popup dialog in VBA 7.0. So far the most promising route seems to be CreateDialog.

First I tried CreateDialogW and received Entry point not found for CreateDialogW in DLL.
After opening the DLL, I verified this function was not listed. The MSDN reference linked above shows User32 as the DLL for this function and lists function names CreateDialogW and CreateDialogA (Unicode/ansi respectively), but they are not listed in this DLL on my computer (Win 7 professional, 64bit).

So, looking at the list of functions that are in the DLL, I saw the CreateDialogParam and CreateDialogIndirectParam functions (Ansi and Unicode versions of each).

I've been trying to follow the MSDN and convert the C examples to VB, but I'm missing something somewhere and I'm kind of stuck as I don't know what I'm doing wrong. The code compiles and runs without errors, but nothing happens at the API call - it executes but nothing happens.

If anyone could give me some pointers in the right direction I would greatly appreciate it. My current workaround sucks, and I'd really like to button this project up.

Option Explicit

'Reference conversion of C to VB type declarations here
'http://msdn.microsoft.com/en-us/library/aa261773(v=vs.60).aspx

'Declare function to Win API CreateDialog function
'http://msdn.microsoft.com/en-us/library/ms645434(v=vs.85).aspx
Private Declare PtrSafe Function CreateDialog Lib "User32.dll" Alias "CreateDialogParamW" _
                                (ByVal lpTemplateName As LongPtr, _
                                 ByRef lpDialogFunc As DIALOGPROC, _
                                 ByVal dwInitParam As Long, _
                                 Optional ByVal hInstance As Long, _
                                 Optional ByVal hWndParent As Long) _
                                As Long

'Windows Style Constants
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms632600(v=vs.85).aspx
Public Const WS_BORDER As Long = &H800000
Public Const WS_CAPTION As Long = &HC00000
Public Const WS_CHILD As Long = &H40000000
Public Const WS_CHILDWINDOW As Long = &H40000000
Public Const WS_CLIPCHILDREN As Long = &H2000000
Public Const WS_CLIPSIBLINGS As Long = &H4000000
Public Const WS_DISABLED As Long = &H8000000
Public Const WS_DLGFRAME As Long = &H400000
Public Const WS_GROUP As Long = &H20000
Public Const WS_HSCROLL As Long = &H100000
Public Const WS_ICONIC As Long = &H20000000
Public Const WS_MAXIMIZE As Long = &H1000000
Public Const WS_MAXIMIZEBOX As Long = &H10000
Public Const WS_MINIMIZE As Long = &H20000000
Public Const WS_MINIMIZEBOX As Long = &H20000
Public Const WS_OVERLAPPED As Long = &H0
Public Const WS_POPUP As Long = &H80000000
Public Const WS_SIZEBOX As Long = &H40000
Public Const WS_SYSMENU As Long = &H80000
Public Const WS_TABSTOP As Long = &H10000
Public Const WS_THICKFRAME As Long = &H40000
Public Const WS_TILED As Long = &H0
Public Const WS_VISIBLE As Long = &H10000000
Public Const WS_VSCROLL As Long = &H200000
Public Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED + WS_CAPTION + WS_SYSMENU + WS_THICKFRAME + WS_MINIMIZEBOX + WS_MAXIMIZEBOX)
Public Const WS_TILEDWINDOW As Long = (WS_OVERLAPPED + WS_CAPTION + WS_SYSMENU + WS_THICKFRAME + WS_MINIMIZEBOX + WS_MAXIMIZEBOX)
Public Const WS_POPUPWINDOW As Long = (WS_POPUP + WS_BORDER + WS_SYSMENU)

'Declare custom type for lpDialogFunc argument
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms645469(v=vs.85).aspx
Public Type DIALOGPROC
    hwndDlg As Long
    uMsg As LongPtr
    wparam As Long
    lparam As Long
End Type


'MAKEINTRESOURCE Macro emulation
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms648029(v=vs.85).aspx
'Bitwise function example found here: http://support.microsoft.com/kb/112651
'VB conversion found here: https://groups.google.com/forum/#!topic/microsoft.public.vb.winapi/UaK3S-bJaiQ _
 modified with strong typing and to use string pointers for VB7
Private Function MAKEINTRESOURCE(ByVal lID As Long) As LongPtr
     MAKEINTRESOURCE = StrPtr("#" & CStr(MAKELONG(lID, 0)))
End Function

Private Function MAKELONG(ByRef wLow As Long, ByRef wHi As Long)
    'Declare variables
        Dim LoLO            As Long
        Dim HiLO            As Long
        Dim LoHI            As Long
        Dim HiHI            As Long

    'Get the HIGH and LOW order words from the long integer value
        GetHiLoWord wLow, LoLO, HiLO
        GetHiLoWord wHi, LoHI, HiHI

            If (wHi And &H8000&) Then
                MAKELONG = (((wHi And &H7FFF&) * 65536) Or (wLow And &HFFFF&)) Or &H80000000
            Else
                MAKELONG = LoLO Or (&H10000 * LoHI)
                'MAKELONG = ((wHi * 65535) + wLow)
            End If
End Function

Private Function GetHiLoWord(lparam As Long, LOWORD As Long, HIWORD As Long)
    'This is the LOWORD of the lParam:
        LOWORD = lparam And &HFFFF&
    'LOWORD now equals 65,535 or &HFFFF
    'This is the HIWORD of the lParam:
        HIWORD = lparam \ &H10000 And &HFFFF&
    'HIWORD now equals 30,583 or &H7777
        GetHiLoWord = 1
End Function

Public Function TstDialog()
    Dim dpDialog                As DIALOGPROC

    dpDialog.hwndDlg = 0
    dpDialog.uMsg = StrPtr("TEST")
    dpDialog.lparam = 0
    dpDialog.wparam = 0

    CreateDialog hInstance:=0, lpTemplateName:=MAKEINTRESOURCE(WS_POPUPWINDOW + WS_VISIBLE), lpDialogFunc:=dpDialog, dwInitParam:=&H110
End Function

Answer 1

This can be made to work, although if you should try to make it work is another question. I have a working version that shows an empty dialog. I don't have any more time tonight to finish with actual controls on the dialog, but I'm posting in the hope it'll get you started.

First you need to forget about CreateDialog because they require the dialog template to be in the resource section. You can use CreateDialogIndirectParam to create a dialog from an in-memory dialog template. You will need this:

Private Type DLGTEMPLATE
    style As Long
    dwExtendedStyle As Long
    cdit As Integer
    x As Integer
    y As Integer
    cx As Integer
    cy As Integer
End Type

Private Type DLGITEMTEMPLATE
    style As Long
    dwExtendedStyle As Long
    x As Integer
    y As Integer
    cx As Integer
    cy As Integer
    id As Integer
End Type

Private Type DLG
    dlgtemp As dlgtemplate
    menu As Long
    classname As String
    title As String
End Type

Private Declare PtrSafe Function CreateDialogIndirectParam Lib "User32.dll" Alias "CreateDialogIndirectParamW" _
  (ByVal hInstance As Long, _
  ByRef lpTemplate As DLGTEMPLATE, _
  ByVal hWndParent As Long, _
  ByVal lpDialogFunc As LongPtr, _
  ByVal lParamInit As Long) _
  As LongPtr

Const WM_INITDIALOG As Long = &H110
Const DS_CENTER As Long = &H800&
Const DS_SETFONT As Long = &H40
Const DS_MODALFRAME As Long = &H80
Const WS_EX_APPWINDOW As Long = &H40000

Then call it like this:

Dim d As DLG
d.dlgtemp.style = DS_MODALFRAME + WS_POPUP + WS_VISIBLE + WS_CAPTION + WS_SYSMENU
d.dlgtemp.dwExtendedStyle = WS_EX_APPWINDOW
d.dlgtemp.cdit = 0
d.dlgtemp.x = 100
d.dlgtemp.y = 100
d.dlgtemp.cx = 200
d.dlgtemp.cy = 200
d.menu = 0
d.title = "Test"
d.classname = "Test"

CreateDialogIndirectParam 0, d.dlgtemp, 0, AddressOf DlgFunc, 0

with DlgFunc looking something like this:

Public Function DlgFunc(ByVal hwndDlg As LongPtr, ByVal uMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    If uMsg = h110 Then  ' = WM_INITDIALOG - you should make a const for the various window messages you'll need...
        DlgFunc = True
    Else
        DlgFunc = False
    End If
End Function

It's been over a decade since I last did any of this stuff. But if you're determined to go this route, I think this approach is the most promising - the next step is to adapt the DLG struct to add some DLGITEMTEMPLATE members, set d.dlgtemp.cdit to the number of controls on your dialog, and start handling control messages in your DlgFunc.

Answer 2

I don't want to detract from the in depth and well researched but there are possible work-arounds to dynamically creating modeless dialog boxes in VBA. That was the original problem before the asker bravely dived down the rabbit hole with CreateDialog. So this answer is for the original problem of dynamically creating Modeless dialog boxes in VBA not how to use CreateDialog. I can't help there.

As previously stated, modeless dialog boxes can be created using a UserForm, but we don't want useless forms littering the project. The work-around I have achieved uses the Microsoft VBA Extensibility Library. In short, we create a class that adds a generic userform to the project on construction and removes the userform on termination.

Also note, this is tested using Excel VBA. I don't have SolidWorks so I can't test it there.

Crudely done as a class module.

Option Explicit

Private pUserForm As VBIDE.VBComponent

Private Sub Class_Initialize()
    ' Add the userform when created '
    Set pUserForm = ThisWorkbook.VBProject.VBComponents.Add(VBIDE.vbext_ct_MSForm)
End Sub
Private Sub Class_Terminate()
    ' remove the userform when instance is deleted '
    ThisWorkbook.VBProject.VBComponenets.Remove pUserForm
End Sub
Public Property Get UserForm() As VBIDE.VBComponent
    ' allow crude access to modify the userform '
    ' ideally this will be replaced with more useful methods '
    Set UserForm = pUserForm
End Property
Public Sub Show(ByVal mode As Integer)
    VBA.UserForms.Add(pUserForm.Name).Show mode
End Sub

Ideally, this class would be better developed and would allow easier access to modifying the form, but for now it's a solution.

Tests

Private Sub TestModelessLocal()

    Dim localDialog As New Dialog
    localDialog.UserForm.Properties("Caption") = "Hello World"
    localDialog.Show vbModeless

End Sub

You should see a window appear and disappear as localDialog leaves scope. A UserForm1 was created in your VBProject and deleted.

This test will create a persistent dialog box. Unfortunately, UserForm1 will remain in your VBProject as globalDialog is still defined. Resetting the project will not remove the userform.

Dim globalDialog As Dialog
Private Sub TestModeless()

    Set globalDialog = New Dialog
    globalDialog.UserForm.Properties("Caption") = "Hello World"
    globalDialog.Show vbModeless
    'Set globalDialog = Nothing  closes window and removes the userform '
    'Set gloablDialog = new Dialog should delete userform1 after added userform2'
End Sub

So never use this at module scope.

In conclusion, its an ugly solution but it's far less ugly than what the Asker was trying to do.

Answer 3

You got a very poor start on this project. You completely scrambled the order of the arguments for CreateDialogParam, note how the hInstance argument is first, the dwInitParam argument is last.

You completely fumbled the DIALOGPROC declaration, it is a function pointer. That requires LongPtr in the declaration and the AddressOf operator when you make the call.

This was just the first 1% of making it work. Next problem is that you'll have to write a functional dialog procedure (the target of AddressOf) that handles the notifications that the dialog generates. Basic stuff, like recognizing that the user clicked the OK button. Very hard to write when you don't know enough about WinAPI programming, little mistakes are big undiagnosable problems at runtime.

That's just the small stuff, there are much bigger problems. The lpTemplateName argument is a very serious obstacle. That needs to be a resource identifier, the kind that's generated by "rc.exe" and added to the executable file by the linker. You cannot relink SolidWorks. A modeless dialog requires help from the message loop, it must call IsDialogMessage(). You cannot convince SolidWorks to make this call for you. Without it, the dialog misbehaves in hard to diagnose ways, like tabbing will not work.

You have to know when you stand absolutely no chance to make it work. You can't make it work.

Answer 4

This answer, like Cheezsteak's doesn't directly deal with the issues you're having with CreateDialog. It addresses the end goal of creating a modeless dialog box.

My suggestion is to use a UserForm to accomplish this. It's Show Method takes an optional parameter that determines whether or not the userform is displayed as a modal or modeless form.

From the MSDN documentation:

modal Optional. Boolean value that determines if the UserForm is modal or modeless.

1. Create a UserForm and design it to your needs.

2. In the code that creates the instance of the UserForm, simply pass it the vbModeless constant.

   Option Explicit
   
   Private frm As UserForm1
   
   Sub test2()
       Set frm = New UserForm1
       frm.Show vbModeless
   End Sub
   

If you're worried about cluttering up your project with forms, don't be. Just create the form on the fly.