100分，请求解决取色器、放大镜的三个问题[附源码]

Question

源码在此
http://mlzboy.jahee.com/zoom3.rar已有一贴，关于此问题的，已经解决
http://community.csdn.net/Expert/topic/3655/3655444.xml?temp=.4834864现在还有三个问题
1.就是左边的十字（用来做放大镜），在移动鼠标，轻微移动的时候，感觉总是定个好位置，只想移动一点点却跳过去多了一点，我在用snagit 7截取区域的时候，同样也有个放大镜，但是用它来移动的时候感觉非常顺，想从哪里开始取都可以定们得到，鼠标的移动速度刚刚好，而在用我的这个的时候感觉移动的非常快
2.在用鼠标左键点击取色的时候，比如是快速启动栏上的图标，只要点一下就启动了，我在上面取色，取完色，结束就运行程序了，不知道能不能让这个点击不启动程序（这个要求是不是有点过份了^_^）
3.可否在点击了取色后，右击就取消该次取色小弟初学VB，肯请各位高人指点

Answer 1

十字的中心和单个象素放大后的中心没有对齐造成了选取不便
使用Timer来取点刷新率不够就导致了移动不顺最好的办法就是抓取屏幕并画到一个全屏窗体上去
然后再在窗体的Form_MouseMove里面得到同步的放大预览这样做的同时
后面的问题也就可以解决了
而且要进一步添加部分截屏的功能也很方便重新写了段代码
新窗体添加PictureBox并改名为picColor即可直接运行用两个窗体实现就不用去反复设置窗体边框
这里为演示方便只用了一个窗体最后～
再用SetWindowPos来设置TopMost更好的防止出错
然后加个PictureBox用双缓冲可以消除闪烁
鼠标靠近时调整picColor的位置……
就基本上像个样子了＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option ExplicitPrivate Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000Private InSnag As Boolean   '是否为取色模式'预设属性
Private Sub Form_Load()
    With Me
        .ScaleMode = 3
        .AutoRedraw = True
        .Caption = "单击开始取色"
    End With
    
    '预览框
    With picColor
        .Visible = False
        .Appearance = 0
        .Move 0, 0, 102, 102
        .ScaleMode = 3
        .DrawWidth = 3
        .DrawMode = 7
        .ForeColor = vbWhite
        .AutoRedraw = False
    End With    InSnag = False
End Sub'画预览
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Not InSnag Then Exit Sub
    
    picColor.Cls
    picColor.PaintPicture Me.Image, 0, 0, 100, 100, X - 10, Y - 10, 20, 20, vbSrcCopy
    picColor.Line (52, 0)-(52, 100)
    picColor.Line (0, 52)-(100, 52)
End Sub'开始、结束取色
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim tColor As Long
    
    If Not InSnag Then
        StartGetColor
    Else
        tColor = Me.Point(X, Y)
        EndGetColor
        Me.BackColor = tColor
    End If
End Sub'开始取色
Private Sub StartGetColor()
    '窗体相关
    Dim wStyle As Long
    
    '屏幕相关
    Dim sDC As Long
    Dim sWidth As Long
    Dim sHeight As Long
    
    '设置窗体
    Me.Hide
    wStyle = GetWindowLong(Me.hwnd, GWL_STYLE)
    SetWindowLong Me.hwnd, GWL_STYLE, wStyle And Not WS_CAPTION    '去边框
    Me.WindowState = 2
    
    sWidth = Screen.Width \ Screen.TwipsPerPixelX
    sHeight = Screen.Height \ Screen.TwipsPerPixelY
    
    
    '抓屏
    DoEvents
    sDC = GetDC(0)
    BitBlt Me.hdc, 0, 0, sWidth, sHeight, sDC, 0, 0, vbSrcCopy
    ReleaseDC 0, sDC
    
    Me.Show
    'Me.Refresh
    picColor.Visible = True
    InSnag = True
End Sub'结束取色
Private Sub EndGetColor()
    Dim wStyle As Long
    
    Me.Hide
    Set Me.Picture = Nothing
    wStyle = GetWindowLong(Me.hwnd, GWL_STYLE)
    SetWindowLong Me.hwnd, GWL_STYLE, wStyle Or WS_CAPTION    '加边框
    Me.WindowState = 0    Me.Show
    picColor.Visible = False
    InSnag = False
End Sub

Answer 2

还有就是～
用的时候觉得SnagIt定位方便应该还和他的预览框比较大有关系

Answer 3

// 使用Timer来取点刷新率不够就导致了移动不顺
确实如  AprilSong(X) 所说，利用 Timer 不是那么平滑，但是如果用 MouseMove 代替的话则需要把放大窗口的 AutoRedraw 改为 False，不然同步效果就更差了。// 最好的办法就是抓取屏幕并画到一个全屏窗体上去
// 然后再在窗体的Form_MouseMove里面得到同步的放大预览
我也觉得将屏幕抓到一个窗体上会比较实在一点，这样也可以避免使用众多 API 所带来的麻烦。至于第三个问题因为鼠标已经释放了，如果再在屏幕任意位置右击鼠标键的话是不能达到你的效果的，如果采用先抓屏再取色的话就很容易实现了。现在给你提点建议，可以在取色的时候先减缓鼠标移动速度，事后恢复即可，需要使用 SystemParametersInfo 这个 API 函数，代码如下：' 声明以下 API 及相关的常量
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" ( _
    ByVal uAction As Long, _
    ByVal uParam As Long, _
    ByRef lpvParam As Any, _
    ByVal fuWinIni As Long) As LongPrivate Const SPI_GETMOUSESPEED = 112
Private Const SPI_SETMOUSESPEED = 113Private Const SPIF_SENDWININICHANGE = 2
Private Const SPIF_SENDCHANGE = SPIF_SENDWININICHANGE' 定义一个窗体级的变量，用来保存鼠标速度
Dim ms As Long' ......' 在主窗体加载的时候获取鼠标速度并保存在 ms 变量中
SystemParametersInfo SPI_GETMOUSESPEED, 0, ms, 0' ......' 在开始取色的时候设置光标移动速度比原速慢三倍
SystemParametersInfo SPI_SETMOUSESPEED, 0, ByVal ms \ 3, SPIF_SENDCHANGE' 开始取色    
' ......
' 取完色后
    
' 恢复光标移动速度
SystemParametersInfo SPI_SETMOUSESPEED, 0, ByVal ms, SPIF_SENDCHANGE

Answer 4

引用 AprilSong(X):
// 还有就是～
// 用的时候觉得SnagIt定位方便应该还和他的预览框比较大有关系有道理。