Sign in to follow this  

Help me to create water effect in delphi7

This topic is 3862 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

This topic is 3862 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.

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

Sign in to follow this