为什么这段代码运行一会会死,请高手看一下
Option Explicit
Private Declare Function SetWindowPos Lib "user32 " ( _
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long _
) As Long
Const HWND_TOPMOST = -1
Const SWP_SHOWWINDOW = &H40
Private Type POINTAPI
x As Long
y As Long
End Type
Public sx As Double
Public sy As Double
Public turnon As Boolean
Public turn As Boolean
Public lefton As Boolean
Dim drv(10) As Integer
Public drv1 As Double
Public drv2 As Double
Public drv3 As Double
Const Srccopy = &HCC0020
Const Swp_nomove = &H2
Const Swp_nosize = &H1
Const Flags = Swp_nomove Or Swp_nosize
'Const HWND_TOPMOST = -1
'Private Declare Function SetWindowPos Lib "user32 " (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetCursorPos Lib "user32 " (lpPoint As POINTAPI) As Long
Private Declare Function GetDC Lib "user32 " (ByVal hwnd As Long) 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
Dim pos As POINTAPI
Private Sub Form_Load()
SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, Flags
'start
End Sub
Private Sub start()
GetCursorPos pos
Dim i
For i = 0 To 5
sx = IIf(pos.x < 50 Or pos.x > 1280, IIf(pos.x < 50, 0, 1280), pos.x - 50)
sy = IIf(pos.y < 50 Or pos.y > 1024, IIf(pos.y < 50, 0, 1024), pos.y - 50)
'Caption = "坐标 " & sx & ", " & sy & " " & hdc & " "
StretchBlt hdc, 0, 0, 500, 300, GetDC(0), sx, sy, 250, 150, Srccopy
'SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 500, 500, 200, SWP_SHOWWINDOW
'Dim retValue As Long
'将窗体设置为处于所有窗口的顶层,注意在 VB 中运行时,可能不行,但编译成EXE后就可以了
Next i
End Sub
Private Sub Timer1_Timer()
start
'End If
End Sub
timer延迟是1毫秒设置成100毫秒还是会死,就是时间久了点
[解决办法]
试了一下,没有死,只是CPU利用率高了点,90%
改一点:
Private Sub start()
Dim i As Long
Dim CurPos As POINTAPI
GetCursorPos CurPos
If CurPos.x = pos.x And CurPos.y = pos.y Then
Exit Sub
Else
pos = CurPos
End If
sx = IIf(pos.x < 50 Or pos.x > 1280, IIf(pos.x < 50, 0, 1280), pos.x - 50)
sy = IIf(pos.y < 50 Or pos.y > 1024, IIf(pos.y < 50, 0, 1024), pos.y - 50)
StretchBlt hdc, 0, 0, 500, 300, GetDC(0), sx, sy, 250, 150, Srccopy
End Sub