在尝试创建无模式对话框的VBA中使用CreateDialog

 苦柚甜甜 发布于 2022-12-12 16:00

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

首先我尝试CreateDialogW并收到了Entry point not found for CreateDialogW in DLL.
打开DLL后,我验证了此功能未列出.上面链接的MSDN参考显示User32作为此函数的DLL并列出函数名称CreateDialogWCreateDialogA(Unicode/ansi),但它们未在我的计算机上的此DLL中列出(Win 7 professional,64bit).

所以,看的是功能列表在DLL中,我看到的CreateDialogParamCreateDialogIndirectParam函数(每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

cheezsteak.. 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叶子范围消失.A UserForm1在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试图做的那么难看.

2 个回答
  • 这可以使用,但如果你应该尝试让它工作是另一个问题.我有一个显示空对话框的工作版本.我今晚没有时间完成对话框的实际控制,但是我希望它能让你开始.

    首先,您需要忘记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中的控制消息.

    2022-12-12 16:03 回答
  • 我不想贬低深度和深入研究,但有可能在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叶子范围消失.A UserForm1在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试图做的那么难看.

    2022-12-12 16:04 回答
撰写答案
今天,你开发时遇到什么问题呢?
立即提问
热门标签
PHP1.CN | 中国最专业的PHP中文社区 | PNG素材下载 | DevBox开发工具箱 | json解析格式化 |PHP资讯 | PHP教程 | 数据库技术 | 服务器技术 | 前端开发技术 | PHP框架 | 开发工具 | 在线工具
Copyright © 1998 - 2020 PHP1.CN. All Rights Reserved 京公网安备 11010802041100号 | 京ICP备19059560号-4 | PHP1.CN 第一PHP社区 版权所有