Inspired =)
Профиль
Группа: Экс. модератор
Сообщений: 1535
Регистрация: 7.5.2005
Репутация: 6
Всего: 191
|
Вот накидал пример. На всякий случай полный проект в аттаче. Позволяет сделать MessageBox с таймаутом закрытия, время в секундах задается в переменной Interval и отображается на кнопке OK (по умолчанию). Если у вас несколько MsgBox, вы можете отличать их не только по имени класса. В общем, это лишь показательный пример  Код модуля: | Код |
Option Explicit
' Declarations
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public 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
Public Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public 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 GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Interval As Long
Public SetWProc As Boolean
Public Const WM_CLOSE = &H10
Const GWL_HWNDPARENT = (-8)
Const MAX_PATH = 260
Function EnumProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim S As String
Dim CL As Long
Dim Btn As Long
EnumProc = True
If GetWindowLong(hwnd, GWL_HWNDPARENT) = Form1.hwnd Then
S = Space(MAX_PATH)
CL = GetClassName(hwnd, S, MAX_PATH)
If CL <> 0 Then
S = Left(S, CL)
If S = "#32770" Then
If Not SetWProc Then
Btn = FindWindowEx(hwnd, 0, "Button", vbNullString)
' Время срабатывания
Interval = 20
Call SetTimer(Btn, 125, 1000, AddressOf BtnTimerProc)
Call BtnTimerProc(Btn, 0, 0, 0)
SetWProc = True
Call KillTimer(hwnd, 124)
EnumProc = False
End If
End If
End If
End If
End Function
Sub TimerProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal IDEvent As Long, ByVal Time As Long)
Call EnumWindows(AddressOf EnumProc, 0)
End Sub
Sub BtnTimerProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal IDEvent As Long, ByVal Time As Long)
Dim T1, T2 As String
T1 = CStr(Interval)
Interval = Interval - 1
T2 = "OK (" & T1 & ")"
Call SetWindowText(hwnd, T2)
If Interval < 0 Then
Call KillTimer(hwnd, 125)
Call SendMessage(GetParent(hwnd), WM_CLOSE, 0, 0)
End If
End Sub
|
Код формы с одной кнопкой - показ MessageBox: | Код |
Private Const MB_ICONEXCLAMATION = &H30&
Private Sub Command1_Click()
Call SetTimer(0, 124, 55, AddressOf TimerProc)
Call MessageBox(Me.HWnd, "Dummy! :)", "Information", MB_ICONEXCLAMATION)
SetWProc = False
End Sub
Private Sub Form_Load()
SetWProc = False
End Sub
|
Способ 2: | Код |
Option Explicit
' Declarations
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public 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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public 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 GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Interval As Long
Public SetWProc As Boolean
Public Const WM_CLOSE = &H10
Const GWL_HWNDPARENT = (-8)
Sub TimerProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal IDEvent As Long, ByVal Time As Long)
Dim Wnd As Long
Dim Btn As Long
Wnd = FindWindow("#32770", "Information")
If Wnd <> 0 Then
If GetWindowLong(Wnd, GWL_HWNDPARENT) = Form1.hwnd Then
If Not SetWProc Then
Btn = FindWindowEx(Wnd, 0, "Button", vbNullString)
' Время срабатывания
Interval = 20
Call SetTimer(Btn, 125, 1000, AddressOf BtnTimerProc)
Call BtnTimerProc(Btn, 0, 0, 0)
SetWProc = True
Call KillTimer(hwnd, 124)
End If
End If
End If
End Sub
Sub BtnTimerProc(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal IDEvent As Long, ByVal Time As Long)
Dim T1, T2 As String
T1 = CStr(Interval)
Interval = Interval - 1
T2 = "OK (" & T1 & ")"
Call SetWindowText(hwnd, T2)
If Interval < 0 Then
Call KillTimer(hwnd, 125)
Call SendMessage(GetParent(hwnd), WM_CLOSE, 0, 0)
End If
End Sub
|
MsgBoxTimeOut.rar 5,87 Kb |
Как создать MessageBox с таймаутом автозакрытия, How to create MessageBox with timeout 
Дата 28.3.2008, 12:29 (
Загрузка ...
