Odczyt listy fontów z zakładki " Arkusz danych "
okna "Narzędzia/Opcje"

Przed przystąpieniem do odczytu listy fontów musimy wcześniej dokładnie zapoznać się ze struktura okna "Opcje", dla każdej aktywnej zakładki, korzystając z metod opisanych przy zapoznawaniu się ze strukturą okna <<"Ustawienia strony" >>.

Okno SysTabControl32 - struktura

Wiemy, że okno to posiada 10 zakładek, po 5 w dwóch rzędach. Nas interesuje zakładka " Arkusz danych ", ponieważ tam znajduje się okno klasy CboBox z listą fontów. Niestety, nie wiemy czy po otwarciu okna nasza zakładka będzie się znajdowała w dolnym czy górnym rzędzie, ponieważ Access w danej sesji przechowuje ID ostatnio zatwierdzonej przez kliknięcie OK zakładki.

' ID okna z zakładkami (okno SysTabControl32)
Const cIDSysTabCtl As Long = 12320
' ID okna klasy CboBox na zakładce " Arkusz danych "
Const cIDCboFont As Long = 3061

Uruchomiamy Timer formularza i wywołujemy Accessowe okno "Opcje"

Private Sub btnListFont2_Click()
      Me.TimerInterval = 50
      DoCmd.RunCommand acCmdOptions
End Sub

 

Kontynuacja odczytu listy fontów z okna SysTabControl32

Private Sub Form_Timer()
' Deklarujemy tablicę zawierająca ID dowolnych niepowtarzających się okien
' po jednym z każdej aktywnej zakładki leżącej w rzędzie nie zawierającym
' naszej zakładki "Arkusz danych".
Dim arrIdBtn(0 To 4) As Long

arrIdBtn(0) = 3002 ' gdy aktywna zakładka Widok - domyślna
arrIdBtn(1) = 3032 ' gdy aktywna zakładka Ogólne
arrIdBtn(2) = 3035 ' gdy aktywna zakładka Hiperłącza
arrIdBtn(3) = 3016 ' gdy aktywna zakładka Edycja
arrIdBtn(4) = 3081 ' gdy aktywna zakładka Klawiatura

' 1. pobieramy uchwyt aktywnego okna za pomocą funkcji GetActiveWindow ()

hActiveWnd = GetActiveWindow

' 2. uchwyt jakie ma okno SysTabControl32 (z zakładkami) posiadające ID=cIDSysTabCtl pobierzemy dzięki funkcji: GetDlgItem(hActiveWnd (...)

hSysTabCtl = GetDlgItem(hActiveWnd, cIDSysTabCtl)

' aby dowiedzieć się która, zakładka (rząd zakładek) jest aktywna musimy zrobić, z pozoru wiele niepotrzebnych rzeczy:

' 3. pobierz położenie jakie ma okno SysTabControl32 za pomocą GetWindowRect (...)

Dim rctSysTC As RECT

GetWindowRect hSysTabCtl, rctSysTC

' 4. pobierz uchwyt dziecka (klasa #32770) okna "Opcje" za pomocą GetWindow (...)

hChild = GetWindow(hActiveWnd, GW_CHILD)

' 5. pobierz położenie dziecka (klasa #32770) okna "Opcje" (tak jak w punkcie 1.)

Dim rctChild As RECT

GetWindowRect hChild, rctChild

' 6. oblicz wysokość dwóch rzędów zakładek

lSysTabH = rctChild.top - rctSysTC.top

' 7. Teraz w oknie o uchwycie hChild sprawdzamy funkcją GetDlgItem(...), czy jest tam okno klasy CboBox o identyfikatorze cIDCboFont = 3061 zawierające listę fontów

hCboFont = GetDlgItem(hChild, cIDCboFont)

' 8. Jeżeli hCboFont = 0 wiemy, że nie jest to zakładka "Arkusz danych". Musimy więc skorzystać z naszej tablicy arrIdBtn () zawierające Identyfikatory dowolnych, charakterystycznych okien zakładek leżących w jednym rzędzie i sprawdzić, w którym rzędzie znajduje się aktywna zakładka.

