Option Compare Database
Option Explicit

#If Win64 Then
  Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
          Alias "GetWindowLongPtrA" _
          (ByVal hwnd As LongPtr, _
          ByVal nIndex As Long) As LongPtr
#ElseIf VBA7 Then
  Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
          Alias "GetWindowLongA" _
          (ByVal hwnd As LongPtr, _
          ByVal nIndex As Long) As LongPtr
#Else
  Private Declare Function GetWindowLong Lib "user32" _
          Alias "GetWindowLongA" _
          (ByVal hwnd As Long, _
          ByVal nIndex As Long) As Long
#End If

' stałe określające przesunięcie argumentu nIndex :
Private Const GWL_WNDPROC = (-4)            'adres procedury okna
Private Const GWL_HINSTANCE = (-6)          'uchwyt do instancji programu
Private Const GWL_HWNDPARENT = (-8)         'uchwyt do okna rodzica
Private Const GWL_ID = (-12)                'identyfikator okna potomnego
Private Const GWL_STYLE = (-16)             'style okna
Private Const GWL_EXSTYLE = (-20)           'rozszerzony styl okna
Private Const GWL_USERDATA = (-21)          'dane użytkownika powiązane z oknem.
' stałe określające styl okna
Private Const WS_BORDER = &H800000          'okno z cienkim obramowaniem
Private Const WS_CAPTION = &HC00000         'okno z paskiem tytułowym, (zawiera WS_BORDER)
Private Const WS_CHILD = &H40000000         'okno typu child, bez paska menu, nie może być
                                            'użyte łącznie z WS_POPUP
Private Const WS_CHILDWINDOW = WS_CHILD     'jak WS_CHILD
Private Const WS_CLIPCHILDREN = &H2000000   'wyklucza obszar zajmowany przez okna podrzędne
                                            'podczas rysowania w oknie nadrzędnym.
Private Const WS_CLIPSIBLINGS = &H4000000   'oddzielny obszar okien klienta i child,
                                            'gdy okno potomne otrzymuje komunikat WM_PAINT,
                                            'obcinane są inne nakładające się okna potomne
Private Const WS_DISABLED = &H8000000       'okno jest nieaktywne po utworzeniu. By uaktywnić
                                            'okno należy użyć funkcji EnableWindow
Private Const WS_DLGFRAME = &H400000        'pogrubiona obramowanie typu okna dialogowego,
                                            'nie może mieć paska tytułowego
Private Const WS_GROUP = &H20000            'wyznacza pierwsze okno z grupy okien
Private Const WS_HSCROLL = &H100000         'okno posiada poziomy pasek przewijania
Private Const WS_MAXIMIZE = &H1000000       'okno jest zmaksymalizowane po utworzeniu
Private Const WS_MAXIMIZEBOX = &H10000      'widoczny  przycisk maksymalizacji, używany
                                            'wraz ze stylem WS_SYSMENU
Private Const WS_MINIMIZE = &H20000000      'okno jest zminimalizowane po utworzeniu
Private Const WS_ICONIC = WS_MINIMIZE       'jak WS_MINIMIZE
Private Const WS_MINIMIZEBOX = &H20000      'widoczny przycisk minimalizacji, używany
                                            'wraz ze stylem WS_SYSMENU
