How to make a water effect on TImage or anything?

Question

OK, I just installed a Tortoise git in my PC. And I'm quiet amuse about the water effect from its about page.

enter image description here

try to move your mouse cursor on the turtle picture from tortoise GIT - About

its more like we are playing out finger on a water.

Does anyone know how to do make that kind of water effect in Delphi ?

"Water effect" is very vague. Could you edit your question to provide a link to the page, so we'll know what it is you're trying to do? — Mason Wheeler, Apr 19 '12 at 18:50
These are open source programs. If you are going to have a chance of doing something like this yourself, you'll need to be capable of finding, downloading, and reading the source code for Tortoise. — David Heffernan, Apr 19 '12 at 18:53
The image you've posted doesn't display the effect you mentioned. Is this effect on the website, or on the TortoiseGIT program itself? — Mason Wheeler, Apr 19 '12 at 18:57
This effect also exists in my Tortoise SVN. Just call the About box and move the mouse on the icon/title graphic. — Francesca, Apr 19 '12 at 19:03
try this article [2D Water Effect in WTL](http://www.codeproject.com/Articles/188236/2D-Water-Effect-in-WTL) is written using WTL and C++ and uses the same library used by tortoise. — RRUZ, Apr 19 '12 at 19:07

LU RD · Accepted Answer · 2012-04-19T20:36:22.117

35

See Leonel Togniolli's "Water Effects" at efg's lab.

enter image description here

The ripple effect is based on 2D Water Effects in December 1999 Game Developer Magazine Article .

The algorithm is described in here 2D Water, as mentioned by François and as a reference in the source code.

Leonel's implementation is partly based on the gamedev article the-water-effect-explained by Roy Willemse. Here is also pascal code.

There is one more Delphi example at efg's called "Ripple Project", a screen shot is shown below.

enter image description here

edited Apr 19 '12 at 20:36

answered Apr 19 '12 at 19:23

LU RD

34,438
5
88
296

I've tried to compile the Delphi translation in Delphi 2009 and XE3, but it consumes too much CPU time. Comparing to the CPP version, there must be something wrong with the translation. – TLama Jun 20 '13 at 09:39
@TLama, i compiled Leonels example in XE2, with some small adjustments. I'm travelling right now, so i will look into code when i'm back . – LU RD Jun 21 '13 at 03:53
@LU RD, thanks! Anyway, the code from the answer below works fine as well. – TLama Jun 21 '13 at 07:55
1

Just to mention, there is the ready made [`TCnWaterImage`](https://code.google.com/p/cnpack/source/browse/trunk/cnvcl/Source/Graphics/CnWaterImage.pas) control from CnPack which does this effect. – TLama Oct 09 '14 at 08:22
Nice demo. Please note that 'TLTWaterEffect.DrawCalc' cannot be used (crashes for some input images). – Gabriel Feb 22 '18 at 14:50

score 17 · Answer 2 · edited Jan 12 '13 at 19:34

Please do the following : 01. Create a Delphi Unit named "WaterEffect.pas" and paste the following codes:

unit WaterEffect;

interface

uses
  Winapi.Windows, System.SysUtils, Vcl.Graphics, Math;

const
  DampingConstant = 15;

type
  PIntArray = ^TIntArray;
  TIntArray = array[0..16777215] of Integer;
  PPIntArray = ^TPIntArray;
  TPIntArray = array[0..16777215] of PIntArray;
  PRGBArray = ^TRGBArray;
  TRGBArray = array[0..16777215] of TRGBTriple;
  PPRGBArray = ^TPRGBArray;
  TPRGBArray = array[0..16777215] of PRGBArray;
  TWaterDamping = 1..99;
  TWaterEffect = class(TObject)

  private
    { Private declarations }
    FrameWidth: Integer;
    FrameHeight: Integer;
    FrameBuffer01: Pointer;
    FrameBuffer02: Pointer;
    FrameLightModifier: Integer;
    FrameScanLine01: PPIntArray;
    FrameScanLine02: PPIntArray;
    FrameScanLineScreen: PPRGBArray;
    FrameDamping: TWaterDamping;
    procedure SetDamping(Value: TWaterDamping);

  protected
    { Protected declarations }
    procedure CalculateWater;
    procedure DrawWater(ALightModifier: Integer; Screen, Distance: TBitmap);

  public
    { Public declarations }
    constructor Create;
    destructor Destroy; override;
    procedure ClearWater;
    procedure SetSize(EffectBackgroundWidth, EffectBackgroundHeight: Integer);
    procedure Render(Screen, Distance: TBitmap);
    procedure Bubble(X, Y: Integer; BubbleRadius, EffectBackgroundHeight: Integer);
    property Damping: TWaterDamping read FrameDamping write SetDamping;
  end;

implementation

{ TWaterEffect }

const
  RandomConstant = $7FFF;

procedure TWaterEffect.Bubble(X, Y: Integer; BubbleRadius, EffectBackgroundHeight: Integer);
var
Rquad: Integer;
CX, CY, CYQ: Integer;
Left, Top, Right, Bottom: Integer;
begin
  if (X < 0) or (X > FrameWidth - 1) then X := 1 + BubbleRadius + Random(RandomConstant) mod (FrameWidth - 2 * BubbleRadius - 1);
  if (Y < 0) or (Y > FrameHeight - 1) then Y := 1 + BubbleRadius + Random(RandomConstant) mod (FrameHeight - 2 * BubbleRadius - 1);
  Left := -Min(X, BubbleRadius);
  Right := Min(FrameWidth - 1 - X, BubbleRadius);
  Top := -Min(Y, BubbleRadius);
  Bottom := Min(FrameHeight - 1 - Y, BubbleRadius);
  Rquad := BubbleRadius * BubbleRadius;
  for CY := Top to Bottom do
    begin
      CYQ := CY * CY;
        for CX := Left to Right do
          begin
            if (CX * CX + CYQ <= Rquad) then
              begin
                Inc(FrameScanLine01[CY + Y][CX + X], EffectBackgroundHeight);
              end;
          end;
    end;
end;

procedure TWaterEffect.CalculateWater;
var
X, Y, XL, XR: Integer;
NewH: Integer;
P1, P2, P3, P4: PIntArray;
PT: Pointer;
Rate: Integer;
begin
  Rate := (100 - FrameDamping) * 256 div 100;
  for Y := 0 to FrameHeight - 1 do
    begin
      P1 := FrameScanLine02[Y];
      P2 := FrameScanLine01[Max(Y - 1, 0)];
      P3 := FrameScanLine01[Y];
      P4 := FrameScanLine01[Min(Y + 1, FrameHeight - 1)];
      for X := 0 to FrameWidth - 1 do
        begin
          XL := Max(X - 1, 0);
          XR := Min(X + 1, FrameWidth - 1);
          NewH := (P2[XL] + P2[X] + P2[XR] + P3[XL] + P3[XR] + P4[XL] + P4[X] +
          P4[XR]) div 4 - P1[X];
          P1[X] := NewH * Rate div 256;
        end;
    end;
  PT := FrameBuffer01;
  FrameBuffer01 := FrameBuffer02;
  FrameBuffer02 := PT;
  PT := FrameScanLine01;
  FrameScanLine01 := FrameScanLine02;
  FrameScanLine02 := PT;
end;

procedure TWaterEffect.ClearWater;
begin
  if FrameBuffer01 <> nil then ZeroMemory(FrameBuffer01, (FrameWidth * FrameHeight) * SizeOf(Integer));
  if FrameBuffer02 <> nil then ZeroMemory(FrameBuffer02, (FrameWidth * FrameHeight) * SizeOf(Integer));
end;

constructor TWaterEffect.Create;
begin
  inherited;
  FrameLightModifier := 10;
  FrameDamping := DampingConstant;
end;

destructor TWaterEffect.Destroy;
begin
  if FrameBuffer01 <> nil then FreeMem(FrameBuffer01);
  if FrameBuffer02 <> nil then FreeMem(FrameBuffer02);
  if FrameScanLine01 <> nil then FreeMem(FrameScanLine01);
  if FrameScanLine02 <> nil then FreeMem(FrameScanLine02);
  if FrameScanLineScreen <> nil then FreeMem(FrameScanLineScreen);
  inherited;
end;

procedure TWaterEffect.DrawWater(ALightModifier: Integer; Screen, Distance:
  TBitmap);
var
DX, DY: Integer;
I, C, X, Y: Integer;
P1, P2, P3: PIntArray;
PScreen, PDistance: PRGBArray;
PScreenDot, PDistanceDot: PRGBTriple;
BytesPerLine1, BytesPerLine2: Integer;
begin
  Screen.PixelFormat := pf24bit;
  Distance.PixelFormat := pf24bit;
  FrameScanLineScreen[0] := Screen.ScanLine[0];
  BytesPerLine1 := Integer(Screen.ScanLine[1]) - Integer(FrameScanLineScreen[0]);
  for I := 1 to FrameHeight - 1 do FrameScanLineScreen[i] := PRGBArray(Integer(FrameScanLineScreen[i - 1]) + BytesPerLine1);
    begin
      PDistance := Distance.ScanLine[0];
      BytesPerLine2 := Integer(Distance.ScanLine[1]) - Integer(PDistance);
      for Y := 0 to FrameHeight - 1 do
        begin
          PScreen := FrameScanLineScreen[Y];
          P1 := FrameScanLine01[Max(Y - 1, 0)];
          P2 := FrameScanLine01[Y];
          P3 := FrameScanLine01[Min(Y + 1, FrameHeight - 1)];
          for X := 0 to FrameWidth - 1 do
            begin
              DX := P2[Max(X - 1, 0)] - P2[Min(X + 1, FrameWidth - 1)];
              DY := P1[X] - P3[X];
              if (X + DX >= 0) and (X + DX < FrameWidth) and (Y + DY >= 0) and (Y + DY < FrameHeight) then
                begin
                  PScreenDot := @FrameScanLineScreen[Y + DY][X + DX];
                  PDistanceDot := @PDistance[X];
                  C := PScreenDot.rgbtBlue - DX;
                  if C < 0 then PDistanceDot.rgbtBlue := 0 else if C > 255 then PDistanceDot.rgbtBlue := 255 else
                    begin
                      PDistanceDot.rgbtBlue := C;
                      C := PScreenDot.rgbtGreen - DX;
                    end;
                  if C < 0 then PDistanceDot.rgbtGreen := 0 else if C > 255 then PDistanceDot.rgbtGreen := 255 else
                    begin
                      PDistanceDot.rgbtGreen := C;
                      C := PScreenDot.rgbtRed - DX;
                    end;
                  if C < 0 then PDistanceDot.rgbtRed := 0 else if C > 255 then PDistanceDot.rgbtRed := 255 else
                    begin
                      PDistanceDot.rgbtRed := C;
                    end;
                end
              else
                begin
                  PDistance[X] := PScreen[X];
                end;
            end;
          PDistance := PRGBArray(Integer(PDistance) + BytesPerLine2);
        end;
    end;
end;

procedure TWaterEffect.Render(Screen, Distance: TBitmap);
begin
  CalculateWater;
  DrawWater(FrameLightModifier, Screen, Distance);
end;

procedure TWaterEffect.SetDamping(Value: TWaterDamping);
begin
  if (Value >= Low(TWaterDamping)) and (Value <= High(TWaterDamping)) then FrameDamping := Value;
end;

procedure TWaterEffect.SetSize(EffectBackgroundWidth, EffectBackgroundHeight: Integer);
var
I: Integer;
begin
  if (EffectBackgroundWidth <= 0) or (EffectBackgroundHeight <= 0) then
    begin
      EffectBackgroundWidth := 0;
      EffectBackgroundHeight := 0;
    end;
  FrameWidth := EffectBackgroundWidth;
  FrameHeight := EffectBackgroundHeight;
  ReallocMem(FrameBuffer01, FrameWidth * FrameHeight * SizeOf(Integer));
  ReallocMem(FrameBuffer02, FrameWidth * FrameHeight * SizeOf(Integer));
  ReallocMem(FrameScanLine01, FrameHeight * SizeOf(PIntArray));
  ReallocMem(FrameScanLine02, FrameHeight * SizeOf(PIntArray));
  ReallocMem(FrameScanLineScreen, FrameHeight * SizeOf(PRGBArray));
  ClearWater;
  if FrameHeight > 0 then
    begin
      FrameScanLine01[0] := FrameBuffer01;
      FrameScanLine02[0] := FrameBuffer02;
      for I := 1 to FrameHeight - 1 do
        begin
          FrameScanLine01[I] := @FrameScanLine01[I - 1][FrameWidth];
          FrameScanLine02[I] := @FrameScanLine02[I - 1][FrameWidth];
        end;
    end;
end;

end.

In "uses" add "WaterEffect".
Add a "Timer" with "Enable" property and "Interval=25".
In "Private Declaration" add "Water: TWaterEffect;" and "FrameBackground: TBitmap;".
Define "var X:Integer;"
Define the following

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Timer01.Enabled := true;
  FrameBackground := TBitmap.Create;
  FrameBackground.Assign(Image01.Picture.Graphic);
  Image01.Picture.Graphic := nil;
  Image01.Picture.Bitmap.Height := FrameBackground.Height;
  Image01.Picture.Bitmap.Width := FrameBackground.Width;
  Water := TWaterEffect.Create;
  Water.SetSize(FrameBackground.Width,FrameBackground.Height);
  X:=Image01.Height;
end;


procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FrameBackground.Free;
  Water.Free;
end;


procedure TMainForm.Image01MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Water.Bubble(X,Y,1,100);
end;


procedure TMainForm.Image01MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Water.Bubble(X,Y,1,100);
end;


procedure TMainForm.Timer01Timer(Sender: TObject);
begin
  if Random(8)= 1 then
    Water.Bubble(-1,-1,Random(1)+1,Random(500)+50);
    Water.Render(FrameBackground,Image01.Picture.Bitmap);
  with Image01.Canvas do
    begin
      Brush.Style:=bsClear;
      font.size:=12;
      Font.Style:=[];
      Font.Name := 'Comic Sans MS';
      font.color:=$e4e4e4;
      Textout(190, 30, DateTimeToStr(Now));
    end;
end;

Now Compile. I think you will get the required effect.

Looks great, but it's completely uncommented - what algorithm is it implementing to work? Is it your code or is it sourced somewhere else? — David, Oct 21 '14 at 10:38
Upvote because your code is much faster than Leonel Togniolli's. Unfortunately, it cannot be used on a decent-size image in real time! One can only get 8-12FPS. — Gabriel, Feb 22 '18 at 15:53

score 3 · Answer 3 · answered Apr 19 '12 at 19:00

3

That effect is generated by applying certain numerical transformations to the image. They're defined in the CWaterEffect class, which you can inspect for yourself in the WaterEffect.cpp source file.

answered Apr 19 '12 at 19:00

Rob Kennedy

161,384
21
275
467

Wasn't the question related to Delphi? C or Delphi, doesn't matter! Link is broken anyway! – Gabriel Feb 22 '18 at 15:29
Udated location of WaterEffect.cpp source file: https://github.com/TortoiseGit/TortoiseGit/blob/master/src/Utils/MiscUI/WaterEffect.cpp – Lars Jan 10 '23 at 13:03

How to make a water effect on TImage or anything?

3 Answers3

Linked