Paski przewijania okna roboczego MS Access.
Chcąc programowo zmienić położenie formularza, bądź kilku formularzy, a zwłaszcza jeżeli chcemy go dosunąć do prawej lub dolnej krawędzi okna roboczego musimy wiedzieć, czy paski przewijania są widoczne. Co prawda pasek przewijanie zajmuje tylko, lub aż ok. 20 pikseli szerokości (wysokości), ale jak to mówią „sztuka cierpi”, gdy przesuwany formularz znajdzie się kilka pikseli pod np. pionowym paskiem i pojawi się poziomy pasek okna roboczego, który przesłoni elementy formularza np. Przyciski nawigacyjne.
Poziomy pasek przewijania zasłania Przyciski nawigacyjne
Czy widoczny jest pionowy i (lub) poziomy pasek przewijania okna MS Access?
Niestety, okno robocze MS Access nie ma „Arkusza właściwości”
i w żaden sposób nie ułatwia nam pracy przez udostępnienie swoich właściwości wprost.
Na stronie GetWindowsLong(...)
znajduje się opis funkcji API GetWindowsLong(...) za pomocą której możemy pobrać styl okna,
a na stronie Styl okna, jak wyodrębnić elementy
stylu ze zwracanej liczbowej wartości.
Jeszcze tylko jedna uwaga.
Okno robocze MS Access to okno „rodzic”, w którym otwierane są „dzieci” tj. obiekty MS Access
takie jak tabele, kwerendy, formularze, raporty, makra.
Okno to, jak prawie każde okno Windows, ma swój uchwyt hwnd, ale także niedostępny wprost.
Ale od czego jest wspomniana już funkcja GetWindowsLong(...) i stała GWL_HWNDPARENT.
Nie należy mylić uchwytu tego okna z uchwytem hWndAccessApp określającym uchwytu przypisany przez
system Windows do głównego okna programu MS Access.
⊗ Private Function accScrollBars(hWind As Long) As Long
- Sprawdza, które paski przewijania są widoczne w oknie o uchwycie hwnd
- argumenty:
- hWind
- uchwyt okna
- zwraca:
-
Przy powodzeniu zwraca liczbę określającą, które paski przewijania są widoczne:
- 0 - żaden pasek przewijania nie jest widoczny
- 1 - tylko poziomy pasek przewijania jest widoczny
- 2 - tylko pionowy pasek przewijania jest widoczny
- 3 - pionowy i poziomy pasek przewijania są widoczne
- autor: Zbigniew Bratko
- data: 08.01.2019
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_HWNDPARENT = (-8) 'uchwyt do okna rodzica
Private Const GWL_STYLE = (-16) 'style okna
' stałe określające styl okna
Private Const WS_HSCROLL = &H100000 'okno posiada poziomy pasek przewijania
Private Const WS_VSCROLL = &H200000 'okno posiada pionowy pasek przewijania
#If VBA7 Then
Private Function accScrollBars(hWind As LongPtr) As Long
#Else
Private Function accScrollBars(hWind As Long) As Long
#End If
#If VBA7 Then
Dim lStyle As LongPtr
#Else
Dim lStyle As Long
#End If
' pobierz styl okna
#If VBA7 Then
lStyle = GetWindowLongPtr(hWind, GWL_STYLE)
#Else
lStyle = GetWindowLong(hWind, GWL_STYLE)
#End If
If lStyle = 0 Then
' coś poszło nie tak
accScrollBars = -1
Exit Function
End If
' porównaj bitowo styl okna ze stylem pasków przewijania
If ((lStyle And WS_HSCROLL) = WS_HSCROLL) And ((lStyle And WS_VSCROLL) = WS_VSCROLL) Then
accScrollBars = 3
ElseIf (lStyle And WS_VSCROLL) = WS_VSCROLL Then
accScrollBars = 2
ElseIf (lStyle And WS_HSCROLL) = WS_HSCROLL Then
accScrollBars = 1
End If
End Function
' przykładowe wywołanie:
Private Sub btnTest_Click()
#If VBA7 Then
Dim hParent As LongPtr
#Else
Dim hParent As Long
#End If
Dim lRetVal As Long
' pobierz uchwyt okna będącego Rodzicem formularza
#If VBA7 Then
hParent = GetWindowLongPtr(Me.hwnd, GWL_HWNDPARENT)
#Else
hParent = GetWindowLong(Me.hwnd, GWL_HWNDPARENT)
#End If
' pobierz pseudowłaściwość ScrollBar
lRetVal = accScrollBars(hParent)
Select Case lRetVal
Case 0
MsgBox "Żaden pasek przewijania."
Case 1
MsgBox "Poziomy pasek przewijania."
Case 2
MsgBox "Pionowy pasek przewijania."
Case 3
MsgBox "Oba paski przewijania."
Case Else
MsgBox "Nieprzewidziany błąd."
End Select
End Sub
Do pobrania:
• Paski przewijania formularza.
Przy próbie zastosowania funkcji:
lStyle = accScrollBars(Me.hwnd)
w celu sprawdzenia jakie paski przewijania są widoczne na formularzu, spotka nas porażka. Zwracana wartość lStyle nie
zawiera stylu WS_HSCROLL ani WS_VSCROLL, czyli w oknie formularza nie są widoczne żadne paski przewijania.
Paski przewijania okna formularza nie są identyfikowane.
Jednak paski przewijania formularza są widoczne. Jak rozwiązać problem identyfikacji pasków przewijania w formularzu będzie przedstawione na stronie Paski przewijania formularza.