100分求，请教一个关于和放大镜有关的问题（附源码）

Question

http://community.csdn.net/Expert/topic/3638/3638999.xml?temp=.9676935
与此贴有关的一个帖子
源码在此http://mlzboy.jahee.com/zoom1214.rar
我想实现这样的效果，就是当鼠标移到屏幕边缘时，比如是最右上角的一个点时，该点显示在窗体的中央，窗体左边当然显示的是放大的区域，右边已经没有可以显示的了，就显示黑色，鼠标不能再往右移动了，再移动还是显示上面的一样，以此类推在其它各个边缘处也是这样的效果，还请帮忙，

Answer 1

' 给你把代码改了一下。以下是全部代码：Option ExplicitPrivate Type POINTAPI
    x As Long
    y As Long
End TypePrivate Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As LongPrivate Sub Form_DblClick()
    Unload Me
End SubPrivate Sub Form_Load()
    Me.AutoRedraw = True
    Me.BackColor = vbBlack
End SubPrivate Sub Timer1_Timer()
    Dim MyPoint As POINTAPI
    Dim dx As Long
    Dim dy As Long
    
    GetCursorPos MyPoint
    dx = MyPoint.x - 50
    dy = MyPoint.y - 50
    If dx < 0 Then dx = 0
    If dy < 0 Then dy = 0
 
    Me.Cls
    StretchBlt Me.hdc, 0, 0, 200, 200, GetDC(0), dx, dy, 100, 100, vbSrcCopy
End Sub

Answer 2

我晕~~这叫做没事找事干~放分啦!
其实用回你以前那个就行了!把窗体的背影色设成黑色.重影就消失了!呵呵~
如果觉得窗体黑色不好看,可以先用个picturebox装着,再copy回窗体上来!
楼主放分啰~哈哈!

Answer 3

' 如果需要左边和上边也变黑的话就把这两行注释掉：'    If dx < 0 Then dx = 0
'    If dy < 0 Then dy = 0

Answer 4

Option Explicit
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 TypePrivate Const SRCCOPY& = &HCC0020
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private myPoint As POINTAPI
Private myOldPoint As POINTAPI
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As rect, ByVal hBrush 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 Sub Form_DblClick()
    Unload Me
End Sub
Private Sub Timer1_Timer()
 Dim dx As Long
 Dim dy As Long
 Dim dl As Long
 Dim whdc As Long
 Dim cx As Integer
 Dim cy As Integer
 Dim bedge As Boolean
 dl& = GetCursorPos(myPoint)
 If myOldPoint.x = myPoint.x And myOldPoint.y = myPoint.y Then
    Exit Sub
 End If
 myOldPoint.x = myPoint.x
 myOldPoint.y = myPoint.y
 dx = myPoint.x
 dy = myPoint.y
 whdc = GetDC(0)
' If dx < 0 Then dx = 0
' If dy < 0 Then dy = 0
 
' With Screen
'    If dx > .Width / .TwipsPerPixelX - 100 Then dx = .Width / .TwipsPerPixelX - 100
'    If dy > .Height / .TwipsPerPixelY - 100 Then dy = .Height / .TwipsPerPixelY - 100
' End With
 '   Me.Cls
  cx = 100
 cy = 100
 If dx - 50 < 0 Then
    cx = 50 + dx
    dx = 0
    bedge = True
 End If If dy - 50 < 0 Then
    cy = 50 + dy
    dy = 0
    bedge = True
 End If
 If dx + 50 > Screen.Width / Screen.TwipsPerPixelX Then
    dx = Screen.Width / Screen.TwipsPerPixelX - dx + 50
    cx = Screen.Width / Screen.TwipsPerPixelX - dx + 50
    bedge = True
 End If
 If dy + 50 > Screen.Height / Screen.TwipsPerPixelY Then
    dy = Screen.Height / Screen.TwipsPerPixelY - dy + 50
    cy = Screen.Height / Screen.TwipsPerPixelY - dy + 50
    bedge = True
 End If
 If bedge Then
    Me.Cls
 End If
 dl& = StretchBlt(Me.hdc, (100 - cx) * 2, (100 - cy) * 2, 2 * cx, 2 * cy, whdc, dx, dy, cx, cy, SRCCOPY)
 ReleaseDC 0, hdc
 bedge = False
End Sub'代码比较乱自己整理一下

Answer 5

' 进一步简化：Option ExplicitPrivate Type POINTAPI
    x As Long
    y As Long
End TypePrivate Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As LongPrivate Sub Form_DblClick()
    Unload Me
End SubPrivate Sub Form_Load()
    Me.AutoRedraw = True
    Me.BackColor = vbBlack
End SubPrivate Sub Timer1_Timer()
    Dim MyPoint As POINTAPI
    
    Me.Cls
    GetCursorPos MyPoint
    StretchBlt Me.hdc, 0, 0, 200, 200, GetDC(0), MyPoint.x - 50, MyPoint.y - 50, 100, 100, vbSrcCopy
End Sub