锐客网

  1. 首页 > 生活百科 > it技术 > >

vb.net特效 vbnet tooltip( 二 )

IT技术Long


dwFlag = dwFlag Or 1 '如果存在源像素和目标像素不同 ， 则表示还在活动状态
'Debug.Print dwPtrSource" SR "dwPtrDest
'CopyMemory ByVal lpDIBitsRender, ByVal lpDIBitsSource, 3
Call WaveGetPixel(lpDIBitsSource, lpDIBitsRender, .dwDIByteWidth)
Else
CopyMemory ByVal lpDIBitsRender, ByVal lpDIBitsSource, 3
End If
'********************************************************************
' 继续循环
'********************************************************************
Continue:
LineIdx = LineIdx + 4 '像素++'指针4个字节
Next 'J
Next 'I
SetDIBits .hDcRender, .hBmpRender, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS
If dwFlag = 0 Then .dwFlag = .dwFlag And (Not F_WO_ACTIVE)
'Debug.Print "WaveRender ".dwFlag
End With
End Sub
Public Sub WaveUpdateFrame(lpWaveObject As WAVE_OBJECT, ByVal hdc As Long, bIfForce As Boolean)
'Dim ret As Long
With lpWaveObject
If bIfForce = True Then GoTo labUpdate
If (.dwFlag And F_WO_NEED_UPDATE) Then
'ret = SetDIBitsToDevice(.hDcRender, 0, 0, .dwBmpWidth, .dwBmpHeight, 0, 0, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS)
'ret = SetDIBits(.hDcRender, .hBmpRender, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS)
'SetDIBits .hDcRender, .hBmpRender, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS
labUpdate:
BitBlt hdc, 0, 0, .dwBmpWidth, .dwBmpHeight, .hDcRender, 0, 0, SRCCOPY
.dwFlag = .dwFlag And (Not F_WO_NEED_UPDATE)
End If
End With
End Sub
'
' 扔一块石头
'
Public Sub WaveDropStone(lpWaveObject As WAVE_OBJECT, ByVal dwPosX As Long, ByVal dwPosY As Long, ByVal dwStoneSize As Long, ByVal dwStoneWeight As Long)
Dim dwSize As Long
Dim dwX1 As Long, dwX2 As Long
Dim dwY1 As Long, dwY2 As Long, dwY3 As Long
'Dim dwMaxX As Long, dwMaxY As Long
Dim LinePtr As Long
With lpWaveObject
'Debug.Print "WaveDropStone ".dwFlag
'********************************************************************
' 计算范围
'********************************************************************
dwSize = dwStoneSize \ H2 '2 ^ 1
dwX1 = dwPosX + dwSize
dwX2 = dwPosX - dwSize
If (.dwFlag And F_WO_ELLIPSE) Then dwSize = dwSize \ H2 ' 2 ^ 1
dwY1 = dwPosY + dwSize
dwY2 = dwPosY - dwSize
dwSize = dwStoneSize
If dwSize = 0 Then dwSize = dwSize + 1
'********************************************************************
' 判断范围的合法性
'********************************************************************
If dwX1 + 1 = .dwBmpWidth Or dwX21 Or dwY1 + 1 = .dwBmpHeight Or dwY21 Then Exit Sub
'********************************************************************
' 将范围内的点的能量置为 dwStoneWeight
'********************************************************************
While dwX2 = dwX1
dwY3 = dwY2
While dwY3 = dwY1
'(x-x0)^2+(y-y0)^2=r^2 就在圆内
If (dwX2 - dwPosX) * (dwX2 - dwPosX) + (dwY3 - dwPosY) * (dwY3 - dwPosY) = dwSize * dwSize Then
LinePtr = .lpWave1 + (dwY3 * .dwBmpWidth + dwX2) * H4 '2 ^ 2
pLongPtr(0) = LinePtr
pLong(0) = dwStoneWeight
End If
dwY3 = dwY3 + 1
Wend
dwX2 = dwX2 + 1
Wend
.dwFlag = .dwFlag Or F_WO_ACTIVE
End With
End Sub
'
' 计算扩散数据、渲染位图、更新窗口、处理特效的定时器过程
'
Public Sub WaveTimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
Dim hdc As Long
【vb.net特效 vbnet tooltip】Dim dwPosX As Long, dwPosY As Long, dwSize As Long, dwWeight As Long
Dim lpWaveObj As Long
'建立模拟指针
Dim pWAVE_OBJECT() As WAVE_OBJECT

推荐阅读


上一篇：拦截器的代码Java，拦截短信代码

下一篇：ppt怎么插入word，ppt导入word文档