问调整OSK.exe窗口大小的VBA

EN

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public 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

Public Const SWP_NOSIZE = &H1
Public Const HWND_TOPMOST = -1

Sub Sample()
    Dim Ret As Long, retval As Long
    Dim Shex As Object

    Set Shex = CreateObject("Shell.Application")
    Shex.Open ("C:\Windows\System32\osk.exe")

    Wait 1

    Ret = FindWindow("OSKMainClass", "On-Screen Keyboard")

    If Ret <> 0 Then
        'Msgbox "On-Screen Keyboard Window Found"
        retval = SetWindowPos(Ret, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE)
        DoEvents

        If retval = False Then MsgBox "Unable to move Window"
    End If
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SetCursorPos Lib "user32" _
(ByVal X As Integer, ByVal Y As Integer) As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Sub mouse_event Lib "user32.dll" (ByVal dwFlags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Private Const MOUSEEVENTF_MOVE = &H1          ' mouse move
Private Const MOUSEEVENTF_LEFTDOWN = &H2      ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4        ' left button up
Private Const MOUSEEVENTF_ABSOLUTE = &H8000   ' absolute move

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Dim pos As RECT


Sub Sample()
    Dim Ret As Long, retval As Long
    Dim Shex As Object

    Set Shex = CreateObject("Shell.Application")
    Shex.Open ("C:\Windows\System32\osk.exe")

    Wait 1

    Ret = FindWindow("OSKMainClass", "On-Screen Keyboard")

    If Ret <> 0 Then
        GetWindowRect Ret, pos

        '~~> Get the co-ordinates of some point in titlebar
        cur_x = pos.Left + 10
        cur_y = pos.Top + 10

        '~~> New Destination (Top Left Corner of Desktop)
        dest_x = 0
        dest_y = 0

        '~~> Move the cursor to a place in titlebar
        SetCursorPos cur_x, cur_y
        Wait 1 '<~~ Wait 1 second

        '~~> Press the left mouse button on the Title Bar
        mouse_event MOUSEEVENTF_LEFTDOWN, cur_x, cur_y, 0, 0

        '~> Set the new destination. Take cursor there
        SetCursorPos dest_x, dest_y

        '~~> Press the left mouse button again to release it
        mouse_event MOUSEEVENTF_LEFTUP, dest_x, dest_y, 0, 0
        Wait 1

        MsgBox "done"

    End If
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub