Tekst informacyjny o polityce Cookies Close   
    
 
         
• Strona główna
• 1. Linki
• 3. Kontakt: e-Mail
 
         
• 1. Baza danych
• 2. Tabele i kwerendy
• 3. Formularze
• 4. Raporty
• 5. Moduły i makra
• 6. Obsługa błędów
 
    

II.   VBA 

    
• 1. Okna Accessa
• 2. Okna Formularzy
• 3.Okna Dialogowe
• 4. Tekst
• 5. Liczby
• 6. Pliki
• 7. Inne
 
    

III.   API 

    
• 1. Ogólnie o API
• 2. Funkcje API
• 3. System
• 4. Praca z oknami
• 5. Okna dialogowe
• 6. API - Inne
 
         
• 1. Bitmapy 24 Bit
• 2. GDI i HDC
• 3. Kody kreskowe
• 4. Formant Image
• 5. FreeImage.dll
 
    

V.   Inne 

    
• 1. Shell i MsDOS
• 2. Kontrolki
• 3. ६ԼҚ ਸ
• 4. Unikod

 
Odwiedzin:

Logo AccessFAQ• III.4. API - Funkcje API i okna •

4.1 Jak pobrać uchwyt okna mającego fokus ?
4.2 Jak pobrać uchwyt aktywnego okna ?
4.3 Jak pobrać tytuł okna (tekst okna) ?
4.4 Jak zmienić tytuł okna (tekst okna) ?
4.5 Jak pobrać nazwę klasy okna ?
4.6 Jak pobrać identyfikator okna mając jego uchwyt, jak pobrać uchwyt rodzica okna
oraz jak pobrać uchwyt okna mając jego ID i uchwyt rodzica ?
4.7 Jak pobrać pozycję kursora myszy oraz uchwyt i wymiary okna znajdującego się pod kursorem myszy ?
4.8 Jak utworzyć własne okno klasy EDIT, ale bez obsługi zdarzeń ?
4.9 Jak odczytać styl okna ?
4.10 Jak pobrać właściwości okna znajdującego się aktualnie pod wskaźnikiem myszy ?
 

4.1 Jak pobrać uchwyt okna mającego fokus ?

Private Declare Function GetFocus Lib "user32" () As Long


' bardziej szczegółowe zastosowanie tej metody omówiono w dziale VBA - Okna formularzy
Private Sub btnTest_Click()
Dim hWind As Long

hWind = GetFocus
' w przypadku formularza, jeżeli fokus będzie miał inny formant niż TextBox, ComboBox lub ListBox, to zwrócony uchwyt będzie uchwytem formularza !
MsgBox "hWind = " & hWind & vbNewLine & _
"Me.hwnd = " & Me.hwnd

End Sub

 ΔΔΔ 

 

4.2 Jak pobrać uchwyt aktywnego okna ?

Private Declare Function GetActiveWindow Lib "user32" () As Long



' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim hActiveWind As Long

    hActiveWind = GetActiveWindow
    MsgBox "hActiveWind = " & hActiveWind

End Sub

 ΔΔΔ 

 

4.3 Jak pobrać tytuł okna (tekst okna) ?

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 SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
wParam As Any, _
lParam As Any) As Long
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_GETTEXT = &HD


' Metoda 1 - w metodzie tej musimy określić przewidywaną maksymalną długość pobieranego tekstu, przy zbyt małej wielkości bufora lMaxSizeBuffer pobrany tekst zostanie ucięty
Private Function zbGetTextWind_1(hWind As Long, _
Optional lMaxSizeBuffer As Long = 256) As String
Dim sBff As String
Dim lRet As Long

    sBff = String(lMaxSizeBuffer, vbNullChar)
    lRet = GetWindowText(hWind, sBff, lMaxSizeBuffer)

    zbGetTextWind_1 = Left$(sBff, lRet)

End Function


' Metoda 2 - w metodzie tej nie musimy znać długości pobieranego tekstu,
Private Function zbGetTextWind_2(hWind As Long) As String
Dim sBff As String
Dim lLen As Long
Dim lRet As Long

