Paski przewijania okna formularza.
Chcąc programowo zmienić położenie formantów formularza, a zwłaszcza jeżeli chcemy formant ten dosunąć do prawej lub dolnej krawędzi okna musimy wiedzieć, czy paski przewijania są widoczne. Gdy pasek postępu jest widoczny, formant powinniśmy dosunąć prawą (lub dolną) krawędzią do paska przewijania, a nie do krawędzi okna formularza, gdyż wtedy pasek przewijania częściowo zasłoni przesuwany formant.
Poziomy pasek przewijania zasłania Przyciski nawigacyjne
Wzorując się na przykładzie Paski przewijania Access i opisanej tam funkcji accScrollBars(...) powinniśmy pobrać styl okna formularza za pomocą funkcji GetWindowLong(...):
lWindowStyle = GetWindowLong(Me.hwnd, GWL_STYLE)
i korzystając z operatora bitowego AND sprawdzić, czy widoczny jest poziomy i pionowy pasek przewijania
If (lWindowStyle AND WS_HSCROLL) = WS_HSCROLL Then ' jest poziomy pasek przewijania
If (lWindowStyle AND WS_VSCROLL) = WS_VSCROLL Then ' jest pionowy pasek przewijania
Niestety, metoda ta nie sprawdza się w przypadku okien formularza. Zwracana wartość lWindowStyle nie zawiera stylu WS_HSCROLL ani WS_VSCROLL i zawsze uzyskamy wynik, że żaden pasek przewijania nie jest widoczny w oknie formularza.
Paski przewijania okna formularza nie są identyfikowane.
Różnice pomiędzy oknem roboczym MS Access, a oknem formularza.
Aby wychwycić różnice pomiędzy oknami, musimy najechać myszką na pasek przewijania okna roboczego MS Access i odczytać za pomocą funkcji API jakie okno znajduje się pod kursorem myszy.
Poziomy i pionowy pasek przewijania okna roboczego MS Access
Istotne informacje to takie, że okno robocze MS Access jest oknem klasy „MDIClient”. Styl tego okna określa, że jest oknem potomnym (WS_CHILD) z widocznymi oboma paskami przewijania WS_HSCROLL i WS_VSCROLL. Oknem nadrzędnym jest okno „OMain”. Reszta danych nie wnosi nic istotnego do problemów widoczności pasków formularza.
Poziomy i pionowy pasek przewijania okna formularza
Już na pierwszy rzut oka widać, że okno formularza, to zupełnie inna „bajka” ☺.
Okno robocze „MDIClient” (ma paski przewijania) jest oknem nadrzędnym (rodzicem) okna formularza
„OForm”, które z kolei jest oknem nadrzędnym (rodzicem) okna „NUIScrollbar”,
a ono posiada okno potomne (dziecko) „NetUIHWND”.
Formularz posiada dwa okna klasy „NUIScrollbar”,
• pierwsze ma spolszczony tytuł „Poziom”,
• drugie posiada tytuł „Pion”.
I tymi dwoma oknami zajmiemy się dokładniej. Najpierw należy znaleźć okno „NetUIHWND”. Jeżeli jesteśmy pewni,
że zawsze będziemy używać wersji polskojęzycznej, to w ostatnim argumencie lpszWindow możemy
zamienić wartość vbNullString na tytuł okna "Poziom":
hNUIHor = FindWindowEx(Me.hwnd, 0&, "NUIScrollbar", vbNullString)
następnie pobieramy styl okna „NetUIHWND”:
lWindowStyle = GetWindowLong(hNUIHor, GWL_STYLE)
i sprawdzamy, czy okno „NetUIHWND” jest widoczne:
If (lWindowStyle AND WS_VISIBLE) = WS_VISIBLE Then ' jest poziomy pasek przewijania
Czy widoczny jest pionowy i (lub) poziomy pasek przewijania formularza?
Właściwość ScrollBars formularza
Bardzo prowizoryczna i niepewna metoda, opierająca się na wykluczeniu pewnych opcji daje nam właściwość ScrollBars formularza. Poniżej przedstawiam wnioski (kolorem brązowym co można wywnioskować ze zwróconej wartości ScrollBars formularza. Więcej o właściwości ScrollBars na stronie Paski przewijania formularza i pola tekstowego
| Me.ScrollBars | Opis |
|---|---|
| 0 |
Żaden pasek przewijania nie pojawi się w formularzu. Poziomy i pionowy pasek przewijania jest niewidoczny |
| 1 |
Poziomy pasek przewijania może pojawić się w formularzu. Pionowy pasek przewijania jest niewidoczny |
| 2 |
Pionowy pasek przewijania może pojawić się w formularzu. Poziomy pasek przewijania jest niewidoczny |
| 3 |
Pionowy i poziomy pasek przewijania może pojawić się w formularzu Poziomy i (lub) pionowy pasek przewijania może być widoczny |
Praktycznie właściwości ScrollBars nie daje jednoznacznych odpowiedzi na pytanie, które paski przewijania formularza są widoczne. Pewniejsza jest informacja, które paski nie są widoczne.
Funkcja formScrollBars(hForm As Long) As Long
⊗ Private Function formScrollBars(hForm As Long) As Long
- Sprawdza, które paski przewijania okna formularza o uchwycie hForm są widoczne
- argumenty:
- hForm
- uchwyt okna formularza
- 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: 11.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
Private Declare PtrSafe Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWndParent As LongPtr, _
ByVal hWndChildAfter As LongPtr, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As LongPtr
#ElseIf VBA7 Then
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWndParent As LongPtr, _
ByVal hWndChildAfter As LongPtr, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As LongPtr
#Else
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" ( _
ByVal hWndParent As Long, _
ByVal hWndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As Long
#End If
' stała określające przesunięcie argumentu nIndex :
Private Const GWL_STYLE = (-16) 'styl 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
Private Const WS_VISIBLE = &H10000000 'okno jest widoczne po utworzeniu
#If VBA7 Then
Private Function formScrollBars(hForm As LongPtr) As Long
#Else
Private Function formScrollBars(hForm As Long) As Long
#End If
#If VBA7 Then
Dim lStyleHor As LongPtr
Dim lStyleVert As LongPtr
Dim hNUIHor As LongPtr
Dim hNUIVert As LongPtr
#Else
Dim lStyleHor As Long
Dim lStyleVert As Long
Dim hNUIHor As Long
Dim hNUIVert As Long
#End If
Const cNUIScrollbar As String = "NUIScrollbar"
' szukaj w formularzu pierwszego okna klasy "NUIScrollbar"
' ewentualnie szukaj okna o spolszczonej nazwie "Poziom"
hNUIHor = FindWindowEx(hForm, 0&, cNUIScrollbar, vbNullString)
'hNUIHor = FindWindowEx(hForm, 0&, cNUIScrollbar, "Poziom")
' szukaj w formularzu drugiego okna klasy "NUIScrollbar"
' ewentualnie szukaj okna o spolszczonej nazwie "Pion"
hNUIVert = FindWindowEx(hForm, hNUIHor, cNUIScrollbar, vbNullString)
'hNUIVert = FindWindowEx(hForm, hNUIHor, cNUIScrollbar, "Pion")
If hNUIHor = 0 Or hNUIVert = 0 Then
' coś poszło nie tak
formScrollBars = -1
Exit Function
End If
' pobierz style okien klasy "NUIScrollbar"
#If VBA7 Then
lStyleHor = GetWindowLongPtr(hNUIHor, GWL_STYLE)
lStyleVert = GetWindowLongPtr(hNUIVert, GWL_STYLE)
#Else
lStyleHor = GetWindowLong(hNUIHor, GWL_STYLE)
lStyleVert = GetWindowLong(hNUIVert, GWL_STYLE)
#End If
' porównaj bitowo style okien ze stylem WS_VISIBLE
If ((lStyleHor And WS_VISIBLE) = WS_VISIBLE) And ((lStyleVert And WS_VISIBLE) = WS_VISIBLE) Then
formScrollBars = 3
ElseIf ((lStyleVert And WS_VISIBLE) = WS_VISIBLE) Then
formScrollBars = 2
ElseIf ((lStyleHor And WS_VISIBLE) = WS_VISIBLE) Then
formScrollBars = 1
End If
End Function
' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim lRetVal As Long
' pobierz pseudowłaściwość ScrollBar
lRetVal = formScrollBars(Me.hwnd)
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
Paski przewijania okna formularza są identyfikowane.
Przykład ten nie będzie działał w MS Access w wersji 2003-. Spróbuj wtedy zmienić wartość stałej Const cNUIScrollbar As String = "NUIScrollbar" na "Scrollbar".
Do pobrania:
•