希望各位“编程大侠”帮小弟设计一个简单的Windows任务栏驻留程序,实现鼠标指针和闪烁光标“合二为一”,鼠标指针和闪烁光标二者焦点的坐标始终一样,通过用键盘控制闪烁光标的移动和定位,使鼠标指针同时作相同的移动和定位,实现“如影随形”(闪烁光标是“形”,而鼠标指针则是“影”)
    假若小弟拥有各位“编程大侠”的一两成功力,我一定应付自如,但可惜,小弟我只是刚刚入门,暂时“功力绵薄”,所以,唯有求助于各位。万望各位不吝相助,小弟感激不尽!
    此外,完成该程序后,欢迎各位抢先在网上发布,至于程序的名称嘛,就叫“如影随形”吧,好让小弟到时google到,抢先试用。

解决方案 »

  1.   

    DEMO版
    ===============================
    Option ExplicitPublic Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
    Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As LongPublic Type POINTAPI
        X As Long
        Y As Long
    End TypePublic Const WM_HOTKEY = &H312
    Public Const MOD_CONTROL = &H2
    Public Const GWL_WNDPROC = (-4)Public Const MOUSEEVENTF_LEFTDOWN = &H2
    Public Const MOUSEEVENTF_LEFTUP = &H4
    Public Const MOUSEEVENTF_RIGHTDOWN = &H8
    Public Const MOUSEEVENTF_RIGHTUP = &H10Public OldWnd As LongPublic Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        If Msg = WM_HOTKEY Then
            Dim Cur As POINTAPI
            GetCursorPos Cur
            Select Case wParam
                Case 1: Call SetCursorPos(Cur.X - 5, Cur.Y)
                Case 2: Call SetCursorPos(Cur.X, Cur.Y - 5)
                Case 3: Call SetCursorPos(Cur.X + 5, Cur.Y)
                Case 4: Call SetCursorPos(Cur.X, Cur.Y + 5)
                Case 5: Call mouse_event(MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
                Case 6: Call mouse_event(MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0)
                Case 7: If MsgBox("Exit", vbYesNo) = vbYes Then Call UnMouse(Main)
            End Select
        End If
        WndProc = CallWindowProc(OldWnd, hwnd, Msg, wParam, lParam)
    End FunctionPublic Function RegMouse(frm As Form) As Boolean
        On Error Resume Next
        Dim Ret As Long
        frm.Hide
        OldWnd = GetWindowLong(frm.hwnd, GWL_WNDPROC)
        Ret = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf WndProc)
        
        Ret = RegisterHotKey(frm.hwnd, 1, MOD_CONTROL, vbKeyLeft)
        Ret = RegisterHotKey(frm.hwnd, 2, MOD_CONTROL, vbKeyUp)
        Ret = RegisterHotKey(frm.hwnd, 3, MOD_CONTROL, vbKeyRight)
        Ret = RegisterHotKey(frm.hwnd, 4, MOD_CONTROL, vbKeyDown)
        Ret = RegisterHotKey(frm.hwnd, 5, MOD_CONTROL, vbKeySpace) 'Mouse左键
        Ret = RegisterHotKey(frm.hwnd, 6, MOD_CONTROL, vbKeyReturn) 'Mouse右键
        Ret = RegisterHotKey(frm.hwnd, 7, MOD_CONTROL, vbKeyF12) '退出
        RegMouse = (Err.Number = 0)
    End FunctionPublic Function UnMouse(frm As Form) As Boolean
        On Error Resume Next
        Dim Ret As Long
        Ret = SetWindowLong(frm.hwnd, GWL_WNDPROC, OldWnd)
        Call UnregisterHotKey(frm.hwnd, vbKeyLeft)
        Call UnregisterHotKey(frm.hwnd, vbKeyUp)
        Call UnregisterHotKey(frm.hwnd, vbKeyRight)
        Call UnregisterHotKey(frm.hwnd, vbKeyDown)
        Call UnregisterHotKey(frm.hwnd, vbKeySpace)
        Call UnregisterHotKey(frm.hwnd, vbKeyReturn)
        Call UnregisterHotKey(frm.hwnd, vbKeyF12)
        Unload frm
        UnMouse = (Err.Number = 0)
    End Function
      

  2.   

    我用VB运行,为何以下内容出现编译错误:Public Const WM_HOTKEY = &H312
    Public Const MOD_CONTROL = &H2
    Public Const GWL_WNDPROC = (-4)Public Const MOUSEEVENTF_LEFTDOWN = &H2
    Public Const MOUSEEVENTF_LEFTUP = &H4
    Public Const MOUSEEVENTF_RIGHTDOWN = &H8
    Public Const MOUSEEVENTF_RIGHTUP = &H10请问这是VB语言还是C语言?
      

  3.   

    补充
    (我尽最大努力去表达我的设想,请认真看完,理解好小弟的意思):
      1、严正声明,绝对不是去做那些骗广告费的勾当!(如有得罪,请多多包涵;如果我也有那种骗广告费的能力,我会把将“勾当”改为“高招”)
      2、实际应用(无保留地同大家分享):先将一批新单词输入文本编辑器(如WORD)→启用金山词霸的“鼠标”、“取词结果记入生词本(自动)”功能→通过用键盘控制闪烁光标的移动和定位,使鼠标指针同时作相同的移动和定位,间接实现“鼠标取词”→再用宏工具(如EZ macros)重复键盘操作,实际上是自动使鼠标指针依次定位至文档中的每一个新单词上,实现批量输入金山词霸的“生词本”,定制需要的生词表→打印
      苍天可鉴,这一切为了学习英语!!!
      这是小弟构思的“快速制作英语生词表”方案,最关键的一环就是鼠标指针和闪烁光标二者“合二为一”,“如影随形”,现在就缺这一环,小弟最渴望实现,但可惜“功力绵薄”……所以……!!!
    我有决心将此贴贴遍所有编程论坛,直至某位真正的大侠帮小弟补上这一环!!!
      3、使用环境(强调):针对各种文本编辑器(如WORD)
      4、windows自带的“鼠标键”是鼠标指针和闪烁光标二者分离,“各自为政”,我想实现的是鼠标指针和闪烁光标二者“合二为一”,“如影随形” 鼠标指针随闪烁光标移动、定位
      5、windows自带的“鼠标键”功能并不够用,过于简单,不方便文本编辑。具体来讲,若以windows自带的“鼠标键”作为参照系,我希望它:
        a、可以将鼠标指针和闪烁光标“捆绑”起来(“如影随形”的另外一种表达)
        b、不局限于小键盘区,而至少增加功能键(如Ctrl、Alt……),以及增加方向键←↑→↓,以实现“Ctrl + →”(闪烁光标隔单词定位)等快捷键功能
      我已经尽我最大努力(和诚意)去表达我的设想——这一个午休又泡汤了——各位应该理解小弟的意思了吧。还是那一句:万望各位不吝指教(相助),小弟真的感激不尽!欢迎回贴!
      

  4.   

    Option Explicit
    Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPublic Const WM_USER = &H400
    Public Const WM_LBUTTONUP = &H202
    Public Const WM_MBUTTONUP = &H208
    Public Const WM_RBUTTONUP = &H205
    Public Const TRAY_CALLBACK = (WM_USER + 1001&)
    Public Const GWL_WNDPROC = (-4)
    Public Const GWL_USERDATA = (-21)
    Public Const NIF_ICON = &H2
    Public Const NIF_TIP = &H4
    Public Const NIM_ADD = &H0
    Public Const NIF_MESSAGE = &H1
    Public Const NIM_MODIFY = &H1
    Public Const NIM_DELETE = &H2Public OldWinProc As Long
    Public NewForm As Form
    Public NewMenu As MenuPublic Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        szTip As String * 64
    End TypePrivate TheData As NOTIFYICONDATAPublic Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        If Msg = TRAY_CALLBACK Then
            If lParam = WM_LBUTTONUP Then
                If NewForm.WindowState = vbMinimized Then
                NewForm.WindowState = NewForm.LastState
                NewForm.SetFocus
                Exit Function
            End If
            If lParam = WM_RBUTTONUP Then
                NewForm.PopupMenu NewMenu
                Exit Function
            End If
        End If
        NewWindowProc = CallWindowProc(OldWinProc, hwnd, Msg, wParam, lParam)
    End FunctionPublic Sub AddTray(frm As Form, mnu As Menu)
        Set NewForm = frm
        Set NewMenu = mnu    OldWinProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)    With TheData
            .uID = 0
            .hwnd = frm.hwnd
            .cbSize = Len(TheData)
            .hIcon = frm.Icon.Handle
            .uFlags = NIF_ICON
            .uCallbackMessage = TRAY_CALLBACK
            .uFlags = .uFlags Or NIF_MESSAGE
            .cbSize = Len(TheData)
        End With
        Shell_NotifyIcon NIM_ADD, TheData
    End SubPublic Sub RemoveTray()    With TheData
            .uFlags = 0
        End With
        Shell_NotifyIcon NIM_DELETE, TheData    SetWindowLong NewForm.hwnd, GWL_WNDPROC, OldWinProc
    End SubPublic Sub TrayTip(tip As String)
        With TheData
            .szTip = tip & vbNullChar
            .uFlags = NIF_TIP
        End With
        Shell_NotifyIcon NIM_MODIFY, TheData
    End SubPublic Sub TrayIcon(pic As Picture)
        If pic.Type <> vbPicTypeIcon Then Exit Sub    With TheData
            .hIcon = pic.Handle
            .uFlags = NIF_ICON
        End With
        Shell_NotifyIcon NIM_MODIFY, TheData
    End Sub
    ====================
    托盘程序
      

  5.   

    看不出来,小兄弟搞歪门邪道挺厉害的。其实你无非是要编程序用金山词霸查单词。你不走正道,来整什么如影随形的东东,想利用金山的屏幕取词功能。其实犯不着这样,金山词霸的高版本提供了编程接口的,你调用它就行了。金山词霸2003和金山词霸2005都可以这样做(再低的版本我没试过):
    1 打开 VBA 编辑界面的菜单 “工具”--〉“引用”。在“可使用的引用”列表框里找到
      “KSEngine 1.0 Type Library”,将他选上,“确定”。2 必须完成第一步,才能使用以下代码:
    Sub aaa()
      Dim d As New KSENGINELib.Dictionary
      d.Open "C:\Program Files\Kingsoft\PowerWord 2005\DICTS\PWQEC.DIC"
      d.Lookup "yes", 1
      MsgBox d.GetExplain, , d.GetTitle
      d.Close
    End Sub