poniedziałek, 1 lutego 2016

• Funkcje API - jak pobrać tytuł (tekst) okna

Czasami w trakcie działania aplikacji MS Access potrzebujemy sprawdzić jaki tytuł (lub tekst) ma okno w systemie Windows. MS Access posiada właściwości pozwalające na odczyt tytułów niektórych okien. Jest to właściwość obiekt.Caption obiektu formularz i obiektu raport. Właściwości obiekt.Caption nie należy mylić z właściwością obiekt.Name, gdyż ta ostatnia zwraca nazwę obiektu, która została podana w trakcie zapisywania projektu. Nazwa ta jest widoczna w „Oknie nawigacji”, dawniej zwanym „Oknem bazy danych”.

Warto pamiętać, że jeżeli w oknie „Arkusz właściwości”, w trybie „Projektowanie”, nie nadamy właściwości Tytuł (Caption) jakiejkowiek wartości (pozostawimy to pole puste), to otwarty formularz (raport) będzie miał tytuł odpowiadający jego nazwie, a właściwość obiekt.Caption będzie ciągiem zerowej długości "". Jak widać, okno formularza (raportu) może mieć tytuł odpowiadający nazwie obiektu obiekt.Name, lub jego tytułowi obiekt.Caption (jeżeli takowa właściwość została ustawiona w oknie „Projektowanie”)

Zagadnienie pobrania tytułu okna jest bardziej skomplikowane, w przypadku pobierania tytułu okna Aplikacji (napis na pasku tytułowym okna MS Access). Teoretycznie sprawa jest niby prosta. Tytuł okna bazy danych przechowywany jest we właściwości CurrentDb.Properties("AppTitle"), ale w przypadku próby pobrania tej właściwości, gdy nie jest ona ustawiona w oknie „Opcje programu Access/Bieżąca baza danych/Tytuł aplikacji”, program MS Access wygeneruje błąd Error.Number = 3270 i wyświetli okno komunikatu o treści:

Aby nasz kod działał prawidłowo, musimy obsłużyć błąd nr 3270, generowany przy próbie odczytu nieistniejącej właściwości "AppTitle", by wyświetlić odpowiednią informację, że nasza aplikacja nie ma ustawionego tytułu.


    MsgBox Forms("NazwaFormularza").Caption '(formularz musi być otwarty)
    ' lub
    MsgBox Me.Caption '(dla bieżącego formularza)
    ' podobnie dla raportu
    MsgBox Reports("NazwaRaportu").Caption '(raport musi być otwarty)
    ' lub
    MsgBox Me.Caption '(dla bieżącego raportu)

 
 ' Okno MS Access 
  ' dla okna bieżącej aplikacji musimy obsłużyć błąd nr 3270,
  ' generowany przy próbie odczytu nieistniejącej właściwości "AppTitle":
  Private Const conPropNotFoundError = 3270
  
  On Error Resume Next
    MsgBox CurrentDb.Properties("AppTitle") ' właściwość musi być ustawiona
    If Err.Number = conPropNotFoundError Then
      MsgBox "Bieżąca Aplikacja:" & vbNewLine & _
            CurrentDb.Name & vbNewLine & _
            "nie posiada tytułu."
      Err.Clear
    End If
  On Error GoTo 0
 

Ale nie zawsze jest tak prosto. Czasami potrzebujemy pobrać tekst (tytuł) okna aplikacji, która nie udostępnia metody pozwalajacej na pobranie tekstu okna. Wtedy z pomocą przychodzi interfejs Windows API i jego dwie funkcje:
• GetWindowTextLength - zwracającą długość tekstu okna o przekazanym w argumencie uchwycie hwnd
• GetWindowText - zwracającą długość pobranego do buforu tekstu okna, a w buforze właściwy tekst okna o uchwycie hwnd.

Option Compare Database
Option Explicit

' • Function GetTextWindow(hWind As Long;[LongLong];[LngPtr]) As String
' --------------------------------------------------------------
' autor: Zbigniew Bratko - 01.2016
' [hWind] - uchwyt okna, którego tytuł (tekst) będzie pobierany
'           w środowisku 32 bitowym liczba typu Long
'           w środowisku 64 bitowym liczba typy LongLong
'           w środowisku VBA7 może być typu LongPtr
' [Out] - zwraca tytuł (tekst) okna
' Przy niepowodzeniu zwraca ciąg zerowej długości ""
'

#If VBA7 Then
  ' Środowisko VBA 7 - zarówno 32 jak i 64 bitowe
  Private Declare PtrSafe Function GetWindowText Lib "user32" _
          Alias "GetWindowTextA" _
          (ByVal hwnd As LongPtr, _
          ByVal lpString As String, _
          ByVal cch As Long) As Long
  Private Declare PtrSafe Function GetWindowTextLength Lib "user32" _
           Alias "GetWindowTextLengthA" ( _
           ByVal hwnd As LongPtr) As Long
#Else
  ' Środowisko VBA 6 - tylko 32 bitowe
  Private Declare Function GetWindowText Lib "user32" _
          Alias "GetWindowTextA" _
          (ByVal hwnd As Long, _
          ByVal lpString As String, _
          ByVal cch As Long) As Long
  Private Declare Function GetWindowTextLength Lib "user32" _
          Alias "GetWindowTextLengthA" ( _
          ByVal hwnd As Long) As Long
#End If

' Funkcja własna GetTextWindow
#If VBA7 Then
  ' Deklaracja funkcji - zarówno w 32 jak i 64 bitowym środowisku VBA 7
  Public Function GetTextWindow(hWind As LongPtr) As String
#Else
  ' Deklaracja funkcji - tylko 32 bitowe środowisko VBA 6
  Public Function GetTextWindow(hWind As Long) As String
#End If
 
Dim sBuffer    As String
Dim lLenText   As Long
 
   ' pobierz długość tekstu okna
   lLenText = GetWindowTextLength(hWind)
   ' uwzględnij dodawany znak końca ciągu znaków
   lLenText = lLenText + 1
   ' przygotuj buffor na przyjęcie tekstu
   sBuffer = String(lLenText, vbNullChar)
   ' pobierz długość zwróconego tekstu
   lLenText = GetWindowText(hWind, sBuffer, lLenText)
   ' utnij nadmiarowy ciąg znaków vbNullChar w buforze
   GetTextWindow = Left$(sBuffer, lLenText)
 
End Function

' przykładowe wywołanie:
Private Sub btnTest_Click()

  ' pobierz tytuł okna bieżącej aplikacji MS Access
  MsgBox GetTextWindow(Application.hWndAccessApp)

Exit Sub