34

我想在 VBA 7.0 中创建一个无模式的弹出对话框。到目前为止，最有希望的路线似乎是CreateDialog.

首先，我尝试CreateDialogW并收到了Entry point not found for CreateDialogW in DLL.
打开DLL后，我验证了这个函数没有列出。上面链接的 MSDN 参考将 User32 显示为此函数的 DLL，并列出了函数名称CreateDialogW和CreateDialogA（分别为 Unicode/ansi），但它们未在我的计算机上的此 DLL 中列出（Win 7 Professional，64 位）。

因此，查看 DLL 中的函数列表，我看到了CreateDialogParamandCreateDialogIndirectParam函数（每个函数的 Ansi 和 Unicode 版本）。

我一直在尝试遵循 MSDN 并将 C 示例转换为 VB，但我在某处遗漏了一些东西，而且我有点卡住了，因为我不知道自己做错了什么。代码编译并运行没有错误，但 API 调用没有任何反应 - 它执行但没有任何反应。

如果有人能给我一些正确方向的指示，我将不胜感激。我目前的解决方法很糟糕，我真的很想关闭这个项目。

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
4

4 回答 4

7

这可以使它起作用，尽管您是否应该尝试使它起作用是另一个问题。我有一个显示空对话框的工作版本。今晚我没有更多时间来完成对话框上的实际控制，但我发帖希望它能让你开始。

首先，您需要忘记 CreateDialog，因为它们要求对话框模板位于资源部分。您可以使用 CreateDialogIndirectParam 从内存中的对话框模板创建对话框。你将需要这个：

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

然后像这样调用它：

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

DlgFunc 看起来像这样：

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

自从我上次做这些事情以来已经有十多年了。但是如果你决心走这条路，我认为这种方法是最有前途的——下一步是调整 DLG 结构以添加一些 DLGITEMTEMPLATE 成员，将 d.dlgtemp.cdit 设置为对话框上的控件数量，并开始处理 DlgFunc 中的控制消息。

于 2014-11-18T22:05:18.960 回答
7

我不想减损深入和充分研究，但有可能的变通办法在 VBA 中动态创建无模式对话框。那是提问者勇敢地带着 潜入兔子洞之前的原始问题CreateDialog。所以这个答案是针对VBA中动态创建无模式对话框的原始问题而不是如何使用CreateDialog。我无能为力。

如前所述，可以使用 UserForm 创建无模式对话框，但我们不希望无用的表单在项目中乱扔垃圾。我实现的解决方法使用 Microsoft VBA 可扩展性库。简而言之，我们创建了一个类，它在构建时将通用用户表单添加到项目中，并在终止时删除用户表单。

另请注意，这是使用 Excel VBA 测试的。我没有 SolidWorks，所以我无法在那里进行测试。

作为一个类模块粗略地完成。

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

理想情况下，这个类会得到更好的开发，并且可以更容易地修改表单，但现在它是一个解决方案。

测试

Private Sub TestModelessLocal()

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

End Sub

您应该会看到一个窗口出现并随着localDialog离开范围而消失。AUserForm1在您的 VBProject 中创建并删除。

该测试将创建一个持久性对话框。不幸的是，UserForm1仍将保留在您的 VBProject 中globalDialog。重置项目不会删除用户表单。

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

所以永远不要在模块范围内使用它。

总之，它是一个丑陋的解决方案，但它远没有 Asker 试图做的丑陋。

于 2014-11-18T22:25:52.690 回答
3

你在这个项目上的开始很糟糕。您完全打乱了CreateDialogParam的参数顺序，请注意hInstance参数如何排在第一位，dwInitParam参数排在最后。

你完全搞砸了 DIALOGPROC 声明，它是一个函数指针。当您拨打电话时，这需要LongPtr声明和运营商。AddressOf

这只是让它发挥作用的前 1%。下一个问题是您必须编写一个功能性对话过程（ 的目标AddressOf）来处理对话生成的通知。基本的东西，比如识别用户点击了 OK 按钮。当你对 WinAPI 编程不够了解时很难编写，小错误在运行时是无法诊断的大问题。

这只是小事，还有更大的问题。lpTemplateName争论是一个非常严重的障碍。这需要是一个资源标识符，由“rc.exe”生成并由链接器添加到可执行文件中。您不能重新链接 SolidWorks。无模式对话框需要消息循环的帮助，它必须调用IsDialogMessage(). 您无法说服 SolidWorks 为您做出此决定。没有它，对话框会以难以诊断的方式出现异常，例如选项卡将不起作用。

你必须知道什么时候你绝对没有机会让它发挥作用。你不能让它工作。

于 2014-11-18T16:25:16.140 回答
3

这个答案，就像Cheezsteak's不直接处理你遇到的问题CreateDialog。它解决了创建无模式对话框的最终目标。

我的建议是使用UserForm来完成此操作。它的Show 方法采用一个可选参数，该参数确定用户窗体是显示为模式窗体还是无模式窗体。

从 MSDN 文档：

模态 可选。确定用户窗体是模态还是非模态的布尔值。

  1. 创建一个用户窗体并根据您的需要进行设计。

  2. 在创建 UserForm 实例的代码中，只需将vbModeless常量传递给它。

    Option Explicit

Private frm As UserForm1

Sub test2()
    Set frm = New UserForm1
    frm.Show vbModeless
End Sub

如果您担心表格会弄乱您的项目，请不要担心。只需即时创建表单。

于 2014-11-19T16:24:12.047 回答