|
| | | |
 • 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 ?
ΔΔΔ | | | | |
|
| |
