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

Question

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

intenta mover el cursor del ratón sobre la imagen de la tortuga de la tortuga GIT - Sobre

es más como estamos jugando a cabo en un dedo de agua.

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

Answer 1

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

El efecto dominó se basa en 2D Water Effects in December 1999 Game Developer Magazine Article .

El algoritmo se describe aquí 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 de 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.

Answer 2

Ese efecto se genera aplicando ciertas transformaciones numéricas a la imagen. Están definidos en la clase CWaterEffect, que puede inspeccionar usted mismo en the WaterEffect.cpp source file.

Answer 3

Por favor, haga lo siguiente: 01. Crear una unidad de Delphi llamado "WaterEffect.pas" y pegar 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 "utiliza" add "WaterEffect" .
2. Agregue un "Temporizador" con la propiedad "Habilitar" e "Intervalo = 25".
3. En "Declaración privada", agregue "Water: TWaterEffect;" y "FrameBackground: TBitmap;".
4. Define "var X: Entero;"
5. Definir el 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 compila. Creo que obtendrás el efecto requerido.