|
| | | |
 • II.1. VBA - Okna MS Access [2] •
- 1.10 Jak zdezaktywować przycisk X na pasku tytułowym okna Accessa, menu systemowe oraz zablokować kombinację klawiszy Alt+F4 zamykającą bazę ?
- 1.11 Jak przesunąć okno Accessa na wierzch, gdy jest ono zminimalizowane lub przesłonięte przez inne okna ?
- <<• idź do str. 1 •>>
| | | | |
 |
| | |
|
1.10 Jak zdezaktywować przycisk X na pasku tytułowym okna Accessa, menu systemowe oraz zablokować kombinację klawiszy Alt+F4 zamykającą bazę ?
• Aby uniemożliwić użytkownikowi zamknięcie bazy danych poprzez kliknięcie przycisku X na pasku tytułowym Accessa musimy ten przycisk uczynić nieaktywnym. Aby tego dokonać skorzystamy z gotowego przykładu: Dezaktywacja menu systemowego i przycisku X oraz napisać dodatkową funkcję blokujacą kombinację klawiszy Alt+F4
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOZORDER = &H4
Private Const SWP_FRAMECHANGED = &H20
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Const GCL_STYLE = -26
Private Const CS_NOCLOSE = &H200
Private Const GCL_MENUNAME = (-8)
Private Declare Function DrawMenuBar Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, _
ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" _
(ByVal hAcc As Long) As Long
Private Declare Function EnableMenuItem Lib "user32" _
(ByVal hAcc As Long, _
ByVal wIDEnableItem As Long, _
ByVal wEnable As Long) As Long
Private Const MF_BYPOSITION = &H400
Private Const MF_DISABLED = &H2
Private Const MF_GRAYED = &H1
Private Sub zbEnableX(hWind As Long, fEnabled As Boolean)
Dim hSysMnu As Long
Dim lCountMnu As Long
Dim lOldStyle As Long
Dim lNewStyle As Long
Const MY_POS As Long = 1
' 1. Dezaktywacja menu systemowego i przycisku X
hSysMnu = GetSystemMenu(hWind, False)
If hSysMnu <> 0 Then
lCountMnu = GetMenuItemCount(hSysMnu)
If fEnabled Then
EnableMenuItem hSysMnu, _
lCountMnu - MY_POS, _
MF_BYPOSITION And Not _
(MF_DISABLED Or MF_GRAYED)
Else
EnableMenuItem hSysMnu, _
lCountMnu - MY_POS, _
MF_BYPOSITION Or _
(MF_DISABLED Or MF_GRAYED)
End If
DrawMenuBar hSysMnu
End If
lOldStyle = GetClassLong(hWind, GCL_STYLE)
' 2. dezaktywacja przycisku X oraz kombinacji klawiszy Alt+F4
If fEnabled Then
lNewStyle = lOldStyle And Not CS_NOCLOSE
lOldStyle = SetClassLong(hWind, GCL_STYLE, lNewStyle)
Else
lNewStyle = lOldStyle Or CS_NOCLOSE
lOldStyle = SetClassLong(hWind, GCL_STYLE, lNewStyle)
End If
' wymuś odświeżenie okna
Call SetWindowPos(hWind, 0&, 0&, 0&, 0&, 0&, _
SWP_NOSIZE Or SWP_NOMOVE Or _
SWP_FRAMECHANGED Or SWP_NOZORDER)
End Sub
Private Sub btnTest_Click()
Call zbEnableX(Application.hWndAccessApp, False)
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
1.11 Jak przesunąć okno Accessa na wierzch, gdy jest ono zminimalizowane lub przesłonięte przez inne okna ?
Problem:
<cyt>
Załóżmy, że mam otwartego Access, a w nim bazę, która ma ustawiony timer w formularzu, który co 10 sek. sprawdza, czy nastąpiło jakieś zdarzenie np. wybiła godzina 12:00. Gdy zdarzenie nastąpi, formularz wykrywa je i otwiera formularz który ma komunikat: "WŁAŚNIE WYBIŁA 12:00" i dodatkowo generuje dźwięk.
[...]
Jest godz 11:55, otwieram DODATKOWO na cały ekran przeglądarkę internetową i przeglądam strony. Cały czas w tle pracuje Access. Dochodzi godzina 12:00 i Access wykrywa to, otwiera formularz i generuje dźwięk. Dźwięk jest słyszalny, ale okienka nie widzę ponieważ aktualnie na całym ekranie mam przeglądarkę.
Jak zrobić, aby Access przysłonił przeglądarkę (może być cały Access lub samo okienko otwieranego formularza z komunikatem) ?
potrzebujący
</cyt>
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_MINIMIZE = 6
Private Const SW_RESTORE = 9
' zmienna przechowująca godzinę powiadomienia
Private m_dtTime As Date
' przykładowe wywołanie:
Private Sub btnTest_Click()
' ustawiamy godzinę (datę) zdarzenia
m_dtTime = CDate("16:14:50")
' uruchamiamy Timer formularza
Me.TimerInterval = 1000
End Sub
Private Sub Form_Timer()
If Time > m_dtTime Then
' w timerze formularza sprawdzamy, czy Access jest aktywny
' porównując uchwyt aktywnego okna z uchwytem okna Accessa
If GetActiveWindow <> Application.hWndAccessApp Then
' wyłączamy Timer
Me.TimerInterval = 0
' dodatkowo ukrywamy okno Accessa, by wyeliminować chwilowe migotanie okna podczs minimalizowania
ShowWindow Application.hWndAccessApp, SW_HIDE
' minimalizujemy okno Accessa, ponieważ inaczej nie zadziała następna instrukcja przywracająca rozmiar okna Accessa
ShowWindow Application.hWndAccessApp, SW_MINIMIZE
ShowWindow Application.hWndAccessApp, SW_RESTORE
' może trochę pokretny sposób uaktywniania okna Accessa, ale nie mogłem w żaden sposób "ujarzmić" poniższych funkcji API:
' SetWindowPos Me.hwnd, HWND_NOTOPMOST, ......
' SetForegroundWindow Application.hWndAccessApp
' BringWindowToTop Application.hWndAccessApp
' apiSetFocus Application.hWndAccessApp
End If
End If
End Sub
ΔΔΔ | | | | |
|
| |
