Question

顶级高手！来！VB 如何在屏幕上 画一个红色边框 并随鼠标移动?

程序中我是用 API函数Rectangle 在屏幕上画的边框。请问 如何让它在屏幕上 并随鼠标移动？(不要把VB窗体全屏化了模拟屏幕) 因为我的桌面是
动态桌面 所以不要锁屏哦！我QQ271072330
请不要把VB 窗体透明了 覆盖模拟屏幕 也不要挖空窗体搞成边框 也不要用四个VB窗体代替四边来代替边框 因为以上几种太浪费资源了 我就想用
Rectangle画上去 再用个函数擦除！ 只用函数画边框，不要用窗体来代替边框！只要能满足条件的 分我可以加到200分 只要你能作到！ 我邮箱qqsq001@163.com 先谢了 在线等...

Answer 1

1楼的代码,最好是在窗口鼠标的Move事件中重绘比较好,这样才比较符合楼主的问题啊,随鼠标移动,用Timer会有延时的效果,不过就是可能会比较占用资源,频繁重绘的结果,还有,如果你要画边框,我觉得,你绘制一个矩形框的光标就可以了,完全不用自己重绘,那样是最快的!Windows硬件级别的切换,会很流畅的跟随你的鼠标移动,又不会占用太多资源,随便找个图标编辑器就可以实现了,没有必要那么麻烦的,呵呵,是吧~!

Answer 2

'在窗体上加入控件timer1，然后复制下面代码，运行即可。

Option Explicit

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
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 ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function SetROP2 Lib "gdi32.dll" (ByVal hdc As Long, ByVal nDrawMode As Long) As Long

Private Const R2_XORPEN As Long = 7
Private Const R2_BLACK As Long = 1
Private Const R2_NOT As Long = 6
Private Const PS_SOLID As Long = 0
Private Const PS_DASH As Long = 1

Private Type POINTAPI
x As Long
y As Long
End Type

Dim deskdc As Long
Dim OldX As POINTAPI
Dim hPen As Long, hOldPen As Long

Private Sub Form_Load()
hPen = CreatePen(PS_SOLID, 2, RGB(255, 0, 0))
deskdc = GetDC(0)
hOldPen = SelectObject(deskdc, hPen)

End Sub

Private Sub Form_Unload(Cancel As Integer)
SelectObject deskdc, hOldPen
DeleteObject hPen
deskdc = ReleaseDC(0, deskdc)

End Sub

Private Sub Timer1_Timer()
Dim p As POINTAPI
GetCursorPos p
If p.x <> OldX.x And p.y <> OldX.y Then
SetROP2 deskdc, R2_NOT
Rectangle deskdc, OldX.x, OldX.y, OldX.x - 10, OldX.y - 10
OldX.x = p.x: OldX.y = p.y
Rectangle deskdc, p.x, p.y, p.x - 10, p.y - 10
End If
End Sub