If hCboFont = 0 Then

' sprawdź, które rząd zakładek jest aktywny

For i = 0 To UBound(arrIdBtn)

      hBtn = GetDlgItem(hChild, arrIdBtn(i))

      If hBtn <> 0 Then Exit For

Next

End If

Sposób I:  Symulacja kliknięcia lewym przyciskiem myszy na zakładce w oknie SysTabControl32

'9. Jeżeli hBtn = 0 oznacza to, że nieaktywna zakładka "Arkusz danych" jest w dolnym rzędzie. W przeciwnym wypadku w górnym. Skoro wiemy, gdzie jest nasza zakładka przeniesiemy tam kursor myszy funkcją SetCursorPos (...) i zasymulujemy w tym punkcie kliknięcie lewym przyciskiem myszy przy pomocy funkcji mouse_event (...)

Dim papiNew As POINTAPI

If hBtn = 0 Then

' Zakładka Arkusz danych jest na dole, kursor myszy musi być
' przesunięty o ~30 pikseli w prawo i 2/3 lSysTabH w dół
papiNew.X = rctSysTC.left + 30
papiNew.Y = rctSysTC.top + CLng(lSysTabH * 0.66)

Else

' Zakładka Arkusz danych jest na górze, kursor myszy musi być
' przesunięty o ~30 pikseli w prawo i 1/3 lSysTabH w dół
papiNew.X = rctSysTC.left + 30
papiNew.Y = rctSysTC.top + CLng(lSysTabH * 0.33)

End If

'10. pobierz aktualne położenie kursora myszy funkcją GetCursorPos (...)

Dim papiOld As POINTAPI

GetCursorPos papiOld

' 11. przesuń kursor myszy nad zakładkę "Arkusz danych"

SetCursorPos papiNew.X, papiNew.Y

' 12. i kliknij lewym przyciskiem myszy nad zakładką "Arkusz danych"

mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0

mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

' 13. przywróć stare położenie kursora

SetCursorPos papiOld.X, papiOld.Y

Sposób II:  Wysłanie komunikatów WM_LBUTTONDOWN / WM_LBUTTONUP do okna SysTabControl32

      Nie chcąc się bawić w obliczanie nowego położenia kursora oraz jego przesuwanie i przywracaniem położenia, skorzystamy z funkcji SendMessage (...) z parametrami:

Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const MK_LBUTTON = &H1

Punkt kliknięcia iX, iY przekażemy jako parametr lParam = lDWORD

'9. Jeżeli hBtn = 0 oznacza to, że nieaktywna zakładka "Arkusz danych" jest w dolnym rzędzie. W przeciwnym wypadku w górnym. Skoro wiemy, gdzie jest nasza zakładka, to wyślemy tam komunikat o kliknięciu:

Dim iX As Integer
Dim iY As Integer
Dim lDWORD As Long

iX = 30 ' pikseli od lewej krawędzi okna
If hBtn = 0 Then
      iY = lSysTabH * 0.66
Else
      iY = lSysTabH * 0.33
End If

'10. Przekształć współrzędne kursora myszy iX, iT liczbę Long gdzie:
    ' LoWord zawiera współrzędną X, HiWord współrzędną Y

lDWORD = (iY * &H10000) Or (iX And &HFFFF&)

'11. i kliknij lewym przyciskiem myszy nad zakładką "Arkusz danych"

SendMessage hSysTabCtl, WM_LBUTTONDOWN, MK_LBUTTON, _
                            ByVal lDWORD
SendMessage hSysTabCtl, WM_LBUTTONUP, MK_LBUTTON, ByVal lDWORD

Sposób III:  Wysłanie komunikatów TCM_SETCURSEL, TCN_SELCHANGE i WM_NOTIFY do okna SysTabControl32

      Powyższe metody mają tę jedyną zaletę, że przełączają zakładkę, ale pobieranie wymiarów okien, położenia kursora, przemieszczanie kursora, symulowanie kliknięć i cała masa innych czynności sprawiają wrażenie wielkiej prowizorki. Spróbujmy użyć nieocenionej funkcji SendMessage (..)  z parametrami:

