|
| | | |
 • II.3. VBA - Okna dialogowe •
- 3.1 Jak pobrać uchwyt okna dialogowego, przecież wywołanie takiego okna wstrzymuje dalsze wykonywanie kodu ?
- 3.2 Jak wyświetlić okno komunikatu, tak by pojawiło się na ekranie, gdy okno Accessa jest (zminimalizowane) nieaktywne przez 3 sek. ?
- 3.3 Jak zmienić wprowadzane znaki w InputBox'ie na ****** ?
- 3.4 Jak sprawdzić, czy w InputBox'ie kliknięto przycisk Anuluj czy OK ?
- 3.5 Jak z MsgBox'a zrobić prymitywny pasek postępu ?
- 3.6 Jak do MsgBox'a wstawić wbudowany wskaźnik postępu MS Access ?
- 3.7 Jak z okna MsgBox'a skopiować tekst komunikatu, zamiast go żmudnie przepisywać ?
- 3.8 Jak zmienić tekst na przyciskach w oknie MsgBox'a ?
| | | | |
 |
| | |
|
3.1 Jak pobrać uchwyt okna dialogowego, przecież wywołanie takiego okna wstrzymuje dalsze wykonywanie kodu ?
Private Declare Function GetActiveWindow Lib "user32" () As Long
' poniższe funkcje zadeklarowano jedynie dla potrzeb testu
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Sub btnTest_Click()
' uruchamiamy Timer, wyświetlamy okno dialogowe i pozostałą część operacji wykonujemy w Form_Timer
Me.TimerInterval = 1500
MsgBox "Okno dialogowe, którego szukamy.", vbExclamation
End Sub
Private Sub Form_Timer()
Dim hActiveWind As Long
Dim hWind As Long
' wyłączamy Timer
Me.TimerInterval = 0
hActiveWind = GetActiveWindow
' Test - sprawdźmy, czy znaleźliśmy właściwe okno
hWind = FindWindowEx(hActiveWind, 0&, _
"Static", vbNullString)
' ukryj ikonę vbExclamation
ShowWindow hWind, False
hWind = FindWindowEx(hActiveWind, hWind, _
"Static", vbNullString)
SetWindowText hWind, "Znaleźliśmy je !" & vbNewLine & _
" Uchwyt okna = " & hActiveWind
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
3.2 Jak wyświetlić okno komunikatu, tak by pojawiło się na ekranie,
gdy okno Accessa jest zminimalizowane (nieaktywne) ?
Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType As Long) As Long
Private Const MB_SYSTEMMODAL = &H1000&
Private Const MB_TOPMOST = &H40000
Private Const MB_YESNO = &H4&
Private Const MB_ICONQUESTION = &H20&
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_MINIMIZE = 6
Private Const SW_RESTORE = 9
' przykładowe wywołanie:
Private Sub btnTest_Click()
' minimalizujemy Access'a uruchamiamy Timer
ShowWindow Application.hWndAccessApp, SW_MINIMIZE
Me.TimerInterval = 3000
End Sub
Private Sub Form_Timer()
Dim hWind As Long
Dim lRet As Long
' w timerze formularza sprawdzamy, czy Access jest aktywny porównując uchwyt aktywnego okna z uchwytem okna Accessa
If GetActiveWindow <> Application.hWndAccessApp Then
' wyłączmay Timer
Me.TimerInterval = 0
lRet = zbSysModalMsgBox( _
"Czy zamknąć bazę danych ?", _
"Nieaktywny Access ", _
MB_SYSTEMMODAL Or _
MB_TOPMOST Or MB_YESNO Or _
MB_ICONQUESTION)
If lRet = vbNo Then
ShowWindow Application.hWndAccessApp, SW_RESTORE
Me.TimerInterval = 3000
Else
DoCmd.Quit
End If
End If
End Sub
' wyświetla okno komunikatu, zwraca wartość przycisku, który wybrał użytkownik
Private Function zbSysModalMsgBox( _
sMsg As String, _
sCaption As String, _
lType As Long) As Long
zbSysModalMsgBox = MessageBox( _
Application.hWndAccessApp, _
sMsg, sCaption, lType)
End Function
ΔΔΔ | | | | |
|
|
| | |
|
3.3 Jak zmienić wprowadzane znaki w InputBox'ie na ****** ?
Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 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 EM_SETPASSWORDCHAR = &HCC
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_GETTEXT = &HD
Private Const WM_SETTEXT = &HC
Private Const EM_SETSEL = &HB1
Private Const MY_PASSWORD_CHAR As Long = 42
Private sDefPsw As String
' przykładowe wywołanie:
Private Sub btnTest_Click()
Dim sRet As String
sDefPsw = "Domyślne hasło"
' uruchom Timer formularza
Me.TimerInterval = 50
' wywołaj InputBox i wpisz gwiazdki, bo przez chwilę jest widoczny jawny tekst,
' reszta zostanie wykonana w Form_Timer
sRet = InputBox("Wprowadź tekst:", "Wpisz hasło", _
String(Len(sDefPsw), _
MY_PASSWORD_CHAR))
If Len(sRet) = 0 Then
MsgBox "Anulowano lub usunięto tekst w InputBox'ie." & _
Else
MsgBox sRet
End If
End Sub
Private Sub Form_Timer()
Dim hWind As Long
Me.TimerInterval = 0
' hWind = FindWindowEx( _
GetActiveWindow, ByVal 0&, _
"Edit", vbNullString)
' lub
hWind = GetFocus
If hWind = 0 Then Exit Sub
SendMessage hWind, _
EM_SETPASSWORDCHAR, _
ByVal MY_PASSWORD_CHAR, _
ByVal 0&
SendMessage hWind, WM_SETTEXT, _
ByVal 0&, ByVal sDefPsw
SendMessage hWind, EM_SETSEL, _
ByVal 0&, ByVal -1&
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
3.4 Jak sprawdzić, czy w InputBox'ie kliknięto przycisk Anuluj czy OK ?
Private Sub knInputBoxCancelOrOK()
Dim s As String
s = InputBox("Wpisz coś")
If StrPtr(s) Then
MsgBox "wpisano: """ & s & """", , "knInputBox"
Else
MsgBox "Wciśnięto Anuluj", , "knInputBox"
End If
End Sub
' dla tych co nie lubią nieudokumentowanych funkcji:
Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Private Sub zbInputBoxCancelOrOK()
Dim sOut As String
sOut = Space$(255)
lstrcpy sOut, InputBox("Wprowadź tekst:", "zbInputBox")
sOut = RTrim$(sOut)
If Len(sOut) = 0 Then
MsgBox "Anulowano.", , "zbInputBox"
Else
sOut = Left$(sOut, InStr(1, sOut, _
vbNullChar, vbBinaryCompare) - 1)
MsgBox "Wprowadzono:[" & sOut & "]", , _
"zbInputBoxCancelOrOK"
End If
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
3.5 Jak z MsgBox'a zrobić prymitywny pasek postępu ?
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetDlgItem Lib "user32" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem As Long) As Long
Private Declare Function EnableWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal fEnable 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_CLOSE = &H10
Private Const WM_SETTEXT = &HC
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) 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
Private Declare Function MoveWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Private Const MY_SIZE_PROGBAR As Long = 32
Private Const MY_CHAR_PROGBAR As String = "#"
Private Const MY_CHR_END As String = "="
Private Type typeMSGBOX
hWndMsg As Long
hBtnOK As Long
hWndStatic As Long
End Type
Private msg As typeMSGBOX
Private lMaxFor As Long
Private Const MY_ID_BTN_OK As Long = 2
Private Const MY_CLASS_STATIC As String = "Static"
' zainicjuj pasek postępu
Private Sub zbIniMsgProgBar()
' uruchom Timer
Me.TimerInterval = 200
' zablokuj odświeżanie pulpitu
LockWindowUpdate GetDesktopWindow
' wywołaj MsgBox, by zrobić z niego ProgressBar
MsgBox "" & vbNewLine & vbNewLine & _
String(MY_SIZE_PROGBAR, _
MY_CHAR_PROGBAR), vbExclamation
LockWindowUpdate False
End Sub
Private Sub Form_Timer()
Dim i As Integer
Dim rctOK As RECT
Dim rctMsg As RECT
Dim hTmp As Long
On Error Resume Next
Me.TimerInterval = 0
With msg
' pobierz uchwyt MsgBox'a i przycisku OK
.hWndMsg = GetActiveWindow
.hBtnOK = GetDlgItem(.hWndMsg, MY_ID_BTN_OK)
' deaktywuj przycisk OK
EnableWindow .hBtnOK, False
' pobierz wymiary okna MsgBox i położenie btnOK
GetWindowRect .hWndMsg, rctMsg
GetWindowRect .hBtnOK, rctOK
' przytnij okno MsgBox nad przyciskiem btnOK
With rctMsg
MoveWindow msg.hWndMsg, .Left, .Top, _
.Right - .Left, _
rctOK.Top - .Top, True
End With
DoEvents
' szukaj ostatniego okna klasy "Static"
Do
hTmp = FindWindowEx(.hWndMsg, ByVal hTmp, _
MY_CLASS_STATIC, vbNullString)
If hTmp <> 0 Then .hWndStatic = hTmp
Loop Until hTmp = 0
' wyzeruj tekst
SendMessage .hWndStatic, WM_SETTEXT, _
ByVal 0&, ByVal vbNullString
End With
' odblokuj odświeżanie
LockWindowUpdate False
DoEvents
' uruchom procedurę przetwarzania
Call zbUpdateMsgProgBar(MY_CHR_END)
End Sub
' ze względu na wykorzystanie okna MsgBox'a jako właściciela paska postępu, musimy poniżej rozpisać całą procedurę przetwarzania
Private Sub zbUpdateMsgProgBar( _
Optional sChrEnd As String = " ")
Dim snCountStep As Single
Dim sStr As String
Dim i As Long
Dim j As Long
Dim k As Long
snCountStep = MY_SIZE_PROGBAR / lMaxFor
REM If Len(sChrEnd) = 0 Then sChrEnd = " "
For i = 0 To lMaxFor
j = CLng(i * snCountStep)
If j > k Then
k = j
sStr = "Wykonuję operację: " & _
CLng(j / snCountStep) & " z " & lMaxFor & _
vbNewLine & vbNewLine & _
String(k, MY_CHAR_PROGBAR)
sStr = sStr & String(MY_SIZE_PROGBAR - k, sChrEnd)
SendMessage msg.hWndStatic, WM_SETTEXT, _
ByVal 0&, ByVal sStr
End If
Sleep 10&
Next
' wtrzymaj działanie, <= tylko w celach poglądowych
Sleep 500&
' zamknij okno MsgBox
EnableWindow msg.hBtnOK, True
SendMessage msg.hWndMsg, WM_CLOSE, _
ByVal 0&, ByVal 0&
End Sub
' przykładowe wywołanie:
Private Sub btnTest_Click()
' ustaw ilość operacji
lMaxFor = 250
zbIniMsgProgBar
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
3.6 Jak do MsgBox'a wstawić wbudowany wskaźnik postępu MS Access ?
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) 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
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Private Declare Function MoveWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Declare Function EnableWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal fEnable As Long) As Long
Private Declare Function GetDlgItem Lib "user32" ( _
ByVal hDlg As Long, _
ByVal nIDDlgItem 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_CLOSE = &H10
Private Const WM_SETTEXT = &HC
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Private Declare Function GetSystemMetrics Lib "user32" _
(ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION = 4&
Private Const SM_CXDLGFRAME = 7&
Private Const SM_CYDLGFRAME = 8&
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Type typeMSGBOX
hWndMsg As Long
hBtnOK As Long
hWndStatic As Long
End Type
| Private hOldParent As Long | ' uchwyt rodzica wskaźnika postępu |
| Private hProgBar As Long | ' uchwyt okna wskaźnika postępu |
| Private hStatBar As Long | ' uchwyt okna StatusBar |
| Private rctProgBar As RECT | ' struktura RECT wskaźnika postępu |
| Private fStatBarVisible As Boolean | ' początkowy stan paska stanu |
| Private lMySizeProgBar As Long | ' wysokość wskaźnika postępu (od 20 do 50 pikseli) |
| Private msg As typeMSGBOX | ' uchwyty okien MsgBox'a |
Private Const MY_ID_BTN_OK As Long = 2
Private Const MY_CLASS_STATIC As String = "Static"
Private Const MY_TEXT_MSGBOX As String = "qwerty"
Private Sub zbIniMsgProgBar( _
Optional lSizeProgBar As Long = 28)
fStatBarVisible = Application.GetOption("Show Status Bar")
' możesz ukryć pozostałości paska stanu
' Application.SetOption ("Show Status Bar"), False
' doświadczalnie dobrane ograniczenia
If lSizeProgBar > 50 Then
lMySizeProgBar = 50
ElseIf lSizeProgBar < 21 Then
lMySizeProgBar = 21
Else
lMySizeProgBar = lSizeProgBar
End If
' uruchom Timer
Me.TimerInterval = 100
' wywołaj MsgBox, by wstawić do niego wskaźnik postępu
MsgBox MY_TEXT_MSGBOX
End Sub
Private Sub Form_Timer()
On Error GoTo ErrHandler
| Dim rctMsg As RECT | ' struktura RECT okna komunikatu |
| Dim rctStatic As RECT | ' struktura RECT pola tekstowego MsgBox |
| Dim lHCaption As Long | ' wysokość paska tytułowego okna |
| Dim lHBorder As Long | ' wysokość okna dialogowego |
| Dim lWBorder As Long | ' szerokość okna dialogowego |
| Dim lWProgBar As Long | ' przewidywana szerokość wskaźnika postępu |
| Dim lWMsg As Long | ' szerokość okna MsgBox |
| Dim lHMsg As Long | ' wysokość okna MsgBox |
| Dim lRet As Long | ' zwracana wartość |
| Const MY_MARGIN As Long = 20 | ' margines MsgBox'a z prawej strony |
Me.TimerInterval = 0
lWProgBar = (lMySizeProgBar - 12&) * 20& + 6&
' pobierz wysokość paska tytułowego okna
' i wymiary obramowania okna
lHCaption = GetSystemMetrics(SM_CYCAPTION)
lHBorder = GetSystemMetrics(SM_CXDLGFRAME)
lWBorder = GetSystemMetrics(SM_CYDLGFRAME)
msg.hWndMsg = GetActiveWindow
hStatBar = FindWindowEx( _
Application.hWndAccessApp, _
ByVal 0&, "OStatbar", vbNullString)
hProgBar = FindWindowEx( _
hStatBar, ByVal 0&, _
"OStatProg", vbNullString)
' pobierz wymiary okna MsgBox
GetWindowRect msg.hWndMsg, rctMsg
' znajdź uchwyt przycisku OK
msg.hBtnOK = GetDlgItem(msg.hWndMsg, _
MY_ID_BTN_OK)
ShowWindow msg.hBtnOK, False
EnableWindow msg.hBtnOK, False
DoEvents
' niestety MS zmienił ID okna klasy Static w Acc2k
' znajdź uchwyt okna tekstowego
' REM hStatic = GetDlgItem(hDlgMsg, cIdStatic)
' tutaj zakładam, że okno to jest ostatnim dzieckiem okna MsgBox
' W razie problemów można pobrać tekst okna i porównać
' z MY_TEXT_MSGBOX= "qwerty"
msg.hWndStatic = 0
Do
lRet = FindWindowEx( _
msg.hWndMsg, _
ByVal msg.hWndStatic, _
MY_CLASS_STATIC, _
vbNullString)
If lRet = 0 Then Exit Do
msg.hWndStatic = lRet
Loop Until lRet = 0&
' pobierz wymiary okna tekstowego
GetWindowRect msg.hWndStatic, rctStatic
' pobierz wymiary wskaźnika postępu
GetWindowRect hProgBar, rctProgBar
' szerokość okna MsgBox
lWMsg = rctMsg.Right - rctMsg.Left
' jeżeli wskaźnik zaawansowania jest szerszy niż okno MsgBox
With rctMsg
If lWProgBar > lWMsg - 20& Then
.Left = .Left - ((lWProgBar - lWMsg) \ 2&) - MY_MARGIN
.Right = .Right + ((lWProgBar - lWMsg) \ 2&) + MY_MARGIN
End If
' przytnij okno MsgBox poniżej okna tekstowego i powiększ o lMySizeProgBar
.Bottom = .Bottom - (.Bottom - rctStatic.Bottom) + _
lMySizeProgBar
lHMsg = .Bottom - .Top
End With
' ustaw nowego rodzica dla wskaźnika postępu
hOldParent = SetParent(hProgBar, msg.hWndMsg)
With rctMsg
' ustaw wymiary okna MsgBox
MoveWindow msg.hWndMsg, .Left, .Top, _
.Right - .Left, .Bottom - .Top, True
' ustaw położenie i wymiar wskaźnika postępu
MoveWindow hProgBar, 0, _
lHMsg - lMySizeProgBar - _
(lHCaption + lHBorder + lWBorder), _
22& * lMySizeProgBar, _
lMySizeProgBar, True
' pobierz wymiary okna tekstowego
GetWindowRect msg.hWndStatic, rctStatic
' powiększ okno Static na przyjęcie dłuższego tekstu
MoveWindow msg.hWndStatic, rctStatic.Left - .Left, _
(rctStatic.Top - .Top) - (lHCaption + _
lHBorder + lWBorder), _
.Right - .Left - 20&, _
rctStatic.Bottom - rctStatic.Top, True
End With
LockWindowUpdate False
Call zbUpdateMsgProgBar
ExitHere:
Exit Sub
ErrHandler:
DoCmd.SetWarnings True
LockWindowUpdate False
MsgBox Err.Description
Resume ExitHere
End Sub
' ze względu na wykorzystanie MsgBox'a,
' musimy poniżej wpisać całą
' procedurę przetwarzania pętli
Private Sub zbUpdateMsgProgBar()
Dim sStr As String
Dim lMyForTo As Long
Dim i As Long
' musimy znać zakres wywoływanej pętli
lMyForTo = 250
' zainicjuj pasek postępu
Application.SysCmd acSysCmdInitMeter, " ", lMyForTo
' wykonaj przykładową pętlę
For i = 1 To lMyForTo
Application.SysCmd acSysCmdUpdateMeter, i
DoEvents
sStr = "Wykonuję operację: " & i & " z " & lMyForTo
SendMessage msg.hWndStatic, WM_SETTEXT, _
ByVal 0&, ByVal sStr
' zwolnij pętlę w celach poglądowych
Sleep 10&
Next
' usuń wskaźnik postępu
Call zbRemoveMsgProgBar
End Sub
Private Sub zbRemoveMsgProgBar()
' przywróć wskaźnika postępu rodzicowi
hOldParent = SetParent(hProgBar, hOldParent)
' przywróć stare ustawienia wskaźnika postępu
With rctProgBar
MoveWindow hProgBar, 0&, 0&, _
.Right - .Left, .Bottom - .Top, True
End With
' zamknij okno MsgBox i usuń pasek postępu
EnableWindow msg.hBtnOK, True
SendMessage msg.hWndMsg, WM_CLOSE, _
ByVal 0&, ByVal 0&
Application.SysCmd acSysCmdClearStatus
Application.SysCmd acSysCmdRemoveMeter
Application.SetOption ("Show Status Bar"), fStatBarVisible
DoEvents
End Sub
Private Sub btnTest_Click()
On Error Resume Next
LockWindowUpdate GetDesktopWindow
Call zbIniMsgProgBar(28)
LockWindowUpdate False
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
3.7 Jak z okna MsgBox'a skopiować tekst komunikatu, zamiast go żmudnie przepisywać ?
<cyt>
Totalnie NTG, ale założę się o cokolwiek, że 95% czytających tego posta zaklnie siarczyście w duszy, że tego nie znało wcześniej...
Mianowicie...
Dowolny MsgBox z dowolnej aplikacji Windows ma tę właściwość, że reaguje
(poprawnie!) na Ctrl-C. Wystarczy potem odpalić notepada i wykonać Ctrl-V...
Przyznać się, kto ile razy w życiu przepisywał jakiś długachny komunikat błędu ... :)
ΔΔΔ | | | | |
|
|
| | |
|
3.8 Jak zmienić tekst na przyciskach w oknie MsgBox'a ?
Private Declare Function LockWindowUpdate Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private aBtnTitle(0 To 2) As String
Private Sub btnTest_Click()
Me.TimerInterval = 140
Call LockWindowUpdate(GetDesktopWindow)
' przypisz tytuły dla poszczególnych przycisków okna
aBtnTitle(0) = "Pierwszy"
aBtnTitle(1) = "Drugi"
aBtnTitle(2) = "Trzeci"
'MsgBox "Mój komunikat !", vbYesNo
MsgBox "Mój komunikat !", vbAbortRetryIgnore
End Sub
Private Sub Form_Timer()
Dim hWind As Long
Dim hBtn As Long
Dim i As Long
On Error Resume Next
Me.TimerInterval = 0
' pobierz uchwyt aktywnego okna
hWind = GetActiveWindow
' szukaj przycisków w oknie MsgBox'a i zmieniaj kolejno tytuły
hBtn = FindWindowEx(hWind, 0&, _
"Button", vbNullString)
Do Until hBtn = 0
SetWindowText hBtn, aBtnTitle(i)
hBtn = FindWindowEx(hWind, hBtn, _
"Button", vbNullString)
i = i + 1
Loop
Call LockWindowUpdate(False)
On Error GoTo 0
End Sub
ΔΔΔ | | | | |
|
| |
