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.