Использование CreateDialog в VBA в попытке создать немодальные диалоговые окна

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, 64bit).

Итак, глядя на список функций, которые находятся в DLL, я увидел функции CreateDialogParam и CreateDialogIndirectParam (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
  • 2
    CreateDialog указывает в своей документации, что это макрос, который на самом деле использует CreateDialogParam . Это также указывает, что оно возвращает значение, и что если это возвращаемое значение равно NULL, вам следует использовать GetLastError чтобы выяснить, почему это не удалось. Ты этого не делаешь - почему бы и нет? (В любом случае, не уверен, почему вы перепрыгиваете через все эти скачки; в любом продукте Office, поддерживающем VBA, гораздо проще использовать встроенные способы создания форм (диалогов).)
  • 1
    Кен, я использую VBA 7.0 с Solidworks. Нет (насколько мне известно) никакой встроенной функции для создания немодального диалога в VBA, кроме создания общей формы и вызова экземпляра с установленным значением VbModeless. Я изучал возможность использования Windows API, потому что мне не нравятся ненужные формы в моих проектах, а также опыт обучения.
Показать ещё 8 комментариев
Теги:
dialog

4 ответа

6
Лучший ответ

Это можно заставить работать, хотя, если вы попытаетесь заставить его работать, это еще один вопрос. У меня есть рабочая версия, которая показывает пустой диалог. У меня больше нет времени, чтобы закончить с помощью реальных элементов управления в диалоговом окне, но я отправляю их в надежде, что вы начнете.

Сначала вам нужно забыть о 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.

  • 1
    Кроме того, вам, вероятно, следует прочесть эту серию: blogs.msdn.com/b/oldnewthing/archive/2005/04/29/412577.aspx, если вы действительно собираетесь это сделать.
  • 2
    Я могу проверить, что у меня есть пустые немодальные диалоговые окна, но я не могу закрыть их сейчас. Они уходят на закрытие Excel.
Показать ещё 6 комментариев
7

Я не хочу умалять глубину и хорошо исследовать, но есть возможности для динамического создания немодальных диалоговых окон в VBA. Это была первоначальная проблема, прежде чем аскер смело нырнул вниз по кроличьей дыре с помощью CreateDialog. Итак, этот ответ предназначен для оригинальной проблемы динамического создания диалоговых окон Modeless в 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

Поэтому никогда не используйте это в области модуля.

В заключение, это уродливое решение, но оно гораздо менее уродливое, чем то, что пытался сделать Аскер.

  • 0
    Привет cheezsteak, да динамическое добавление формы является вариантом. Единственное, что мне не нравится в динамическом изменении проектов VBA, - это отладка PITA, потому что, как только проект изменяется программным способом, больше нельзя приостанавливать выполнение, и код должен выполняться до завершения. Для меня это означает, что мне нужно много проверять на ошибки в моем коде и печатать в окне отладки, либо сохранять результаты и печатать в окне сообщений в конце, что в VBA является своего рода болью, так как нет такой попытки / отлова, как .net: / Часть причины, по которой я искал другие методы, но это вариант!
  • 0
    Что касается глобального решения, вы, вероятно, могли бы переместить процедуру завершения в открытую процедуру, а затем просто вызвать эту процедуру даже при завершении вызова. Таким образом, вы можете уничтожить переменные глобального / модульного уровня. т.е. Public Sub Destroy() ' remove the userform when instance is deleted ThisWorkbook.VBProject.VBComponents.Remove pUserForm End Sub Private Sub Class_Terminate() Destroy End Sub
Показать ещё 11 комментариев
4

У вас очень плохое начало в этом проекте. Вы полностью скремблировали порядок аргументов для CreateDialogParam, обратите внимание, как сначала аргумент hInstance, последний аргумент dwInitParam.

Вы полностью поиграли в объявление DIALOGPROC, это указатель на функцию. Это требует LongPtr в объявлении и оператора AddressOf при выполнении вызова.

Это было всего лишь 1% от того, как он работал. Следующая проблема заключается в том, что вам придется написать функциональную диалоговую процедуру (цель AddressOf), которая обрабатывает уведомления, которые генерирует диалог. Основные вещи, например, распознавание того, что пользователь нажал кнопку "ОК". Очень сложно писать, когда вы не знаете достаточно о программировании в WinAPI, небольшие ошибки - это большие проблемы с неигромизацией во время выполнения.

Это просто мелочи, есть гораздо большие проблемы. Аргумент lpTemplateName является очень серьезным препятствием. Это должен быть идентификатор ресурса, который генерируется "rc.exe" и добавлен в исполняемый файл компоновщиком. Вы не можете переделать SolidWorks. Диалог без модели требует помощи из цикла сообщений, он должен вызывать IsDialogMessage(). Вы не можете убедить SolidWorks сделать этот звонок для вас. Без этого диалог плохо работает, чтобы диагностировать способы, например, табуляция не будет работать.

Вы должны знать, когда у вас нет абсолютно никаких шансов заставить его работать. Вы не можете заставить его работать.

  • 0
    Я ценю очень понятную обратную связь. Первоначально у меня CreateDialogParam аргументы CreateDialogParam в порядке, указанном в документации MSDN, но VBA, к сожалению, требует, чтобы дополнительные аргументы были последними, поэтому они теперь упорядочены так, как они есть. Я не знал, повлияет ли это на вызов API. Похоже, это так. Как указывал выше Кен, я совершенно неверно истолковал, как использовать DialogProc обратного вызова DialogProc но я нашел некоторую информацию об использовании AddressOf . Это действительно звучит так, как будто это невозможно в VBA или, по крайней мере, не стоит потраченного времени / усилий.
  • 0
    [Я не могу решить, будет ли мой комментарий здесь или в вашем вопросе Tumbleweed. - Рэнди] Понятно, что вы уже подумали об этой проблеме и задали довольно много вопросов . Мое единственное предложение (если это возможно) состоит в том, чтобы перегонять код до наименьшего возможного значения. Это поможет людям увидеть код и то, что может быть взломано. И, возможно, самостоятельно проверить, правильны ли такие служебные функции, как MAKELONG. Удачи!
3

Этот ответ, например Cheezsteak, напрямую не касается проблем, которые у вас есть с CreateDialog. В нем рассматривается конечная цель создания диалогового окна без модели.

Мое предложение - использовать UserForm для этого. Это Показать метод принимает необязательный параметр, определяющий, отображается ли пользовательская форма как модальная или немощная форма.

Из документации MSDN:

modal Необязательный. Логическое значение, определяющее, является ли UserForm модальным или немощный.

Если вы беспокоитесь о загромождении своего проекта формами, не надо. Просто создайте форму на лету.

  • 1
    Я сделал ссылку на связанный вопрос для моего ответа.

Ещё вопросы

Сообщество Overcoder
Наверх
Меню