You can specify the display position of the input dialog or message box when it starts.
After manually moving to the new position, the last position will be remembered, and the new dialog box will be displayed in the same coordinate position.
After manually moving to the new position, the last position will be remembered, and the new dialog box will be displayed in the same coordinate position.
Code:
Private Sub Form_Load()
InputX = 300 * Screen.TwipsPerPixelX
InputY = 500 * Screen.TwipsPerPixelY
End Sub
Private Sub Command1_Click()
Dim S As String
S = InputboxXY("Please Input Your Password", , True, "Tip Info", InputX, InputY)
MsgBox "S=" & S
End SubCode:
Public InputX As Long, InputY As Long
Dim PassMode As Boolean
Dim FindInput As Boolean, InputTitle As String
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Dim lngTimerID As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) 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
Public Const EM_SETPASSWORDCHAR = &HCC
Function InputboxXY(Optional Title As String, Optional Default As String, Optional PassModeA As Boolean, Optional Prompt As String, Optional XPos, Optional YPos)
If Title = "" Then Title = App.Title
InputTitle = Title
FindInput = False
PassMode = PassModeA
lngTimerID = SetTimer(0, 0, 15, AddressOf TimerProc)
If InputX > 0 Then XPos = InputX: YPos = InputY
If IsMissing(XPos) Then
InputboxXY = InputBox(Prompt, Title, Default)
Else
InputboxXY = InputBox(Prompt, Title, Default, XPos, YPos)
End If
End Function
Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
Static Rect1 As RECT
Dim win As Long, InputHwd As Long
win = FindWindow(vbNullString, InputTitle)
If win > 0 Then
If IsWindowVisible(win) Then
If FindInput = False Then
FindInput = True
If PassMode Then
InputHwd = FindWindowEx(win, 0, "edit", vbNullString)
SendMessage InputHwd, EM_SETPASSWORDCHAR, 42, 0
End If
End If
GetWindowRect win, Rect1
End If
ElseIf FindInput Then
KillTimer 0, lngTimerID
InputX = Rect1.Left * Screen.TwipsPerPixelX
InputY = Rect1.Top * Screen.TwipsPerPixelY
End If
End Sub