img - ¿Cómo hacer un efecto de agua en TImage o algo?

img title

Question

OK, acabo de instalar un Git Tortoise en mi PC. Y estoy en silencio divertido sobre el efecto de agua de su página.

intente mover el cursor de su mouse sobre la imagen de tortuga de la tortuga GIT - Acerca de

es más como si estuviéramos jugando con el dedo en el agua.

¿Alguien sabe cómo hacer ese tipo de efecto de agua en Delphi?

Answer 1

Ese efecto se genera aplicando ciertas transformaciones numéricas a la imagen. Están definidos en la clase CWaterEffect , que puedes inspeccionar por ti mismo en el archivo fuente WaterEffect.cpp .

Answer 2

Haga lo siguiente: 01. Cree una unidad Delphi llamada "WaterEffect.pas" y pegue los siguientes códigos:

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.

1. En "usos" agrega "WaterEffect".
2. Agregue un "Temporizador" con la propiedad "Habilitar" e "Intervalo = 25".
3. En "Declaración privada", agregue "Agua: TWaterEffect"; y "FrameBackground: TBitmap;".
4. Definir "var X: entero";
5. Defina lo siguiente

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;

Ahora Compile. Creo que obtendrás el efecto requerido.

Answer 3

Vea "Water Effects" de Leonel Togniolli en el laboratorio de efg.

El efecto dominó está basado en 2D Water Effects en diciembre de 1999 Artículo de Game Developer Magazine .

El algoritmo se describe aquí en 2D Water , como lo menciona François y como referencia en el código fuente.

La implementación de Leonel se basa en parte en el artículo gamedev the-water-effect-explained por Roy Willemse. Aquí también está el código pascal.

Hay un ejemplo más de Delphi en efg llamado "Proyecto Ripple", a continuación se muestra una captura de pantalla.