以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  [求助] 在文本框的当前输入位置打开独立窗口  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=78860)
--  作者：lsy
--  发布时间：2015/12/18 16:36:00
--  [求助] 在文本框的当前输入位置打开独立窗口
Forms("代码精灵").Open(System.Windows.Forms.Cursor.Position.X, System.Windows.Forms.Cursor.Position.Y)

想在文本框的当前输入位置打开窗口，上面的代码不灵。
--  作者：大红袍
--  发布时间：2015/12/18 17:06:00
--  

mark 获取焦点坐标

 

全局代码

 

#Region "得到光标在屏幕上的位置"
<DllImport("user32")> _
Public Function GetCaretPos(ByRef lpPoint As Point) As Boolean
End Function
<DllImport("user32.dll")> _
Public Function GetForegroundWindow() As IntPtr
End Function
<DllImport("user32.dll")> _
Public Function GetFocus() As IntPtr
End Function
<DllImport("user32.dll")> _
Public Function AttachThreadInput(idAttach As IntPtr, idAttachTo As IntPtr, fAttach As Integer) As IntPtr
End Function
<DllImport("user32.dll")> _
Public Function GetWindowThreadProcessId(hWnd As IntPtr, ProcessId As IntPtr) As IntPtr
End Function
<DllImport("kernel32.dll")> _
Public Function GetCurrentThreadId() As IntPtr
End Function
<DllImport("user32.dll")> _
Public Sub ClientToScreen(hWnd As IntPtr, ByRef p As Point)
End Sub

Public Function CaretPos() As Point
Dim ptr As IntPtr = GetForegroundWindow()
Dim p As New Point()

\'得到Caret在屏幕上的位置
If ptr.ToInt32() <> 0 Then
    Dim targetThreadID As IntPtr = GetWindowThreadProcessId(ptr, IntPtr.Zero)
    Dim localThreadID As IntPtr = GetCurrentThreadId()
   
    \'If localThreadID <> targetThreadID Then
        AttachThreadInput(localThreadID, targetThreadID, 1)
        ptr = GetFocus()
        If ptr.ToInt32() <> 0 Then
            GetCaretPos(p)
            ClientToScreen(ptr, p)
        End If
        AttachThreadInput(localThreadID, targetThreadID, 0)
    \'End If
End If
Return p
End Function
#End Region

 

调用代码

 

Dim p = CaretPos()
msgbox(p.x & " " & p.y)
--  作者：lsy
--  发布时间：2015/12/18 17:08:00
--  
先谢了。
看起来不容易，试试。
--  作者：lsy
--  发布时间：2015/12/18 17:16:00
--  
好的很，窗口很听话了。