vb.net特效 vbnet tooltip( 三 )


Dim pWAVE_OBJECTPtr() As Long
Dim SApWAVE_OBJECT As SAFEARRAY1D
Dim SApWAVE_OBJECTPtr As SAFEARRAY1D
With SApWAVE_OBJECT
.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 SApWAVE_OBJECTPtr
.cDims = 1
.fFeatures = 0
.cbElements = 4
.cLocks = 0
.pvData = https://www.04ip.com/post/VarPtr(SApWAVE_OBJECT.pvData)
.Bounds(0).lLbound = 0
.Bounds(0).cElements = 1
End With
CopyMemory ByVal VarPtrArray(pWAVE_OBJECT), VarPtr(SApWAVE_OBJECT), 4
CopyMemory ByVal VarPtrArray(pWAVE_OBJECTPtr), VarPtr(SApWAVE_OBJECTPtr), 4
lpWaveObj = idEvent
pWAVE_OBJECTPtr(0) = lpWaveObj
'Debug.Print "WaveTimerProc "pWAVE_OBJECT(0).dwFlag
Call WaveSpread(pWAVE_OBJECT(0))
Call WaveRender(pWAVE_OBJECT(0))
With pWAVE_OBJECT(0)
If (.dwFlag And F_WO_NEED_UPDATE) Then
hdc = GetDC(.hWnd)
Call WaveUpdateFrame(pWAVE_OBJECT(0), hdc, False)
Call ReleaseDC(.hWnd, hdc)
End If
'********************************************************************
' 特效处理
'********************************************************************
If (.dwFlag And F_WO_EFFECT) = 0 Then Exit Sub
Select Case .dwEffectType
'********************************************************************
' Type = 1 雨点,Param1=速度(0最快,越大越慢) , Param2=雨点大小,Param3=能量
'********************************************************************
Case 1
'Dim ret As Long
If .dwEffectParam10 Then Call WaveRandom(pWAVE_OBJECT(0), .dwEffectParam1) 'ret = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam1)
'If ret = 0 Then
dwPosX = WaveRandom(pWAVE_OBJECT(0), .dwBmpWidth - 2) + 1
dwPosY = WaveRandom(pWAVE_OBJECT(0), .dwBmpHeight - 2) + 1
dwSize = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam2) + 1
dwWeight = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam3) + 50
Call WaveDropStone(pWAVE_OBJECT(0), dwPosX, dwPosY, dwSize, dwWeight)
'End If
'********************************************************************
' Type = 2 行船 , Param1=速度(0最快,越大越快),Param2=大小,Param3=能量
'********************************************************************
Case 2
.dwEff2Flip = .dwEff2Flip + 1
If (.dwEff2Flip And 1)0 Then Exit Sub
dwPosX = .dwEff2X + .dwEff2XAdd
dwPosY = .dwEff2Y + .dwEff2YAdd
If dwPosX1 Then
dwPosX = -(dwPosX - 1)
.dwEff2XAdd = -.dwEff2XAdd
End If
If dwPosY1 Then
dwPosY = -(dwPosY - 1)
.dwEff2YAdd = -.dwEff2YAdd
End If
If dwPosX.dwBmpWidth - 1 Then
dwPosX = (.dwBmpWidth - 1) - (dwPosX - (.dwBmpWidth - 1)) '(.dwBmpWidth - 1)*2 -dwPosX
.dwEff2XAdd = -.dwEff2XAdd
End If
If dwPosY.dwBmpHeight - 1 Then
dwPosY = (.dwBmpHeight - 1) - (dwPosY - (.dwBmpHeight - 1)) '(.dwBmpHeight-1)*2-dwPosY
.dwEff2YAdd = -.dwEff2YAdd
End If
.dwEff2X = dwPosX
.dwEff2Y = dwPosY
Call WaveDropStone(pWAVE_OBJECT(0), dwPosX, dwPosY, .dwEffectParam2, .dwEffectParam3)
'********************************************************************
' Type = 3 波浪,Param1=密度,Param2=大小,Param3=能量
'********************************************************************
Case 3
Dim I As Long
For I = 0 To .dwEffectParam1
dwPosX = WaveRandom(pWAVE_OBJECT(0), .dwBmpWidth - 2) + 1
dwPosY = WaveRandom(pWAVE_OBJECT(0), .dwBmpHeight - 2) + 1
dwSize = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam2) + 1
dwWeight = WaveRandom(pWAVE_OBJECT(0), .dwEffectParam3)
Call WaveDropStone(pWAVE_OBJECT(0), dwPosX, dwPosY, dwSize, dwWeight)
Next
End Select

推荐阅读