VBA 调整 OSK.exe 窗口的大小

Question

我正在开发一个 Kiosk 类型(没有鼠标，没有键盘)的应用程序，用户可以在其中将数据输入到 Excel 电子表格中。我想让屏幕键盘每次被调用时都出现在同一个地方。 osk.exe 窗口“记住”它在关闭时所在的位置，并会在下次打开时重新出现在同一位置，但在关闭后，osk 会返回到其默认位置并覆盖表单。

我需要一种方法来设置 osk 打开时的位置。下面是我打开 osk 的代码。

   Dim Shex As Object
   Dim tgtfile As String

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

我想知道是否有类似 Shex.Top = 250 之类的东西。

谢谢!

Answer 1

不幸的是，SetWindowPos API 和 FindWindow API 不适用于 OSKMainClass("On-Screen Keyboard") 我尝试了各种组合，但它继续失败。似乎它没有被视为普通窗口。

注意:在 Excel 2010(32 位)、Windows 8.1 64 位(触摸屏是否重要？)中测试代码

这是我试过的代码。 (这行不通)

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