Private Const TCM_FIRST = &H1300

Private Const TCM_SETCURSEL = (TCM_FIRST + 12)

Private Const TCN_FIRST As Integer = -550

Private Const TCN_SELCHANGE = (TCN_FIRST - 1)

Private Const WM_NOTIFY = &H4E

Private Sub Form_Timer()
Dim hActiveWnd As Long
Dim hSysTabCtl As Long
Dim nmh As NMHDR
Dim lRet As Long

' pobieramy uchwyt aktywnego okna za pomocą funkcji GetActiveWindow ()

hActiveWnd = GetActiveWindow

' pobierz uchwyt jakie ma okno SysTabControl32

hSysTabCtl = GetDlgItem(hActiveWnd, cIDSysTabCtl)

' Sposób pobrania <<numerów zakładek i ich nazw>> znajduje się na końcu.

Dim lIdDS as Long

' Dla Acc97 lIdDS = 5; dla Acc2000 lIdDs = 4; Access XP - prawdopodobnie lIdDS = 4

' zaznacz zakładkę "Arkusz danych" (nr lIdDS;  liczone od 0).

lRet = SendMessage(hSysTabCtl, TCM_SETCURSEL, ByVal lIdDS , ByVal 0)

' Niestety, po zaznaczeniu zakładki, nie jest wysyłany przez okno SysTabControl32 komunikat powiadamiający okno rodzica o dokonanej zmianie. Musimy zrobić to sami:

' wypełnij strukturę NMHDR, by powiadomić rodzica

nmh.hwndFrom = hSysTabCtl

nmh.idFrom = 0 ' lub GetDlgCtrlID(hSysTabCtl)

nmh.code = TCN_SELCHANGE

' powiadom rodzica, że zaznaczono zakładką "Arkusz danych"

lRet = SendMessage(hActiveWnd, WM_NOTIFY, GetDlgCtrlID(hSysTabCtl), nmh)

Poniższe instrukcje odnoszą się do wszystkich trzech opisanych sposobów:

' Mając zaznaczoną odpowiednią zakładkę
' pobieramy uchwyt zakładki "Arkusz danych"
hChild = GetWindow(hActiveWnd, GW_CHILD)
' pobierz uchwyt CboBox Czcionka
hCboFont = GetDlgItem(hChild, cIDCboFont)
' Metoda pobrania wszystkich pozycji listy CboCzcionka była omówiona na przykładzie pobierania listy rozmiarów papieru w oknie "Ustawienia strony" za pomocą procedury zbGetItemList (...)
' pobierz listę czcionek z CboCzcionka
Call zbListFont(hCboFont, hActiveWnd)
' zamknij okno klikając przycisk Anuluj
SendMessage GetDlgItem(hActiveWnd, 2), BM_CLICK, ByVal 0, ByVal 0

End Sub

Odczyt listy zakładek z okna SysTabControl32 :

Aby wylistować wszystkie zakładki okna "Opcje" użyjemy funkcji SendMessage (..)  z parametrami:
Const TCIF_TEXT = 1
Const TCM_FIRST = &H1300
Const TCM_GETITEM = (TCM_FIRST + 5)
Const TCM_GETITEMCOUNT = TCM_FIRST + 4

Private Sub zbListTabCtl (hTabCtl As Long)
Dim tcith As TC_ITEMHEADER
Dim lCount As Long
Dim lRet As Long
Dim i As Long

tcith.mask = TCIF_TEXT
tcith.res1 = 0
tcith.res2 = 0
tcith.cchTextMax = 50
tcith.pszTxt = String(tcith.cchTextMax, vbNullChar)
tcith.iImage = -1
lCount = SendMessage(hTabCtl, TCM_GETITEMCOUNT, 0, 0)

' Tylko w celu wylistowania zakładek
For i = 0 To lCount - 1

lRet = SendMessage(hTabCtl, TCM_GETITEM, i, tcith)
Debug.Print i; tcith.pszTxt
tcith.pszTxt = String(tcith.cchTextMax, vbNullChar)

Next

End Sub