Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe "gbripple_short.exe"
#Dim All
#Debug Error On 'catch array/pointer errors - OFF in production
#Debug Display On 'display untrapped errors - OFF in production
%Unicode = 1
#Include "Win32api.inc"
Enum Equates Singular
IDC_Graphic = 500
ID_TImer
End Enum
Global hDlg,hBMP,hGraphic As Dword
Global bmpR$, bmpT$, Disturb,X0,Y0,Interval,Decay,Refract As Long
Global imgH, imgW, riprad, RippleMap(), Ripple(), Texture() As Long
Global oldind, newind, mapind As Long
Function PBMain() As Long
Dialog New Pixels, 0, "Water Ripple",300,300,500,220, %WS_OverlappedWindow To hDlg
Control Add Graphic, hDlg, %IDC_Graphic,"", 0,0,500,220
Control Handle hDlg, %IDC_Graphic To hGraphic
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local i,x,y As Long
Select Case Cb.Msg
Case %WM_InitDialog
'background image
If IsFile("images\foot.bmp") Then
Graphic Bitmap Load "images\foot.bmp", 0, 0 To hBmp
Graphic Attach hBMP, 0
Else
Graphic Bitmap New 500,220 To hBMP
Graphic Attach hBmp, 0
Graphic Color %Black, %rgb_Orange : Graphic Clear : Graphic Width 20
Graphic Font "Tahoma", 14, 1
Graphic Set Pos (20,20) : Graphic Print "Bitmap file missing: images\foot.bmp"
For i = 120 To 600 Step 60 : Graphic Line (0,i)-(i-60,80) : Next i
End If
Graphic Get Canvas To imgW, imgH
'stretch image into Graphic background
Graphic Attach hDlg, %IDC_Graphic, ReDraw
Graphic Stretch Page hBMP, 0, %Mix_CopySrc, %HalfTone 'Graphic Stretch hBMP, 0, (0,0)-(imgWN-1,imgHN-1) To (0,0)-(imgW-1,imgH-1), %Mix_CopySrc, %HalfTone
Graphic Get Bits To bmpT$
bmpR$ = bmpT$
'initialize Ripple stuff
RippleCode 1,0,0,0,0
'Start animation
SetTimer hDlg, %ID_Timer, Interval, 0
Case %WM_MouseMove, %WM_LButtonDown
If (Cb.WParam And %MK_LButton) Then RippleCode 0,1,0,Lo(Word,Cb.LParam)-X0, Hi(Word,Cb.LParam)-Y0
Case %WM_Destroy
KilLTimer hDlg, %ID_Timer
Case %WM_Timer
RippleCode 0,0,1,0,0
Graphic Set Bits bmpR$ : Graphic ReDraw
End Select
End Function
Sub RippleCode (Flag_Init As Long, Flag_Splash As Long, Flag_NewFrame As Long, dxx As Long, dyy As Long)
Local j,k, i,x,y,xData,a,b As Long
If Flag_Init Then
Decay = 90 : RipRad = 5 : Disturb = 512 : Interval = 40 : Refract = 1024
ReDim RippleMap(imgW*(imgH+2) * 2)
ReDim Texture(imgW*imgH) As Long At StrPtr(bmpT$) + 8
ReDim Ripple(imgW*imgH) As Long At StrPtr(bmpR$) + 8
oldind = imgW
newind = imgW * (imgH+3)
End If
If Flag_Splash Then
For j = dyy -RipRad To dyy+RipRad
For k = dxx - RipRad To dxx + RipRad
If (j>=0 And j<imgH And k>=0 And k<imgW) Then ripplemap(oldind+(j*imgW)+k) += Disturb
Next k
Next j
End If
If Flag_NewFrame Then
Swap oldind, newind 'toggle maps each frame
mapind=oldind
For y = 0 To imgH-1
For x = 0 To imgW-1
xData = (ripplemap(mapind-imgW)+ripplemap(mapind+imgW)+ripplemap(mapind-1)+ripplemap(mapind+1))\2
xData -= ripplemap(newind+i) 'subtract value in current state map
xData = xData - xData / (100-Decay) 'decay value each frame
ripplemap(newind+i)=xData 'set the height value in the next frame
xData = (2*Disturb-xdata) 'where xData=0 then still, where xdata>0 then wave
a=((x-imgW\2)*xData/Refract)+imgW\2 'color displayed is based on offset position (gives distortion)
b=((y-imgH\2)*xData/Refract)+imgH\2 'color displayed is based on offset position (gives distortion)
If a>=imgW Then a=imgW-1 'bounds check
If a<0 Then a=0 'bounds check
If b>=imgH Then b=imgH-1 'bounds check
If b<0 Then b=0 'bounds check
Ripple(i)=Texture(a+b*imgW) 'set color to be displayed
Incr mapind 'next location in target state map
Incr i 'next location in current state map
Next x
Next Y
End If
End Sub
'gbs_01418
'Date: 10-17-2014
http://www.garybeene.com/sw/gbsnippets.htm