Question

VB 如何在屏幕上 画一个红色边框 并随鼠标移动?

程序中我用 API函数Rectangle 在屏幕上画的边框。请问 如何让它在屏幕上 并随鼠标移动？(不要把VB窗体全屏化了模拟屏幕) 因为我的桌面是动态桌面 所以不要锁屏哦！我QQ271072330
不要把VB 窗体透明了 覆盖屏幕 也不要挖空窗体搞成边框 也不要用四个VB窗体代替四边来代替边框 因为以上几种太浪费资源了 我就想用Rectangle画上去 再用个函数擦除！

Answer 1

把窗体的图象整个储存在一个bitmap里或者直接储存在显存里，然后鼠标移动时先用bitmap画窗体,再画框，这样是占用资源最少的。用.net的System.Drawing里的画图功能或者directX去做这件事情。
实际上所谓的擦除就是重新画一张背景，然后再背景上画移动的东西，和我们平时写字然后搽掉的概念不同的，显卡显示的方式都是一块一块的图案往上贴而已。就是说实际上擦除只是在后台把背景画一次，然后再上面再画移动的东西，然后再把这个画好的合成图案再画到前台显示出来

Answer 2

这是按钮随鼠标移动的代码，你可以修改一下就可以了。

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.Left = X
Command1.Top = Y
End Sub

Answer 3

留个脚印

Answer 4

'在窗体上加入控件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