Private Const WS_OVERLAPPED = &H0&          'okno ma pasek tytułowy oraz ramkę, jak WS_TILED
Private Const WS_POPUP = &H80000000         'okno PopuUp, nie może być użyte łącznie z WS_CHILD
Private Const WS_SYSMENU = &H80000          'okno posiada menu systemowe. Razem z WS_CAPTION
Private Const WS_TABSTOP = &H10000          'możliwe przełączanie za pomocą TAB
Private Const WS_THICKFRAME = &H40000       'jak WS_SIZEBOX
Private Const WS_SIZEBOX = WS_THICKFRAME    'możliwa jest zmiana rozmiaru okna,
Private Const WS_TILED = WS_OVERLAPPED      'jak WS_OVERLAPPED
Private Const WS_VISIBLE = &H10000000       'okno jest widoczne po utworzeniu
Private Const WS_VSCROLL = &H200000         'okno posiada pionowy pasek przewijania
Private Const WS_OVERLAPPEDWINDOW = _
                                    (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or _
                                     WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
Private Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
Private Const WS_TILEDWINDOW = WS_OVERLAPPEDWINDOW


#If VBA7 Then
  Private Function accGetWindowStyle(lWindowStyle As LongPtr) As String
#Else
  Private Function accGetWindowStyle(lWindowStyle As Long) As String
#End If
Dim vArrStyle As Variant
Dim sStyle    As String
Dim i         As Byte

	' nieprawidłowa wartość argumentu lWindowStyle
	If lWindowStyle = 0 Then Exit Function

	' tablica zawierająca pary powiązanych danych:
	' styl okna i odpowiadająca mu wartość
	' UWAGA! bez stylu WS_OVERLAPPED = 0,
	 vArrStyle = Array( _
							"WS_BORDER", WS_BORDER, _
							"WS_CAPTION", WS_CAPTION, _
							"WS_CHILD", WS_CHILD, _
							"WS_CLIPCHILDREN", WS_CLIPCHILDREN, _
							"WS_CLIPSIBLINGS", WS_CLIPSIBLINGS, _
							"WS_DISABLED", WS_DISABLED, _
							"WS_DLGFRAME", WS_DLGFRAME, _
							"WS_GROUP", WS_GROUP, _
							"WS_HSCROLL", WS_HSCROLL, _
							"WS_MAXIMIZE", WS_MAXIMIZE, _
							"WS_MAXIMIZEBOX", WS_MAXIMIZEBOX, _
							"WS_MINIMIZE", WS_MINIMIZE, _
							"WS_MINIMIZEBOX", WS_MINIMIZEBOX, _
							"WS_POPUP", WS_POPUP, _
							"WS_POPUPWINDOW", WS_POPUPWINDOW, _
							"WS_SYSMENU", WS_SYSMENU, _
							"WS_TABSTOP", WS_TABSTOP, _
							"WS_THICKFRAME", WS_THICKFRAME, _
							"WS_VISIBLE", WS_VISIBLE, _
							"WS_VSCROLL", WS_VSCROLL)
							'"WS_OVERLAPPED", WS_OVERLAPPED,

	' sprawdź, czy styl okna to WS_OVERLAPPED
	If (lWindowStyle And (WS_POPUP Or WS_CHILD)) = 0 Then
		sStyle = sStyle & "WS_OVERLAPPED" & vbNewLine
		' sprawdź, czy styl okna to WS_OVERLAPPEDWINDOW
		If (lWindowStyle And (WS_OVERLAPPEDWINDOW)) = WS_OVERLAPPEDWINDOW Then
			sStyle = sStyle & "WS_OVERLAPPEDWINDOW" & vbNewLine
		End If
	End If

	If Len(sStyle) > 1 Then
		sStyle = sStyle & String(35, 45) & vbNewLine
	End If

	' porównaj bitowo styl okna z poszczególnymi elementami stylu
	For i = LBound(vArrStyle) To UBound(vArrStyle) Step 2
			 If (lWindowStyle And vArrStyle(i + 1)) = vArrStyle(i + 1) Then
					sStyle = sStyle & vArrStyle(i) & vbNewLine
			 End If
	Next

	' utnij ostatni znak nowej linii
	If Len(sStyle) > 1 Then
		sStyle = Left$(sStyle, Len(sStyle) - 2)
		accGetWindowStyle = sStyle
	End If

	End Function

	' przykładowe wywołanie:
	Private Sub btnTest_Click()
	#If VBA7 Then
	Dim lStyle  As LongPtr
	Dim hWind  As LongPtr
	#Else
	Dim lStyle  As Long
	Dim hWind  As Long
	#End If
	Dim sStyleWindow As String

	' pobierz styl okna MS Access
	hWind = Application.hWndAccessApp

	#If VBA7 Then
		'hWind = GetWindowLongPtr(Me.hwnd, GWL_HWNDPARENT)
		lStyle = GetWindowLongPtr(hWind, GWL_STYLE)
	#Else
		'hWind = GetWindowLong(Me.hwnd, GWL_HWNDPARENT)
		lStyle = GetWindowLong(hWind, GWL_STYLE)
	#End If

	' pobierz opisowy styl okna
	sStyleWindow = accGetWindowStyle(lStyle)

	MsgBox "Uchwyt: " & hWind & vbNewLine & _
					"Styl: " & lStyle & vbNewLine & _
					String(25, 45) & vbNewLine & _
					sStyleWindow, , "Styl okna"
End Sub