㈠ VB求源碼做成像下列圖片一樣的程序
Private Sub Text1_Change()
s = List1.List(Val(Text1.Text) - 1)
For i = 0 To List1.ListCount - 1
If List1.ListCount = 1 Then Exit For
If List1.List(i) <> s Then
List1.RemoveItem (i)
i = i - 1
End If
Next
s = List2.List(Val(s) - 1)
For i = 0 To List2.ListCount - 1
If List2.ListCount = 1 Then Exit For
If List2.List(i) = s Then
MsgBox i
Else
List2.RemoveItem (i)
i = i - 1
End If
Next
End Sub
㈡ 用VB模擬時鍾轉動源代碼，謝謝啊！急需~~
呵呵,本轉一個VB吧主CBM666寫的時鍾代碼.. '添加 Line1 Line2 Line3 Timer1 Dim xx1%, yy1% '宣告變數xx1,yy1為整型(給圓心用的) Private Sub Form_Load() Me.AutoRedraw = True '重畫為真 '窗體置中 Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - meiheight) \ 2 '計算圓心的x軸 xx1 xx1 = Me.Width \ 2 '計算圓心的y軸 yy1 yy1 = (Me.Height - 405) \ 2 '將下面3根針的起點x1,y1全定位在圓心上 Line1.X1 = xx1: Line1.Y1 = yy1 Line2.X1 = xx1: Line2.Y1 = yy1 Line3.X1 = xx1: Line3.Y1 = yy1 '畫鍾的外匡讓線條粗一點 Me.DrawWidth = 5 '畫一個圓 Me.Circle (xx1, yy1), 950 Line2.BorderWidth = 1 '秒針的粗度 Line2.BorderColor = QBColor(12) '秒針的顏色 Line1.BorderWidth = 2 '分針的粗度 Line1.BorderColor = QBColor(14) '分針的顏色 Line3.BorderWidth = 3 '時針的粗度 Line3.BorderColor = QBColor(10) '時針的顏色 Timer1.Interval = 500 End Sub Private Sub Timer1_Timer() Me.Caption = Time '標題欄顯示現在時間 ' Second Hand '畫秒針 '計算秒針的角度,每一秒是 360度除以60秒=6度, 所以要乘上6 sdeg = Second(Time) * 6 'vb是以弧度為單位來計算,所以角度換算弧度是 3.14/180, 秒針跑了N度就乘上N srad = (3.14 / 180) * sdeg '900是秒針的長度,以圓心(line2的x1,y1)為准,計算出在這個弧度時line2.x2在什麼位置 Line2.X2 = Line2.X1 + (900 * Sin(srad)) '900是秒針的長度,以圓心(line2的x1,y1)為准,計算出在這個弧度時line2.y2在什麼位置 Line2.Y2 = Line2.Y1 - (900 * Cos(srad)) ' Minute Hand '畫分針 '計算分針的角度,每一分是360度除以60分=6度, 所以要乘上6,秒針動分針也會動,所以還要加上秒針移動所產生的分針移動. '秒針轉了1圈360度,分針才會前進1分鍾=6度,所以比例是 6/360等於 1/60 Mdeg = Minute(Time) * 6 + (sdeg * 1 / 60) 'vb是以弧度為單位來計算,所以角度換算弧度是 3.14/180, 分針跑了N度就乘上N mrad = (3.14 / 180) * Mdeg 'vb是以弧度為單位來計算,所以角度換算弧度是 3.14/180, 分針跑了N度就乘上N '750是分針的長度,以圓心(line1的x1,y1)為准,計算出在這個弧度時line1.x2在什麼位置 Line1.X2 = (750 * Sin(mrad)) + Line1.X1 '750是分針的長度,以圓心(line1的x1,y1)為准,計算出在這個弧度時line1.y2在什麼位置 Line1.Y2 = Line1.Y1 - (750 * Cos(mrad)) ' Hour Hand '畫時針 '計算時針的角度,每一小時時針跑30度,分針動時針也會動,所以還要加上分針移動所產生的時針移動. '分針轉了1圈360度,時針才會前進1刻劃=30度,所以比例是 30/360等於 1/12 hdeg = Hour(Time) * 30 + (Mdeg / 12) 'vb是以弧度為單位來計算,所以角度換算弧度是 3.14/180, 時針跑了N度就乘上N hrad = (3.14 / 180) * hdeg '500是時針的長度,以圓心(line3的x1,y1)為准,計算出在這個弧度時line3.x2在什麼位置 Line3.X2 = (500 * Sin(hrad)) + Line3.X1 '500是時針的長度,以圓心(line3的x1,y1)為准,計算出在這個弧度時line3.y2在什麼位置 Line3.Y2 = Line3.Y1 - (500 * Cos(hrad)) End Sub參考資料： http://hi..com/cbm666/blog/item/5729f736f7d902300a55a991.html
㈢ 求一個能實現屏幕水波紋效果的vb代碼
'補模塊3文件。一個放不下。
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' 渲染子程序，將新的幀數據渲染到 lpDIBitsRender 中
' 演算法：
' posx = Wave1(x-1,y)-Wave1(x+1,y)+x
' posy = Wave1(x,y-1)-Wave1(x,y+1)+y
' SourceBmp(x,y) = DestBmp(posx,posy)
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Sub WaveRender(lpWaveObject As WAVE_OBJECT)
Dim dwPosX As Long, dwPosY As Long, dwPtrSource As Long, dwPtrDest As Long, dwFlag As Long
Dim lpWave1 As Long, LineIdx As Long, LinePtr As Long
Dim lpDIBitsSource As Long, lpDIBitsRender As Long
Dim I As Long, J As Long
dwFlag = 0
With lpWaveObject
'Debug.Print "WaveRender " & .dwFlag
If (.dwFlag And F_WO_ACTIVE) = 0 Then Exit Sub
.dwFlag = .dwFlag Or F_WO_NEED_UPDATE
lpWave1 = .lpWave1
LineIdx = .dwWaveByteWidth '像素指針
For I = 1 To .dwBmpHeight - 2
For J = 0 To .dwBmpWidth - 1
'********************************************************************
' PosY=i+像素上1能量-像素下1能量
' PosX=j+像素左1能量-像素右1能量
'********************************************************************
'LineIdx = LineIdx - .dwWaveByteWidth
LinePtr = lpWave1 + LineIdx - .dwWaveByteWidth
pLongPtr(0) = LinePtr
dwPosY = pLong(0)
LinePtr = lpWave1 + LineIdx + .dwWaveByteWidth
pLongPtr(0) = LinePtr
dwPosY = dwPosY - pLong(0) + I
LinePtr = lpWave1 + LineIdx - 4
pLongPtr(0) = LinePtr
dwPosX = pLong(0)
LinePtr = lpWave1 + LineIdx + 4
pLongPtr(0) = LinePtr
dwPosX = dwPosX - pLong(0) + J
If dwPosX < 0 Or dwPosY < 0 Then GoTo Continue
If dwPosX >= .dwBmpWidth Or dwPosY >= .dwBmpHeight Then GoTo Continue
'********************************************************************
' ptrSource = dwPosY * dwDIByteWidth + dwPosX * 3
' ptrDest = i * dwDIByteWidth + j * 3
'********************************************************************
'dwPtrSource = dwPosY * .dwDIByteWidth + (dwPosX + dwPosX * 2)
dwPosX = dwPosX + dwPosX * 2 'dwPosX * 3
dwPtrSource = dwPosY * .dwDIByteWidth + dwPosX
dwPtrDest = I * .dwDIByteWidth + (J + J * 2) 'dwPtrDest = I * .dwDIByteWidth + J * 3
'********************************************************************
' 渲染像素 [ptrDest] = 原始像素 [ptrSource]
'********************************************************************
lpDIBitsSource = .lpDIBitsSource + dwPtrSource
lpDIBitsRender = .lpDIBitsRender + dwPtrDest
If dwPtrSource <> dwPtrDest Then
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 dwX2 < 1 Or dwY1 + 1 >= .dwBmpHeight Or dwY2 < 1 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
Dim dwPosX As Long, dwPosY As Long, dwSize As Long, dwWeight As Long
Dim lpWaveObj As Long
'建立模擬指針
Dim pWAVE_OBJECT() As WAVE_OBJECT
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 = 0
.Bounds(0).lLbound = 0
.Bounds(0).cElements = 1
End With
With SApWAVE_OBJECTPtr
.cDims = 1
.fFeatures = 0
.cbElements = 4
.cLocks = 0
.pvData = 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 .dwEffectParam1 > 0 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 dwPosX < 1 Then
dwPosX = -(dwPosX - 1)
.dwEff2XAdd = -.dwEff2XAdd
End If
If dwPosY < 1 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
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 .hDcRender > 0 Then DeleteDC (.hDcRender)
If .hBmpRender > 0 Then DeleteObject .hBmpRender
If .lpDIBitsSource > 0 Then GlobalFree .lpDIBitsSource
If .lpDIBitsRender > 0 Then GlobalFree .lpDIBitsRender
If .lpWave1 > 0 Then GlobalFree .lpWave1
If .lpWave2 > 0 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 = 0
.Bounds(0).lLbound = 0
.Bounds(0).cElements = 1
End With
With SApLongPtr
.cDims = 1
.fFeatures = 0
.cbElements = 4
.cLocks = 0
.pvData = 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 = 0
.Bounds(0).lLbound = 0
.Bounds(0).cElements = 3
End With
With SApBytePtr
.cDims = 1
.fFeatures = 0
.cbElements = 4
.cLocks = 0
.pvData = 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.dwBmpHeight < 3 then dwReturn = 1:GoTo result
.dwBmpWidth = stBmp.bmWidth
'if lpWaveObject.dwBmpWidth < 3 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&))
'********************************************************************
' 創建用於渲染的點陣圖
'********************************************************************
hdc = GetDC(hWnd)
.hDcRender = CreateCompatibleDC(hdc)
.hBmpRender = CreateCompatibleBitmap(hdc, .dwBmpWidth, .dwBmpHeight)
'MsgBox .hBmpRender
SelectObject .hDcRender, .hBmpRender
'********************************************************************
' 分配波能緩沖區
'********************************************************************
.lpWave1 = GlobalAlloc(GPTR, .dwWaveByteWidth * .dwBmpHeight)
.lpWave2 = GlobalAlloc(GPTR, .dwWaveByteWidth * .dwBmpHeight)
'********************************************************************
' 分配像素緩沖區
'********************************************************************
.lpDIBitsSource = GlobalAlloc(GPTR, .dwDIByteWidth * .dwBmpHeight)
.lpDIBitsRender = GlobalAlloc(GPTR, .dwDIByteWidth * .dwBmpHeight)
'********************************************************************
' 獲取原始像素數據
'********************************************************************
'With .stBmpInfo.bmiHeader
.stBmpInfo.bmiHeader.biSize = Len(.stBmpInfo.bmiHeader) ' &H28 'len(BITMAPINFOHEADER)
.stBmpInfo.bmiHeader.biWidth = .dwBmpWidth
.stBmpInfo.bmiHeader.biHeight = -.dwBmpHeight '- .dwBmpHeight
.stBmpInfo.bmiHeader.biPlanes = 1
.stBmpInfo.bmiHeader.biBitCount = 24
.stBmpInfo.bmiHeader.biCompression = BI_RGB
.stBmpInfo.bmiHeader.biSizeImage = 0
'End With
hMDC = CreateCompatibleDC(hdc)
SelectObject hMDC, hBmp
ReleaseDC hWnd, hdc
GetDIBits hMDC, hBmp, 0, .dwBmpHeight, .lpDIBitsSource, .stBmpInfo, DIB_RGB_COLORS
GetDIBits hMDC, hBmp, 0, .dwBmpHeight, .lpDIBitsRender, .stBmpInfo, DIB_RGB_COLORS
DeleteDC hMDC
If .lpWave1 = 0 Or .lpWave2 = 0 Or .lpDIBitsSource = 0 Or .lpDIBitsRender = 0 Or .hDcRender = 0 Then
WaveFree lpWaveObject
dwReturn = 1
End If
'Debug.Print "WaveInit " & .dwFlag
SetTimer hWnd, ByVal VarPtr(lpWaveObject), dwSpeed, AddressOf WaveTimerProc
.dwFlag = .dwFlag Or F_WO_ACTIVE Or F_WO_NEED_UPDATE
'Debug.Print "WaveInit " & .dwFlag
WaveRender lpWaveObject
hdc = GetDC(.hWnd)
WaveUpdateFrame lpWaveObject, hdc, True
ReleaseDC .hWnd, hdc
End With
'********************************************************************
result:
WaveInit = dwReturn
End Function
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' 一些特效
' 輸入：dwType = 0 關閉特效
' dwType <> 0 開啟特效，參數具體見上面
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Sub WaveEffect(lpWaveObject As WAVE_OBJECT, ByVal dwEffectType As WaveEffectType, ByVal dwParam1 As Long, ByVal dwParam2 As Long, ByVal dwParam3 As Long)
Dim dwMaxX As Long, dwMaxY As Long
With lpWaveObject
' Debug.Print "WaveEffect " & .dwFlag
Select Case dwEffectType
Case wClose '關閉特效
.dwFlag = .dwFlag And (Not F_WO_EFFECT)
.dwEffectType = dwEffectType
Exit Sub
'Case wrain '下雨
Case wLaunch '汽艇
.dwEff2XAdd = dwParam1
.dwEff2YAdd = dwParam1
.dwEff2X = WaveRandom(lpWaveObject, .dwBmpWidth - 2) + 1
.dwEff2Y = WaveRandom(lpWaveObject, .dwBmpHeight - 2) + 1
' .dwEffectType = dwEffectType
' .dwEffectParam1 = dwParam1
' .dwEffectParam2 = dwParam2
' .dwEffectParam3 = dwParam3
' .dwFlag = .dwFlag Or F_WO_EFFECT
'Case wWaves '風浪
'Case Else '默認
End Select
.dwEffectType = dwEffectType
.dwEffectParam1 = dwParam1
.dwEffectParam2 = dwParam2
.dwEffectParam3 = dwParam3
.dwFlag = .dwFlag Or F_WO_EFFECT
End With
End Sub
完