' pobierz długość tekstu
lLen = SendMessage(hWind, WM_GETTEXTLENGTH, _
ByVal 0&, ByVal 0&) + 1&
' przygotuj buffor na tekst
sBff = String(lLen, vbNullChar)
' pobierz tekst i zwróć długość pobranego tekstu
lRet = SendMessage(hWind, WM_GETTEXT, _
ByVal lLen, ByVal sBff)

zbGetTextWind_2 = Left$(sBff, lRet)

End Function


' przykładowe wywołanie:
Private Sub btnTest_Click()
    MsgBox _
"Okno formularza: " & _
zbGetTextWind_1(Me.hwnd) & vbNewLine & _
"Okno Accessa: " & _
zbGetTextWind_2(Application.hWndAccessApp)
End Sub

 ΔΔΔ 

 

4.4 Jak zmienić tytuł okna (tekst okna) ?

Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal Msg As Long, _
wParam As Any, _
lParam As Any) As Long
Private Const WM_SETTEXT = &HC


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

    ' Metoda 1 -zmień tytuł okna Access'a
    SetWindowText Application.hWndAccessApp, _
"Nowy tytuł okna Accessa"
    ' Metoda 2 -zmień tytuł okna formularza
    SendMessage Me.hwnd, WM_SETTEXT, _
ByVal 0&, ByVal "Nowy tytuł formularza"

End Sub

 ΔΔΔ 

 

4.5 Jak pobrać nazwę klasy okna ?

Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long

Private Function zbGetClassName(hWind As Long) As String
Dim lRet As Long
Dim sBff As String
Const MY_SIZEBUFFER As Long = 256

    sBff = String(MY_SIZEBUFFER, vbNullChar)
    lRet = GetClassName(hWind, sBff, MY_SIZEBUFFER)
    zbGetClassName = Left$(sBff, lRet)

End Function


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

    MsgBox "Klasa okna Accessa: " & _
zbGetClassName(Application.hWndAccessApp) & _
vbNewLine & _
"Klasa okna formularza: " & _
zbGetClassName(Me.hwnd)

End Sub

 ΔΔΔ 

 

4.6 Jak pobrać identyfikator okna mając jego uchwyt, jak pobrać uchwyt rodzica okna oraz jak pobrać uchwyt okna mając jego ID i uchwyt rodzica ?

Private Declare Function GetDlgItem Lib "user32" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long) As Long
Private Declare Function GetDlgCtrlID Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetParent Lib "user32" _
(ByVal hwnd As Long) As Long


' zwraca Identyfikator okna o uchwycie hWind, lub ZERO
Private Function zbGetIDWind(hWind As Long) As Long
    zbGetIDWind = GetDlgCtrlID(hWind)
End Function


' zwraca uchwyt okna o ID= lID, które jest dzieckiem okna hDlg, lub ZERO
Private Function zbGetHwindByID(hDlg As Long, lID As Long) As Long
    zbGetHwindByID = GetDlgItem(hDlg, lID)
End Function


' zwraca uchwyt okna będącego rodzicem okna hWind
Private Function zbGetParent(hWind As Long) As Long
    zbGetParent = GetParent(hWind)
End Function


' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim lID As Long
Dim hParent As Long
Dim hByID As Long

    ' pobierz identyfikator okna
    lID = zbGetIDWind(Me.hwnd)
    ' pobierz uchwyt rodzica
    hParent = zbGetParent(Me.hwnd)
    ' pobierz uchwyt okna o identyfikatorze lID, które jest dzieckiem okna hParent
    hByID = zbGetHwindByID(hParent, lID)
    MsgBox "Uchwyty okien powinny być takie same:" & _
vbNewLine & _
Space(15) & hByID & " = " & Me.hwnd
End Sub

 ΔΔΔ 

 

