vb.net特效 vbnet tooltip( 四 )


End With
'取消模拟指针
CopyMemory ByVal VarPtrArray(pWAVE_OBJECT), 0, 4
CopyMemory ByVal VarPtrArray(pWAVE_OBJECTPtr), 0, 4
End Sub
'
'释放对象
'
Public Sub WaveFree(lpWaveObject As WAVE_OBJECT)
With lpWaveObject
If .hDcRender0 Then DeleteDC (.hDcRender)
If .hBmpRender0 Then DeleteObject .hBmpRender
If .lpDIBitsSource0 Then GlobalFree .lpDIBitsSource
If .lpDIBitsRender0 Then GlobalFree .lpDIBitsRender
If .lpWave10 Then GlobalFree .lpWave1
If .lpWave20 Then GlobalFree .lpWave2
KillTimer .hWnd, VarPtr(lpWaveObject)
ZeroMemory ByVal VarPtr(lpWaveObject), Len(lpWaveObject)
'-----------------------------------------------------------
'取消模拟指针
CopyMemory ByVal VarPtrArray(pLong), 0, 4
CopyMemory ByVal VarPtrArray(pLongPtr), 0, 4
'-----------------------------------------------------------------
'取消模拟指针
CopyMemory ByVal VarPtrArray(pByte), 0, 4
CopyMemory ByVal VarPtrArray(pBytePtr), 0, 4
'-----------------------------------------------------------
End With
End Sub
'
' 初始化对象
' 参数:_lpWaveObject = 指向 WAVE_OBJECT结构体
' 返回:0 成功、 1 失败
'
Public Function WaveInit(lpWaveObject As WAVE_OBJECT, ByVal hWnd As Long, ByVal hBmp As Long, ByVal dwSpeed As Long, ByVal dwType As WaveType) As Long
Dim stBmp As BITMAP
Dim dwReturn As Long
Dim ret As Long
Dim hdc As Long
Dim hMDC As Long
'-----------------------------------------------------------------
'建立模拟指针
With SApLong
.cDims = 1
.fFeatures = 0
.cbElements = 1
.cLocks = 0
.pvData = https://www.04ip.com/post/0
.Bounds(0).lLbound = 0
.Bounds(0).cElements = 1
End With
With SApLongPtr
.cDims = 1
.fFeatures = 0
.cbElements = 4
.cLocks = 0
.pvData = https://www.04ip.com/post/VarPtr(SApLong.pvData)
.Bounds(0).lLbound = 0
.Bounds(0).cElements = 1
End With
CopyMemory ByVal VarPtrArray(pLong), VarPtr(SApLong), 4
CopyMemory ByVal VarPtrArray(pLongPtr), VarPtr(SApLongPtr), 4
'-----------------------------------------------------------------
'建立模拟指针
With SApByte
.cDims = 1
.fFeatures = 0
.cbElements = 1
.cLocks = 0
.pvData = https://www.04ip.com/post/0
.Bounds(0).lLbound = 0
.Bounds(0).cElements = 3
End With
With SApBytePtr
.cDims = 1
.fFeatures = 0
.cbElements = 4
.cLocks = 0
.pvData = https://www.04ip.com/post/VarPtr(SApByte.pvData)
.Bounds(0).lLbound = 0
.Bounds(0).cElements = 1
End With
CopyMemory ByVal VarPtrArray(pByte), VarPtr(SApByte), 4
CopyMemory ByVal VarPtrArray(pBytePtr), VarPtr(SApBytePtr), 4
'-----------------------------------------------------------------
dwReturn = 0
ZeroMemory ByVal VarPtr(lpWaveObject), Len(lpWaveObject)
'ZeroMemory lpWaveObject, H84 ' Len(WAVE_OBJECT)
With lpWaveObject
If dwType = sEllipse Then
.dwFlag = .dwFlag Or F_WO_ELLIPSE
End If
'********************************************************************
' 获取位图尺寸
'********************************************************************
.hWnd = hWnd
.dwRandom = GetTickCount()
ret = GetObject(hBmp, Len(stBmp), stBmp)
If ret = 0 Then
dwReturn = 1
GoTo result
End If
.dwBmpHeight = stBmp.bmHeight
'if lpWaveObject.dwBmpHeight3 then dwReturn = 1:GoTo result
.dwBmpWidth = stBmp.bmWidth
'if lpWaveObject.dwBmpWidth3 then dwReturn = 1:GoTo result
.dwWaveByteWidth = stBmp.bmWidth * H4 '2 ^ 2 'dwBmpWidth * 4
.dwDIByteWidth = (stBmp.bmWidth + stBmp.bmWidth * 2 + 3) And (Not H3) '(dwBmpWidth * 3 + 3) and ~3 ' ((W * 3 + 3) And (Not 3))

推荐阅读