none
Problem with the function CreateWindowEx on W10/64bits RRS feed

  • Question

  • Hello All,
     I have a question about the function CreateWindowEx in vba.
    I have managed to make it work on W7/64bits with Access2013/64bits....(and on all 32bit versions). it works fine also on my W10/32bits version.

    But when i try exactly the same on W10/64bits with Access2013/64bits CreateWindowEx does not return a valid pointer.

    In my module there is this code (for VBA7) : and i run the CreateMyForm function

    ===============================

    Option Compare Database
    Option Explicit

    Private Type WNDCLASSEX
        cbSize As Long
        style As Long
        lpfnwndproc As LongPtr
        cbClsextra As Long
        cbWndExtra As Long
        hInstance As LongPtr
        hIcon As LongPtr
        hCursor As LongPtr
        hbrBackground As LongPtr
        lpszMenuName As String
        lpszClassName As String
        hIconSm As LongPtr
    End Type

    Private Type POINTAPI
        x As Long
        y As Long
    End Type

    Private Type MSG
        hwnd As LongPtr
        message As Long
        wParam As LongPtr
        lParam As LongPtr
        time As Long
        pt As POINTAPI
    End Type

    Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type

    Private Type PAINTSTRUCT
        hdc As LongPtr
        fErase As Long
        rcPaint As RECT
        fRestore As Long
        fIncUpdate As Long
        rgbReserved(0 To 31) As Byte
        'rgbReserved(32) As Byte 'this was declared incorrectly in VB API viewer
    End Type

    Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As LongPtr, ByVal hMenu As LongPtr, ByVal hInstance As LongPtr, lpParam As Any) As LongPtr
    Private Declare PtrSafe Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As LongPtr, ByVal lpIconName As String) As LongPtr
    Private Declare PtrSafe Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As LongPtr, ByVal lpCursorName As String) As LongPtr
    Private Declare PtrSafe Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (pcWndClassEx As WNDCLASSEX) As Integer
    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
    Private Declare PtrSafe Function UpdateWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
    Private Declare PtrSafe Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
    Private Declare PtrSafe Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As LongPtr
    Private Declare PtrSafe Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
    Private Declare PtrSafe Function BeginPaint Lib "user32" (ByVal hwnd As LongPtr, lpPaint As PAINTSTRUCT) As LongPtr
    Private Declare PtrSafe Function EndPaint Lib "user32" (ByVal hwnd As LongPtr, lpPaint As PAINTSTRUCT) As Long
    Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As LongPtr, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
    Private Declare PtrSafe Function GetLastError Lib "kernel32" () As Long


    Private Const WS_VISIBLE As Long = &H10000000
    Private Const WS_VSCROLL As Long = &H200000
    Private Const WS_TABSTOP As Long = &H10000
    Private Const WS_THICKFRAME As Long = &H40000
    Private Const WS_MAXIMIZE As Long = &H1000000
    Private Const WS_MAXIMIZEBOX As Long = &H10000
    Private Const WS_MINIMIZE As Long = &H20000000
    Private Const WS_MINIMIZEBOX As Long = &H20000
    Private Const WS_SYSMENU As Long = &H80000
    Private Const WS_BORDER As Long = &H800000
    Private Const WS_CAPTION As Long = (WS_BORDER Or WS_DLGFRAME)  '&HC00000
    Private Const WS_CHILD As Long = &H40000000
    Private Const WS_CHILDWINDOW As Long = (WS_CHILD)
    Private Const WS_CLIPCHILDREN As Long = &H2000000
    Private Const WS_CLIPSIBLINGS As Long = &H4000000
    Private Const WS_DISABLED As Long = &H8000000
    Private Const WS_DLGFRAME As Long = &H400000
    Private Const WS_EX_ACCEPTFILES As Long = &H10&
    Private Const WS_EX_DLGMODALFRAME As Long = &H1&
    Private Const WS_EX_NOPARENTNOTIFY As Long = &H4&
    Private Const WS_EX_TOPMOST As Long = &H8&
    Private Const WS_EX_TRANSPARENT As Long = &H20&
    Private Const WS_GROUP As Long = &H20000
    Private Const WS_HSCROLL As Long = &H100000
    Private Const WS_ICONIC As Long = WS_MINIMIZE
    Private Const WS_OVERLAPPED As Long = &H0&
    Private Const WS_OVERLAPPEDWINDOW As Long = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
    Private Const WS_POPUP As Long = &H80000000
    Private Const WS_POPUPWINDOW As Long = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
    Private Const WS_SIZEBOX As Long = WS_THICKFRAME
    Private Const WS_TILED As Long = WS_OVERLAPPED
    Private Const WS_TILEDWINDOW As Long = WS_OVERLAPPEDWINDOW
    Private Const CW_USEDEFAULT As Long = &H80000000
    Private Const CS_HREDRAW As Long = &H2
    Private Const CS_VREDRAW As Long = &H1
    Private Const IDI_APPLICATION As Long = 32512&
    Private Const IDC_ARROW As Long = 32512&
    Private Const WHITE_BRUSH As Integer = 0
    Private Const BLACK_BRUSH As Integer = 4
    Private Const WM_KEYDOWN As Long = &H100
    Private Const WM_CLOSE As Long = &H10
    Private Const WM_DESTROY As Long = &H2
    Private Const WM_PAINT As Long = &HF
    Private Const SW_SHOWNORMAL As Long = 1
    Private Const DT_CENTER As Long = &H1
    Private Const DT_SINGLELINE As Long = &H20
    Private Const DT_VCENTER As Long = &H4
    Private Const WS_EX_STATICEDGE = &H20000
    Private Const SW_NORMAL = 1

    Public Function CreateMyForm()

        Dim lhwndWindow As LongPtr
        Dim AtomReg As Integer
        Dim tWinClass As WNDCLASSEX
        Dim tMessage As MSG
      
        'Set up and register window class
        tWinClass.cbSize = LenB(tWinClass)
        tWinClass.style = CS_HREDRAW Or CS_VREDRAW
        tWinClass.lpfnwndproc = FunctionPointer(AddressOf WindowProc)
        tWinClass.cbClsextra = 0&
        tWinClass.cbWndExtra = 0&
        tWinClass.hInstance = 0&
        tWinClass.hIcon = LoadIcon(0&, IDI_APPLICATION)
        tWinClass.hCursor = LoadCursor(0&, IDC_ARROW)
        tWinClass.hbrBackground = GetStockObject(WHITE_BRUSH)
        tWinClass.lpszMenuName = 0&
        tWinClass.lpszClassName = "NOMDEMACLASSE"
        tWinClass.hIconSm = LoadIcon(0&, IDI_APPLICATION)

        AtomReg = RegisterClassEx(tWinClass)

        'Create a window
        lhwndWindow = CreateWindowEx(WS_EX_DLGMODALFRAME, "NOMDEMACLASSE", "A NICE TITLE", WS_POPUPWINDOW Or WS_CAPTION, 100, 100, 500, 200, 0&, 0&, 0&, 0&)

        If lhwndWindow = 0 Then
            MsgBox "Debug info : " & vbCrLf _
            & "AtomReg=" & AtomReg & vbCrLf & vbCrLf _
            & "but lhwndWindow = " & lhwndWindow & vbCrLf & vbCrLf _
            & "So CreateWindowEx DOES NOT WORK ! "
            Exit Function
        End If

        'Show the window
        ShowWindow lhwndWindow, SW_SHOWNORMAL
        UpdateWindow lhwndWindow
        SetFocus lhwndWindow
       
        'Message loop
        Do While 0 <> GetMessage(tMessage, 0&, 0&, 0&)
            TranslateMessage tMessage
            DispatchMessage tMessage
        Loop
       
    End Function

    'Message handler for this window
    Private Function WindowProc(ByVal lhwnd As LongPtr, ByVal tMessage As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
        Dim tPaint As PAINTSTRUCT
        Dim tRect As RECT
        Dim lHdc As LongPtr
        Dim sCaption As String

        Select Case tMessage
        Case WM_PAINT
            lHdc = BeginPaint(lhwnd, tPaint)
            Call GetClientRect(lhwnd, tRect)
            sCaption = "CreateWindowEx WORKS .....yessss"
            Call DrawText(lHdc, sCaption, Len(sCaption), tRect, DT_SINGLELINE Or DT_CENTER Or DT_VCENTER)
            Call EndPaint(lhwnd, tPaint)
            Exit Function

        Case WM_KEYDOWN
            'Close window when the user presses a key
            Call PostMessage(lhwnd, WM_CLOSE, 0, 0)
            Exit Function
           
        Case WM_DESTROY
            'Fired when the X button is pressed
            PostQuitMessage 0&
            Exit Function
        End Select
       
        'pass all other messages to default window procedure
        WindowProc = DefWindowProc(lhwnd, tMessage, wParam, lParam)

    End Function

    ==================================================

    So the actual call to CreateWindowEx is :

       lhwndWindow = CreateWindowEx(WS_EX_DLGMODALFRAME, CLASSNAME, TITLE, WS_POPUPWINDOW Or WS_CAPTION, 500, 50, 500, 500, 0&, 0&, 0&, 0&)

    And this fails on my W10/64bits computer with Access2013/64bits installed. (lhwndWindow = 0), whereas on W7/64bits it returns a valid pointer.

    Can anyone tell me why it is different in W10/64bits and how i should solve this issue ?
     Could this be an antivirus issue ? (i tried to turn down Avast and Window Defender to no avail)

    On request i can provide the complet .accdb file with all the code in it

    Are there known issues with CreateWindowsEx with W10/64bits ? (cant find any usefull info in these forums)

    Many thanks in advance....






    • Edited by rlisoft Sunday, January 15, 2017 10:59 AM
    Sunday, January 15, 2017 6:37 AM

Answers

  • I used your code but commented all tWinClass calls because you hadn't posted the whatever is in your WNDCLASSEX, then I exit'd the sub just after the ShowWindow line. Also I moved the lhwndWindow declaration to module level so I could use DestroyWindow to delete the window.

    I've only just noticed that in the code I commented you had registered "NOMDECLASS" so it should have worked.

    I used "STATIC just for testing because it's a pre-defined system class

    https://msdn.microsoft.com/en-us/library/windows/desktop/ms633574(v=vs.85).aspx#system

    Try adding a null string to STATIC or your own name, eg

    "NOMDECLASS" & Chr(0) ' or vbNullString

    • Marked as answer by rlisoft Friday, January 20, 2017 6:40 AM
    Thursday, January 19, 2017 8:42 PM
    Moderator

All replies

  • Does CreateWindow function also fail?  I've seen a few problems with Win 10 v1607 vs. v1511.  They seem to have added a lot more security features.

    I'm not sure what you are doing with the window but you may consider using C#'s NativeWindow class.  Write a program using that and call it from VBA.  I've done that several times.

    Monday, January 16, 2017 1:31 PM
  • Is "NOMDEMACLASSE" a recognized Windows classname in your system?

    For testing try, for example, "STATIC"

    Monday, January 16, 2017 2:15 PM
    Moderator
  • Hello mogulman52...and Peter Thornton,

    Thank you both so much for your replies on my post : it is a week now i am searching for an awnser to no avail and except for your replies nobody seems to be interested in it.

    In reply to Peter: i tried to change "NOMDELACLASS" to "STATIC" but the result is the same : it works on W7/64bits and it fails on W10/64bits (W10 familly edition).

    Both instructions RegisterClassEx and CreateWindowEx return no error : err.LastDllError=0, but the handler returned lhwndWindow is still 0  in W10/64bits

    In reply to mogulman52....yes that is what i suspect...a security issue with W10/64bits; but who can confirm this ?.

    I tried to replace RegisterClassEx and CreateWindowEx with RegisterClass and CreateWindow but i see no diffence.

    Unfortunately i have no programming experience with C so i'm stuck with vba.

    (by the way and for info: i need this to work because i have 'translated' Lebans calender class clsMonthcal and modCalendar from 32bits to 64bits. Lebans class permitted so nicely to select a range of dates on an Access-form and it is intensively used in a big Access application, now completely transformed to vba7, except for this nasty detail.)

    So any more help maybe ?

    Wednesday, January 18, 2017 10:54 AM
  • I know this isn't a solution but what happens if you run Access as 'Run as Administrator'.
    Wednesday, January 18, 2017 1:10 PM
  • W10/64bits does not allow me to right-clic on a .accdb and run it as administrator

    I even created a shortcut to a command window, and tried to change the advanced properties of that shortcut and there is a checkbox to run the shortcut as administrator but it is grayed out...so i cannot choose it.

    Running just the .accdb from within the command window gives me the same behavour as normal double clic on the .accdb.

    So how to run it as administrator ?

    Wednesday, January 18, 2017 5:03 PM
  • You run the command window as Administrator.  That should run .accdb as administrator.
    Wednesday, January 18, 2017 6:28 PM
  • Yes that's what i tried to do.

    My Windows account is administrator anyway....

    but it changes Nothing

    Wednesday, January 18, 2017 6:33 PM
  • Finally found out how to run the command prompt on W10/64 family edition 'as administrator' and in it i executed my test Access database with the above mentioned code and CreateWindowEx still returns a window handler=0...without any DLLerror information......so it fails.

    please help !

    Thursday, January 19, 2017 8:53 AM
  • Thank you both so much for your replies on my post : it is a week now i am searching for an awnser to no avail and except for your replies nobody seems to be interested in it.

    In reply to Peter: i tried to change "NOMDELACLASS" to "STATIC" but the result is the same : it works on W7/64bits and it fails on W10/64bits (W10 familly edition).

    Both instructions RegisterClassEx and CreateWindowEx return no error : err.LastDllError=0, but the handler returned lhwndWindow is still 0  in W10/64bits

    Not sure why you say nobody seems to be interested in your post. You've had quick replies, I also replied to another of your posts which you didn't respond to.

    I tried your code in Win10 x64 with "Static" and it worked fine. I had to move some of your constants around though, the ones which referred to other constants lower in the list. I also commented most of your code. I retained the handle and used DestroyWindow to delete it

    What sort of window are you trying to create, is it defined with a classname known to your version of windows?

    Thursday, January 19, 2017 5:11 PM
    Moderator
  • Hello Peter,

    Thanks for this reply.

    So you got it working with "STATIC" ! That's new info for me (i had no results with that...)

    Could you post a little extract of your code you used? So i can trie the same...

    Yes, i saw that WS_DLGFRAME should have been higher up...i already corrected...but the result stays the same..

    Thursday, January 19, 2017 6:40 PM
  • Petr, you wrote < I also replied to another of your posts which you didn't respond to.>

    I do not see that reply in this thread....could you point me to it... ?

    Thursday, January 19, 2017 7:41 PM
  • I used your code but commented all tWinClass calls because you hadn't posted the whatever is in your WNDCLASSEX, then I exit'd the sub just after the ShowWindow line. Also I moved the lhwndWindow declaration to module level so I could use DestroyWindow to delete the window.

    I've only just noticed that in the code I commented you had registered "NOMDECLASS" so it should have worked.

    I used "STATIC just for testing because it's a pre-defined system class

    https://msdn.microsoft.com/en-us/library/windows/desktop/ms633574(v=vs.85).aspx#system

    Try adding a null string to STATIC or your own name, eg

    "NOMDECLASS" & Chr(0) ' or vbNullString

    • Marked as answer by rlisoft Friday, January 20, 2017 6:40 AM
    Thursday, January 19, 2017 8:42 PM
    Moderator
  • Petr, you wrote < I also replied to another of your posts which you didn't respond to.>

    I do not see that reply in this thread....could you point me to it... ?

    https://social.msdn.microsoft.com/Forums/en-US/5aeadf04-4c0f-438a-a09a-fe85e4f9cb1f/problem-with-the-function-createwindowex-with-office201364bits?forum=isvvba

    When I replied to this thread I hadn't seen the code you posted later in your second post here

    Thursday, January 19, 2017 8:44 PM
    Moderator
  • GOOD NEWS ...

    Yes Peter you pointed me to the right direction...by commenting out and changing all as you proposed and with STATIC it finaly WORKED !.

    So that left me with my class NOMDELACLASS that did not register correctly although no errors where reported by RegisterClassEx.

    Then suddenly i saw the problem:

    It was my WindowProc declaration:

    Private Function WindowProc(ByVal lhwnd As LongPtr, ByVal tMessage As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr

    that should have been :

    Private Function WindowProc(ByVal lhwnd As LongPtr, ByVal tMessage As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    SO wParam and lParam as LONGPTR

    And that solved my problem....thanks Peter !

    Friday, January 20, 2017 6:39 AM
  • @rlisoft

    Did you ever get the clsMonthCal  working with 64 bit. If yes, can you please release it to the public. I just spent hours on it, and cannot get it to work.

    Monday, September 21, 2020 8:53 PM