Jump to content
  • Advertisement
Sign in to follow this  

Help me to create water effect in delphi7

This topic is 4169 days old which is more than the 365 day threshold we allow for new replies. Please post a new topic.

If you intended to correct an error in the post then please contact us.

Recommended Posts

can every body help me ?? because i am create water effect in delphi7 not perfect because the color is broken.it my homework. i was read the web site tutor but i was confused. this the listing was i create if wrong i hope every body can correct it thanks. unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtDlgs, ExtCtrls,math; type TForm1 = class(TForm) Image1: TImage; Image2: TImage; OpenPictureDialog1: TOpenPictureDialog; Button1: TButton; Button2: TButton; Button3: TButton; Image3: TImage; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure updatewavemap; procedure init; procedure initize; procedure gambar; procedure gambar1; procedure RenderWaveToDIB; procedure WaveMapDrop(x,y,w,MulFactor: integer); procedure FormCreate(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Image2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end; const MAXX=300; MAXY=300; DAMP = 4; rIndex = 4.0; var Form1: TForm1; CT,NW:byte; WaveMap: Array[0..1, 0..MAXX, 0..MAXY] of integer; dispLut: Array[0..511] of byte; keluar:boolean; implementation {$R *.dfm} procedure tform1.initize; var c,d:integer; begin for c:=-256 to 255 do begin d:=c div 4; dispLut[c+256] := Byte(Trunc(Tan(ArcSin((Sin(ArcTan(d))/rIndex)))*d)); end; end; procedure tform1.init; var y,x:integer; begin for y := 0 to MAXY do begin for x := 0 to MAXX do begin //waveMap[nw,x,y]:=image1.Canvas.Pixels[y,x]; waveMap[NW,x,y]:=image1.Canvas.Pixels[y,x]; // wavemap[ct,x,y]:=0; end; end; end; procedure tform1.gambar; var i,j:integer; begin for i:= 0 to maxx-1 do begin for j:= 0 to maxy-1 do begin image2.Canvas.Pixels[j,i]:=waveMap[ct,j,i]; end; end; end; procedure tform1.WaveMapDrop(x,y,w,MulFactor: integer); var u,v:integer; sqrx,sqry,sqrw: integer; begin 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.gambar1; var i,j:integer; begin for i:= 0 to maxx-1 do begin for j:= 0 to maxy-1 do begin image3.Canvas.Pixels[j,i]:=waveMap[ct,j,i]; end; end; end; procedure Tform1.RenderWaveToDIB; var x,y,newcolor,xDiff,yDiff,xDisp,yDisp: Smallint; 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]; yDisp := dispLut[yDiff+256]; if xDiff<0 then begin // Current position is higher - Clockwise rotation if (yDiff<0) then newcolor := image1.canvas.Pixels[x-xDisp,y-yDisp] else newcolor := image1.canvas.Pixels[x-xDisp,y+yDisp] end else begin if (yDiff<0) then newcolor := image1.canvas.Pixels[x+xDisp,y-yDisp] else newcolor := image1.canvas.Pixels[x+xDisp,y+yDisp] end; image2.canvas.pixels[x,y] := newcolor; end; end; end; procedure tform1.updatewavemap; var y,x:integer; n:integer; begin 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];} n := ( WaveMap[CT,x-1,y] + WaveMap[CT,x+1,y] + WaveMap[CT,x,y-1] + WaveMap[CT,x,y+1] ) div 2 - WaveMap[NW,x,y]; n:= n - (n div damp); {asm 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.Button1Click(Sender: TObject); begin if OpenPictureDialog1.Execute then begin image1.Picture.LoadFromFile(OpenPictureDialog1.FileName); end; end; procedure TForm1.Button2Click(Sender: TObject); var x,y,i,j:integer; totr,totg,totb:integer; tmp:integer; begin CT:=0; NW:=1; x := 40 + random(MAXX-40); y := 40 + random(MAXY-40); WaveMapDrop(x,y,10,25); UpdateWaveMap; RenderWaveToDIB; end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var warnar,warnag,warnab:integer; begin { warnar:=GetRValue(image1.Canvas.Pixels[y,x]); warnag:=GetGValue(image1.Canvas.Pixels[y,x]); warnab:=GetBValue(image1.Canvas.Pixels[y,x]); showmessage(inttostr(Warnar)); showmessage(inttostr(Warnag)); showmessage(inttostr(Warnab)); } end; procedure TForm1.FormCreate(Sender: TObject); begin CT:=0; NW:=1; end; procedure TForm1.Button3Click(Sender: TObject); var i,j:double; warna:cardinal; begin keluar:=true; warna:=30; j:=30; i:=arctan(warna); showmessage(floattostr(i)); end; procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin showmessage(inttostr(getrvalue(image2.Canvas.Pixels[y,x]))); showmessage(inttostr(getgvalue(image2.Canvas.Pixels[y,x]))); showmessage(inttostr(getbvalue(image2.Canvas.Pixels[y,x]))); end; end.

Share this post

Link to post
Share on other sites
Sign in to follow this  

  • Advertisement

Important Information

By using GameDev.net, you agree to our community Guidelines, Terms of Use, and Privacy Policy.

We are the game development community.

Whether you are an indie, hobbyist, AAA developer, or just trying to learn, GameDev.net is the place for you to learn, share, and connect with the games industry. Learn more About Us or sign up!

Sign me up!