SUB skEffect ALIAS "skEffect" (BYVAL hDC&, _ ' Destination device context
BYVAL xDest&, _ ' Upper-left X coordinate (pixels)
BYVAL yDest&, _ ' Upper-left Y coordinate (pixels)
BYVAL nWidth&, _ ' Width of destination
BYVAL nHeight&, _ ' Height of destination
BYVAL hSrcBMP&, _ ' Handle of the source bitmap
BYVAL Dummy&, _ ' Unused
BYVAL CallBackFX AS DWORD, _ ' CODEPTR
BYVAL uGrain&, _ ' Pixel square size
BYVAL uDelay&, _ ' Speed effect in millisecond
BYVAL UseEffect&) EXPORT ' The effect type
REGISTER x&, y&
DIM Bm(2) AS BITMAP, hTmpBmp&(2), hDC&(2), hTmpDC&(2)
DIM bmi As BITMAPINFO
DIM pBits0 AS BYTE PTR, pBits1 AS BYTE PTR, pBits2 AS BYTE PTR
hDC&(1) = CreateCompatibleDC(hDC&)
CALL SelectObject(hDC&(1), hSrcBMP&)
hDC&(2) = CreateCompatibleDC(hDC&)
hResultBmp& = CreateCompatibleBitmap(hDC&, nWidth&, nHeight&)
hDestPrevBmp& = SelectObject(hDC&(2), hResultBmp&)
CALL BitBlt(hDC&(2), 0, 0, nWidth&, nHeight&, hDC&, xDest&, yDest&, %SRCCOPY)
bmi.bmiHeader.biSize = SIZEOF(bmi.bmiHeader)
bmi.bmiHeader.biWidth = nWidth&
bmi.bmiHeader.biHeight = nHeight&
bmi.bmiHeader.biPlanes = 1
bmi.bmiHeader.biBitCount = 32
bmi.bmiHeader.biCompression = %BI_RGB
FOR K& = 2 TO 0 STEP -1
hTmpDC&(K&) = CreateCompatibleDC (hDC&)
hTmpBmp&(K&) = CreateDIBSection(hTmpDC&(K&), bmi, %DIB_RGB_COLORS, 0, 0, 0)
CALL GlobalLock(hTmpBmp&(K&))
CALL SelectObject(hTmpDC&(K&), hTmpBmp&(K&))
IF K& THEN
CALL BitBlt(hTmpDC&(K&), 0, 0, nWidth&, nHeight&, hDC&(K&), 0, 0, %SRCCOPY)
END IF
CALL GetObject(hTmpBmp&(K&), SIZEOF(bm(K&)), bm(K&))
IF K& = 0 THEN
SELECT CASE LONG UseEffect&
CASE FxAlphablend ' Alphablending using using uGrain& as percent value
GOSUB ResetPTR
p1& = uGrain&: p2& = 100 - uGrain&
FOR Y& = nHeight& - 1 TO 0 STEP - 1
FOR X& = nWidth& - 1 TO 0 STEP -1
GOSUB ComputePTR
NEXT
NEXT
GOSUB DisplayFX
GOSUB DelayFX
CASE FxTop, FxBottom ' 1 = Dissolve from top
' 2 = Dissolve from bottom
GOSUB ResetPTR
FOR Y& = nHeight& - 1 TO 0 STEP - 1
Percent& = Y& / nHeight& * 100
IF UseEffect& = 1 THEN
p1& = percent&: p2& = 100 - percent&
ELSE
p1& = 100 - percent&: p2& = percent&
END IF
FOR X& = nWidth& - 1 TO 0 STEP -1
GOSUB ComputePTR
NEXT
NEXT
GOSUB DisplayFX
GOSUB DelayFX
CASE FxLeft, FxRight ' 3 = Dissolve from left
' 4 = Dissolve from right
GOSUB ResetPTR
FOR Y& = nHeight& - 1 TO 0 STEP - 1
FOR X& = nWidth& - 1 TO 0 STEP -1
Percent& = X& / nWidth& * 100
IF UseEffect& = 3 THEN
p1& = 100 - percent&: p2& = percent&
ELSE
p2& = 100 - percent&: p1& = percent&
END IF
GOSUB ComputePTR
NEXT
NEXT
GOSUB DisplayFX
GOSUB DelayFX
CASE FxHorzCenter, FxVertCenter ' 5 = Dissolve horizontaly to center
' 6 = Dissolve verticaly to center
GOSUB ResetPTR
FOR Y& = nHeight& - 1 TO 0 STEP - 1
IF UseEffect& = 5 THEN
IF Y& < nHeight& \ 2 THEN
Percent& = (Y& / nHeight& * 100) * 2
ELSE
Percent& = 200 - ((Y& / nHeight& * 100) * 2)
END IF
p2& = 100 - percent&: p1& = percent&
END IF
FOR X& = nWidth& - 1 TO 0 STEP -1
IF UseEffect& = 6 THEN
IF X& < nWidth& \ 2 THEN
Percent& = (X& / nWidth& * 100) * 2
ELSE
Percent& = 200 - ((X& / nWidth& * 100) * 2)
END IF
p2& = 100 - percent&: p1& = percent&
END IF
GOSUB ComputePTR
NEXT
NEXT
GOSUB DisplayFX
GOSUB DelayFX
CASE FxCenter ' 7 = Dissolve to center
GOSUB ResetPTR
FOR Y& = nHeight& - 1 TO 0 STEP - 1
IF Y& < nHeight& \ 2 THEN
P& = (Y& / nHeight& * 100) * 2
ELSE
P& = 200 - ((Y& / nHeight& * 100) * 2)
END IF
FOR X& = nWidth& - 1 TO 0 STEP -1
IF X& < nWidth& \ 2 THEN
Percent& = (X& / nWidth& * 100) * 2
ELSE
Percent& = 200 - ((X& / nWidth& * 100) * 2)
END IF
IF P& < Percent& THEN Percent& = P&
p2& = 100 - percent&: p1& = percent&
GOSUB ComputePTR
NEXT
NEXT
GOSUB DisplayFX
GOSUB DelayFX
CASE ELSE ' Full dissolve
FOR Percent& = 1 TO 100 STEP uGrain&
GOSUB ResetPTR
p1& = percent&: p2& = 100 - percent&
FOR Y& = nHeight& - 1 TO 0 STEP - 1
FOR X& = nWidth& - 1 TO 0 STEP -1
GOSUB ComputePTR
NEXT
NEXT
GOSUB DisplayFX
IF uDelay& THEN
T??? = GetTickCount + uDelay&
DO WHILE GetTickCount < T???
CALL apiSLEEP(0)
GOSUB CheckStatusFX: IF BailOut& THEN EXIT DO
LOOP
ELSE
GOSUB CheckStatusFX
END IF
IF BailOut& THEN EXIT FOR
NEXT
END SELECT
FOR T& = 0 TO 2
CALL GlobalUnLock(hTmpBmp&(T&))
CALL DeleteDC(hTmpDC&(T&)): CALL DeleteObject(hTmpBmp&(T&))
NEXT
END IF
NEXT
' Select original objects back.
CALL SelectObject(hDC&(2), hDestPrevBmp&)
' Deallocate system resources.
CALL DeleteObject(hResultBmp&)
FOR K& = 1 TO 2
DeleteDC hDC&(K&)
NEXT
EXIT SUB
ResetPTR:
pBits0 = bm(0).bmBits
pBits1 = bm(1).bmBits
pBits2 = bm(2).bmBits
RETURN
ComputePTR:
@pBits0[2] = ((p1& * @pBits1[2] + p2& * @pBits2[2])) \ 100
@pBits0[1] = ((p1& * @pBits1[1] + p2& * @pBits2[1])) \ 100
@pBits0[0] = ((p1& * @pBits1[0] + p2& * @pBits2[0])) \ 100
pBits0 = pBits0 + 4: pBits1 = pBits1 + 4: pBits2 = pBits2 + 4
RETURN
DelayFX:
IF uDelay& THEN
T??? = GetTickCount + uDelay&
DO WHILE GetTickCount < T???
CALL apiSLEEP(0)
GOSUB CheckStatusFX: IF BailOut& THEN EXIT DO
LOOP
END IF
RETURN
CheckStatusFX:
IF CallBackFX THEN
CALL DWORD CallBackFX USING StatusCallBack(0) TO BailOut&
IF BailOut& <> ERROR_USER_ABORT THEN BailOut& = 0
END IF
RETURN
DisplayFX:
CALL BitBlt(hDC&, xDest&, yDest&, nWidth&, nHeight&, hTmpDC&(K&), 0, 0, %SRCCOPY)
RETURN
END SUB
'
Reply With Quote