VBIDEUtils/MsgBox.bas at master · tannerhelland/VBIDEUtils · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
Attribute VB_Name = "MsgBox_Module"
' #VBIDEUtils#************************************************************
' * Programmer Name  : removed
' * Web Site         : http://www.ppreview.net
' * E-Mail           : removed
' * Date             : 09/14/2000
' * Time             : 15:44
' * Module Name      : MsgBox_Module
' * Module Filename  : MsgBox.bas
' **********************************************************************
' * Comments         :
' *
' *
' **********************************************************************

Option Explicit

Private Const NV_CLOSEMSGBOX = &H5000&
Private Const NV_MOVEMSGBOX = &H5001&
Private Const NV_TOPMSGBOX = &H5002&
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1

Private Type RECT
   left                 As Long
   top                  As Long
   right                As Long
   bottom               As Long
End Type
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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
   ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
   ByVal nIDEvent As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Private mTitle          As String
Private mX              As Long
Private mY              As Long
Private mPause          As Long
Private mHandle         As Long

Public Function MsgBoxTop(ByVal hWnd As Long, ByVal sPrompt As String, Optional nButtons As Long = vbInformation + vbOKOnly, Optional sTitle As String = "") As Integer
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : removed
   ' * Web Site         : http://www.ppreview.net
   ' * E-Mail           : removed
   ' * Date             : 06/08/2001
   ' * Time             : 23:42
   ' * Module Name      : MsgBox_Module
   ' * Module Filename  : MsgBox.bas
   ' * Procedure Name   : MsgBoxTop
   ' * Parameters       :
   ' *                    ByVal hwnd As Long
   ' *                    ByVal sPrompt As String
   ' *                    Optional nButtons As Long = vbInformation + vbOKOnly
   ' *                    Optional sTitle As String = ""
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************
   mTitle = sTitle
   SetTimer hWnd, NV_TOPMSGBOX, 0&, AddressOf NewTimerProc
   MsgBoxTop = MessageBox(hWnd, sPrompt, sTitle, nButtons)

End Function

Public Function MsgBoxMove(ByVal hWnd As Long, ByVal sPrompt As String, ByVal sTitle As String, ByVal nButtons As Long, ByVal inX As Long, ByVal inY As Long) As Integer
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : removed
   ' * Web Site         : http://www.ppreview.net
   ' * E-Mail           : removed
   ' * Date             : 09/14/2000
   ' * Time             : 15:44
   ' * Module Name      : MsgBox_Module
   ' * Module Filename  : MsgBox.bas
   ' * Procedure Name   : MsgBoxMove
   ' * Parameters       :
   ' *                    ByVal hwnd As Long
   ' *                    ByVal sPrompt As String
   ' *                    ByVal sTitle As String
   ' *                    ByVal nButtons As Long
   ' *                    ByVal inX As Long
   ' *                    ByVal inY As Long
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************
   mTitle = sTitle: mX = inX:  mY = inY
   SetTimer hWnd, NV_MOVEMSGBOX, 0&, AddressOf NewTimerProc
   MsgBoxMove = MessageBox(hWnd, sPrompt, sTitle, nButtons)
End Function

Public Function MsgBoxPause(ByVal hWnd As Long, ByVal sPrompt As String, ByVal sTitle As String, ByVal nButtons As Long, ByVal inPause As Integer) As Integer
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : removed
   ' * Web Site         : http://www.ppreview.net
   ' * E-Mail           : removed
   ' * Date             : 09/14/2000
   ' * Time             : 15:44
   ' * Module Name      : MsgBox_Module
   ' * Module Filename  : MsgBox.bas
   ' * Procedure Name   : MsgBoxPause
   ' * Parameters       :
   ' *                    ByVal hwnd As Long
   ' *                    ByVal sPrompt As String
   ' *                    ByVal sTitle As String
   ' *                    ByVal nButtons As Long
   ' *                    ByVal inPause As Integer
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************
   mTitle = sTitle: mPause = inPause * 1000
   SetTimer hWnd, NV_CLOSEMSGBOX, mPause, AddressOf NewTimerProc
   MsgBoxPause = MessageBox(hWnd, sPrompt, sTitle, nButtons)
End Function

Public Function NewTimerProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : removed
   ' * Web Site         : http://www.ppreview.net
   ' * E-Mail           : removed
   ' * Date             : 09/14/2000
   ' * Time             : 15:44
   ' * Module Name      : MsgBox_Module
   ' * Module Filename  : MsgBox.bas
   ' * Procedure Name   : NewTimerProc
   ' * Parameters       :
   ' *                    ByVal hwnd As Long
   ' *                    ByVal Msg As Long
   ' *                    ByVal wparam As Long
   ' *                    ByVal lparam As Long
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

   Dim w                As Single
   Dim h                As Single
   Dim mBox             As RECT

   KillTimer hWnd, wParam
   Select Case wParam
      Case NV_CLOSEMSGBOX:
         ' A system class is a window class registered by the system which cannot
         ' be destroyed by a processed, e.g. #32768 (a menu), #32769 (desktop
         ' window), #32770 (dialog box), #32771 (task switch window).
         mHandle = FindWindow("#32770", mTitle)
         If mHandle <> 0 Then
            SetForegroundWindow mHandle
            SendKeys "{enter}"
         End If

      Case NV_TOPMSGBOX:
         mHandle = FindWindow("#32770", mTitle)
         If mHandle <> 0 Then
            w = Screen.Width / Screen.TwipsPerPixelX
            h = Screen.Height / Screen.TwipsPerPixelY
            GetWindowRect mHandle, mBox
            mX = (w - (mBox.right - mBox.left) - 1) / 2
            mY = (h - (mBox.bottom - mBox.top) - 1) / 2
            ' SWP_NOSIZE is to use current size, ignoring 3rd & 4th parameters.
            SetWindowPos mHandle, HWND_TOPMOST, mX, mY, 0, 0, SWP_NOSIZE
         End If

      Case NV_MOVEMSGBOX:
         mHandle = FindWindow("#32770", mTitle)
         If mHandle <> 0 Then
            w = Screen.Width / Screen.TwipsPerPixelX
            h = Screen.Height / Screen.TwipsPerPixelY
            GetWindowRect mHandle, mBox
            If mX > (w - (mBox.right - mBox.left) - 1) Then mX = (w - (mBox.right - mBox.left) - 1)
            If mY > (h - (mBox.bottom - mBox.top) - 1) Then mY = (h - (mBox.bottom - mBox.top) - 1)
            If mX < 1 Then mX = 1: If mY < 1 Then mY = 1
            ' SWP_NOSIZE is to use current size, ignoring 3rd & 4th parameters.
            SetWindowPos mHandle, HWND_TOPMOST, mX, mY, 0, 0, SWP_NOSIZE
         End If
   End Select
End Function