4.7 Jak pobrać pozycję kursora myszy oraz uchwyt i wymiary okna znajdującego się pod kursorem myszy ?

Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function WindowFromPoint Lib "user32" _
(ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type


' przy powodzeniu zwraca wartość różną od ZERA, a w argumentach ByRef współrzędne X,Y kursora
Private Function zbGetCursorPos(Optional lRetX As Long = 0, _
Optional lRetY As Long = 0) As Long
Dim papi As POINTAPI

    zbGetCursorPos = GetCursorPos(papi)
    lRetX = papi.x
    lRetY = papi.y

End Function


' zwraca uchwyt okna zawierający punkt lX, lY, dla okna Static Text zwraca uchwyt okna nadrzędnego, nie zwraca uchwytu okna ukrytego lub nieaktywnego
Private Function zbGetWindowFromPoint(lX As Long, lY As Long) As Long
    zbGetWindowFromPoint = WindowFromPoint(lX, lY)
End Function


' przy powodzeniu zwraca wartość różną od ZERA, a w argumentach ByRef zwraca położenie X,Y lewego górnego narożnika okna (współrzędne ekranowe) oraz szerokość i wysokość okna (w pikselsch).
Private Function zbGetWindowRect(hWind As Long, _
Optional lLeftRet As Long = 0, _
Optional lTopRet As Long = 0, _
Optional lWidthRet As Long = 0, _
Optional lHeightRet As Long = 0) As Long
Dim rct As RECT

zbGetWindowRect = GetWindowRect(hWind, rct)
With rct
lLeftRet = .Left
lTopRet = .Top
lWidthRet = .Right - .Left
lHeightRet = .Bottom - .Top
End With

End Function


' przykładowe wywołanie:
' • wciśnij lewy przycisk myszy nad przyciskiem i przesuwaj
'    wskaźnik myszy nad oknami

Private Sub btnTest_MouseMove(Button As Integer, Shift As Integer, _
x As Single, y As Single)
Dim lX As Long, lY As Long
Dim lLeft As Long, lTop As Long
Dim lWidth As Long, lHeight As Long
Dim hWind As Long

If Button = acLeftButton Then
Me.Caption = ""
If zbGetCursorPos(lX, lY) = 0 Then Exit Sub
hWind = zbGetWindowFromPoint(lX, lY)
If hWind = 0 Then Exit Sub
If zbGetWindowRect(hWind, lLeft, lTop, lWidth, lHeight) = 0 Then
Exit Sub
End If
Me.Caption = "X=" & lX & ", Y=" & lY & _
", Left=" & lLeft & ", Top=" & lTop & _
", Width=" & lWidth & ", Height=" & lHeight
End If

End Sub

 ΔΔΔ 

 

4.8 Jak utworzyć własne okno klasy EDIT, ale bez obsługi zdarzeń ?

Private Declare Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateWindowEx Lib "user32" _
Alias "CreateWindowExA" _
(ByVal dwExStyle As Long, _
ByVal lpClassName As String, _
ByVal lpWindowName As String, _
ByVal dwStyle As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hWndParent As Long, _
ByVal hMenu As Long, _
ByVal hInstance As Long, _
lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Private Const WS_SYSMENU = &H80000
Private Const WS_THICKFRAME = &H40000
Private Const WS_POPUP = &H80000000
Private Const WS_VISIBLE = &H10000000
Private Const ES_MULTILINE = &H4
Private hNewWnd As Long


' przykładowe wywołanie:
' • wciśnij i przytrzymaj lewy przycisk myszy
Private Sub btnTest_MouseDown( _
Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim lWinStyle As Long

    ' sprawdź, czy okno istnieje
    If IsWindow(hNewWnd) <> 0 Then DestroyWindow (hNewWnd)
    lWinStyle = ES_MULTILINE Or WS_THICKFRAME Or _
WS_POPUP Or WS_VISIBLE
    hNewWnd = CreateWindowEx(0&, "EDIT", _
"To jest Twoje okno." & vbNewLine & _
"Zwolnij lewy przycisk myszy.", lWinStyle, _
30&, 90&, 220&, 110, _
GetDesktopWindow, 0&, 0&, 0&)
    DoEvents
End Sub


Private Sub btnTest_MouseUp( _
Button As Integer, Shift As Integer, _
X As Single, Y As Single)
' zniszcz okno
If IsWindow(hNewWnd) <> 0 Then DestroyWindow (hNewWnd)
End Sub

 ΔΔΔ 

 

4.9 Jak odczytać styl okna ?

Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Const WS_CLIPSIBLINGS = &H4000000' odzielny obszar okien klienta i child
Const WS_DISABLED = &H8000000' okno jest nieaktywne po utworzeniu
Const WS_DLGFRAME = &H400000' pogrubiona obramowanie typu okna dialogowego
Const WS_GROUP = &H20000' widoczne okna będące obiektami sterujacymi
Const WS_HSCROLL = &H100000' okno posiada poziomy pasek przwijania
Const WS_MAXIMIZE = &H1000000' okno jest zmaksymalizowane po utworzeniu
Const WS_MAXIMIZEBOX = &H10000' widoczny przycisk maksymalizacji
Const WS_MINIMIZE = &H20000000' okno jest zminimmalizowane po utworzeniu
Const WS_ICONIC = WS_MINIMIZE' jak WS_MINIMIZE
Const WS_MINIMIZEBOX = &H20000' widoczny przycisk minimilizacji
Const WS_OVERLAPPED = &H0' okno ma pasek tytułowy oraz ramkę
Const WS_POPUP = &H80000000' okno PopuUp, nie można razem z WS_CHILD
Const WS_SYSMENU = &H80000' okno z menu systemowym. Zawiera WS_CAPTION
Const WS_TABSTOP = &H10000' możliwe przełączanie za pomocą TAB
Const WS_THICKFRAME = &H40000' jak WS_SIZEBOX
Const WS_SIZEBOX = WS_THICKFRAME' możliwa jest zmiana rozmiaru okna
Const WS_TILED = WS_OVERLAPPED' jak WS_OVERLAPPEDWINDOW
Const WS_VISIBLE = &H10000000' okno jest widoczne po utworzeniu
Const WS_VSCROLL = &H200000' okno posiada pionowy pasek przewijania
Const WS_BORDER = &H800000' okno z cienkim obramowaniem
Const WS_CAPTION = &HC00000' okno z paskiem tytułowym, (zawiera WS_BORDER )
Const WS_CHILD = &H40000000' okno typu child, nie można razem z WS_POPUP
Const WS_CLIPCHILDREN = &H2000000' za duże okno child będzie obcinane



Private Function zbGetWindowStyle(hWind As Long, _
Optional fListStyle As Boolean = False, _
Optional sStyle As String = "") As Long
Dim vArrStyle As Variant
Dim lStyle As Long
Dim i As Byte
Const GWL_STYLE = (-16)

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_OVERLAPPED", WS_OVERLAPPED, _
"WS_POPUP", WS_POPUP, _
"WS_SYSMENU", WS_SYSMENU, _
"WS_TABSTOP", WS_TABSTOP, _
"WS_THICKFRAME", WS_THICKFRAME, _
"WS_VISIBLE", WS_VISIBLE, _
"WS_VSCROLL", WS_VSCROLL)

lStyle = GetWindowLong(hWind, GWL_STYLE)
If lStyle = 0 Then
Exit Function
Else
zbGetWindowStyle = lStyle
End If

If fListStyle Then
For i = LBound(vArrStyle) To UBound(vArrStyle) Step 2
If (CBool(lStyle And vArrStyle(i + 1))) = True Then
sStyle = sStyle & vArrStyle(i) & "; "
End If
Next
If Len(sStyle) > 1 Then
sStyle = Left$(sStyle, Len(sStyle) - 2)
End If
End If

End Function


' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim sRet As String
Dim lRet As Long

    lRet = zbGetWindowStyle( _
Application.hWndAccessApp, True, sRet)
    MsgBox "Styl okna = " & lRet & vbNewLine & sRet

End Sub

 ΔΔΔ 

 

4.10 Jak pobrać właściwości okna znajdującego się aktualnie pod wskaźnikiem myszy ?


Właściwości okna pod wskaźnikiem myszy

   Przykład:  • api23a_09  •  52 KB  •  status: FREE  Pobrano    razy   


 ΔΔΔ