Delphi + delphiX( DirectX Delphi控件 ) 实现水纹效果。··大概翻译了下里面的算法···重新用程序里表现了下

请在优快云下载中心 http://download.youkuaiyun.com/source/1674110 

 

用的是俺参与的1个游戏项目的图。 可自定义特效范围和大小。DX处理起来比GDI效率高很多···

 

原图：

 

 

效果1：

 

 

效果2：

 

 

 

 

 

 

 

 

顺便支持下该游戏，直接关系到年终分红：www.8880666.com .

 

顺便再支持下，我最近做的1个手机游戏开发网：www.j2megame.com 天朝的备案还没下来，内容已经搞完了。

 

翻译老外的英文花了点时间，如果觉得翻译不准确的话，欢迎指教。

 

DelphiX 下载地址：http://www.delphix.com.cn/(Hori)delphix/DelphiX2000_0717-2.zip

 

请在优快云下载中心搜索 DXTEST 就是该程序了

 

 

 

 

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls,Math, DXDraws, DIB, DXClass ; const MAXX = 300; MAXY = 200; DAMP = 2; rIndex = 4.0; type TForm1 = class(TForm) Button1: TButton; Image2: TImage; DXDIB1: TDXDIB; BackGround: TDXDIB; DXDraw1: TDXDraw; DXTimer1: TDXTimer; Image1: TImage; DXTimer2: TDXTimer; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure DXTimer1Timer(Sender: TObject; LagCount: Integer); procedure FormDestroy(Sender: TObject); procedure DXTimer2Timer(Sender: TObject; LagCount: Integer); private { Private declarations } public { Public declarations } Fullscreen : Tbitmap; TimeCount : Integer ; x2,y2,xi,yi,xc,yc,angle: Integer ; cosy,siny:real; Tmp: Byte; //获取程序指定区域大小 procedure StoreRectScreen( sx, sy, sWidth, sHeight : Integer ); procedure playWater(tx,ty,tWidth,tHeight : Integer ) ; //水纹效果 procedure WaveMapDrop(x,y,w,MulFactor: integer); //水纹纹理粒子 procedure UpdateWaveMap; //刷新纹理 procedure RenderWaveToDIB(DIB: TDIB); //渲染水纹 procedure InitWaveMap; //水纹初始化 procedure initData ; //初始化数据 end; TWaveMap = array[0..1,0..MAXX,0..MAXY] of Smallint; var Form1: TForm1; tsin,tcos: Array[0..511] of Single; //511 Closing: Boolean; WaveMap: TWaveMap; CT,NW: byte; dispLut: Array[0..511] of byte; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin DXDraw1.Left := 256 ; DXDraw1.Top := 160 ; DXDraw1.Width := 281 ; DXDraw1.Height := 193 ; TimeCount := 0 ; playWater( 256, 160, 281, 193 ) ; end; //============================================================================== //获取程序指定区域大小 //============================================================================== procedure TForm1.StoreRectScreen(sx, sy, sWidth, sHeight: Integer); var FullscreenCanvas:TCanvas; dc:HDC; Image2 : TBitmap ; begin Fullscreen.Width := sWidth; Fullscreen.Height := sHeight; // DC := GetDC(0); //全屏 dc := GetDC(Self.Handle) ; FullscreenCanvas := TCanvas.Create; FullscreenCanvas.Handle := DC; Fullscreen.Canvas.CopyRect(Rect(0, 0, sWidth, sHeight), fullscreenCanvas,Rect(sx, sy, sWidth+sx, sHeight+sy)); FullscreenCanvas.Free; ReleaseDC(0, DC); Image2 := TBitmap.Create ; Image2.Assign(Fullscreen); Image2.SaveToFile('tmp.bmp'); Image2.Free; end; //============================================================================== //水纹效果 //============================================================================== procedure TForm1.playWater(tx,ty,tWidth,tHeight : Integer ); begin //采集指定屏幕区域 StoreRectScreen(tx,ty,tWidth,tHeight); BackGround.DIB.Assign(Fullscreen); BackGround.DIB.BitCount := 24 ; DXDIB1.DIB.SetSize(BackGround.DIB.Width,BackGround.DIB.Height,24); //启动特效 DXTimer1.Enabled := True ; //防黑屏闪烁 initData ; DXDraw1.Visible := True ; end; //============================================================================== //水纹纹理粒子 //============================================================================== procedure TForm1.WaveMapDrop(x, y, w, MulFactor: integer); var u,v:integer; sqrx,sqry,sqrw: integer; begin (* ------------------------------------------------------------------------ *) (* 使用该方法产生不同大小的纹理. *) (* (x, y) 是坐标, w 是大小, MulFactor 是Splash强度 *) (* ------------------------------------------------------------------------ *) sqrw := sqr(w); if (x>w) and (x<MAXX -w) and (y>w) and (y<MAXY -w) then begin for v:=y-w to y+w do begin sqry := sqr(v-y); for u:=x-w to x+w do begin sqrx := sqr(u-x); if (sqrx+sqry)<=sqrw then begin WaveMap[CT,u,v] := MulFactor*Trunc(w-sqrt(sqrx+sqry)); end; end; end; end; end; //============================================================================== //刷新纹理 //============================================================================== procedure TForm1.UpdateWaveMap; var x,y: Integer ; n : SmallInt ; begin (* ------------------------------------------------------------------------ *) (* 计算1帧水纹在时间t *) (* *) (* 水纹的高度在 (x, y)时候，是由 水纹在（x,y）点的上下左右的高度和 除以2，大约等于水纹高度的2倍 定义的 *) (* *) (* 这里是水纹动画的重点: 用我们的总数减去水纹的高度在(x，y)在(t-1)时候 *) (* *) (* 如果上1个水纹比平均高度高, 则水纹降落. *) (* 如果上1个水纹比平均高度低, 则水纹上升. *) (* *) (* 请看简短的描述: *) (* *) (* **** **** *) (* ----*** -----------------***----------- 平均高度; *) (* **** **** 水纹增长 *) (* ********** *) (* *) (* *) (* ********** *) (* -------****----------****-------------- 平均高度; *) (* *** *** 水纹下落 *) (* **** **** *) (* *) (* 当水纹上上下下移动时候, 波浪逐渐失去能量. 这种模拟是通过阻尼因子实现的。 *) (* 这种因子依靠于水纹的高度, *) (* 所以越高的水纹能量丢失越快，越低的水纹能量丢失的越慢 *) (* *) (* wave_height = wave_height - (wave_height / damp_factor) *) (* ------------------------------------------------------------------------ *) for y:=2 to MAXY -2 do begin for x:=2 to MAXX -2 do begin n:=( WaveMap[CT,x-1,y] + WaveMap[CT,x-2,y] + WaveMap[CT,x+1,y] + WaveMap[CT,x+2,y] + WaveMap[CT,x,y-1] + WaveMap[CT,x,y-2] + WaveMap[CT,x,y+1] + WaveMap[CT,x,y+2] + WaveMap[CT,x-1,y-1] + WaveMap[CT,x+1,y-1] + WaveMap[CT,x-1,y+1] + WaveMap[CT,x+1,y+1] ) div 6 - WaveMap[NW,x,y]; asm //计算n=wave_height - (wave_height / damp_factor) push bx mov bx, n sar bx, DAMP sub n, bx pop bx end; WaveMap[NW,x,y] := n; // Store result end; end; end; //============================================================================== //渲染水纹 //============================================================================== procedure TForm1.RenderWaveToDIB(DIB: TDIB); var x,y,newcolor,xDiff,yDiff,xDisp,yDisp: Integer ; begin for y:=0 to MAXY do begin for x:=0 to MAXX do begin xDiff := WaveMap[NW,x+1,y] - WaveMap[NW,x,y]; yDiff := WaveMap[NW,x,y+1] - WaveMap[NW,x,y]; xDisp := dispLut[xDiff+256]; //256 yDisp := dispLut[yDiff+256]; if xDiff<0 then begin // 当前位置过高，循环旋转播放 if (yDiff<0) then newcolor := Background.DIB.Pixels[x-xDisp,y-yDisp] else newcolor := Background.DIB.Pixels[x-xDisp,y+yDisp] end else begin if (yDiff<0) then newcolor := Background.DIB.Pixels[x+xDisp,y-yDisp] else newcolor := Background.DIB.Pixels[x+xDisp,y+yDisp] end; //去除黑色 if newcolor <> 0 then DIB.Pixels[x,y] := newcolor else DIB.Pixels[x,y] := Background.DIB.Pixels[x,y] ; end; end; end; //============================================================================== //水纹初始化 //============================================================================== procedure TForm1.InitWaveMap; var x,y: Integer ; c,d: Integer ; begin for c:=-256 to 255 do begin d:=c ; dispLut[c+256] := Byte(Trunc(Tan(ArcSin((Sin(ArcTan(d))/rIndex)))*d)); end; for c:=0 to 511 do begin tsin[c] := sin( ((c*360)/511) * Pi/180 ); tcos[c] := cos( ((c*360)/511) * Pi/180 ); end; for y:=0 to MAXY do begin for x:=0 to MAXX do begin WaveMap[CT,x,y] := 0; WaveMap[NW,x,y] := 0; end; end; end; //============================================================================== //初始化数据 //============================================================================== procedure TForm1.initData; begin if not DXDraw1.CanDraw then Exit; DXDRAW1.Surface.Fill(0); DXDRAW1.Surface.LoadFromDIB(BackGround.DIB); DXDraw1.Flip; end; //============================================================================== //窗口初始化 //============================================================================== procedure TForm1.FormCreate(Sender: TObject); begin Self.doublebuffered := True ; Fullscreen := TBitmap.Create; InitWaveMap; end; //============================================================================== //窗口销毁 //============================================================================== procedure TForm1.FormDestroy(Sender: TObject); begin Fullscreen.free ; end; //============================================================================== //单线程Timer //============================================================================== procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer); var x,y : Integer ; const sx = 80; sy = 80; begin Inc(TimeCount) ; if TimeCount = 1 then begin xc := Background.DIB.Width ; yc := Background.DIB.Height ; CT:=0; // 当前 NW:=1; // 新的 angle:=0; x2:=4; xi:=4; y2:=4; yi:=3; WaveMapDrop(xc,yc,40,-100); end else begin cosy := (sy-yc) * tcos[angle and $1ff]; siny := (sy-yc) * tsin[angle and $1ff]; x := Trunc((sx-xc) * tsin[angle and $1ff] + cosy)+xc; y := Trunc((sx-xc) * tcos[angle and $1ff] - siny)+yc; angle:=angle+8; WaveMapDrop(x,y,4,-500); //-500 WaveMapDrop(x2,y2,4,-500); //-500 x2:=x2+xi; y2:=y2+yi; if (x2<4) or (x2>MAXX -4) then xi:=-xi; if (y2<4) or (y2>MAXY -4) then yi:=-yi; UpdateWaveMap; RenderWaveToDIB(DXDIB1.DIB); // 交换水纹 Tmp:=CT; CT:=NW; NW:=Tmp; if DXDraw1.CanDraw then begin DXDraw1.Surface.Assign(DXDIB1.DIB); DXDraw1.Flip; end; end ; end; //============================================================================== //不断初始化 //============================================================================== procedure TForm1.DXTimer2Timer(Sender: TObject; LagCount: Integer); begin if not DXDraw1.CanDraw then Exit else begin end ; end; end.