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
===============================
Code: Select all
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) or is this just a new bug ????
On request i can provide the complet .accdb file with all the code in it
Many thanks in advance....
__________________________________________________
Code tags added
14.03.2017
RSBasic