如何在 TImage 或任何东西上制作水效果？答案

【问题标题】：How to make a water effect on TImage or anything?如何在 TImage 或任何东西上制作水效果？
【发布时间】：2012-05-01 08:38:36
【问题描述】：

好的，我刚刚在我的 PC 中安装了一个 Tortoise git。我很喜欢它关于页面的水效果。

尝试将鼠标光标移动到乌龟 GIT 中的乌龟图片上 - 关于

这更像是我们在玩水。

有谁知道如何在 Delphi 中制作那种水效果？

【问题讨论】：

“水效果”很模糊。您能否编辑您的问题以提供指向该页面的链接，以便我们知道您要做什么？
这些是开源程序。如果您有机会自己做这样的事情，您需要能够找到、下载和阅读 Tortoise 的源代码。
您发布的图片没有显示您所说的效果。这是对网站的影响，还是对 TortoiseGIT 程序本身的影响？
这个效果也存在于我的 Tortoise SVN 中。只需调用 About 框并将鼠标移动到图标/标题图形上。
试试这篇文章2D Water Effect in WTL是用WTL和C++写的，和tortoise使用的库是一样的。

标签： image delphi effect

【解决方案1】：

查看 Leonel Togniolli 在 efg 实验室的 "Water Effects"。

涟漪效果基于2D Water Effects in December 1999 Game Developer Magazine Article 。

该算法在此处2D Water 中进行了描述，正如 François 所提到的，并且作为源代码中的参考。

Leonel 的实现部分基于 Roy Willemse 的 gamedev 文章 the-water-effect-explained。这里也是帕斯卡代码。

在 efg 上还有一个名为“Ripple Project”的 Delphi 示例，屏幕截图如下所示。

【讨论】：

我尝试在Delphi 2009 和XE3 中编译Delphi 翻译，但是它消耗了太多的CPU 时间。与CPP版本相比，翻译肯定有问题。
@TLama，我在 XE2 中编译了 Leonels 示例，并进行了一些小调整。我现在正在旅行，所以我回来后会查看代码。
@LU RD，谢谢！无论如何，下面答案中的代码也可以正常工作。
顺便提一下，CnPack 提供了现成的TCnWaterImage 控件来实现此效果。
不错的演示。请注意，不能使用“TLTWaterEffect.DrawCalc”（某些输入图像会崩溃）。

【解决方案2】：

请执行以下操作： 01.创建一个名为“WaterEffect.pas”的Delphi Unit并粘贴以下代码：

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.

在“用途”中添加“WaterEffect”。
添加一个带有“Enable”属性和“Interval=25”的“Timer”。
在“私人声明”中添加“水：TWaterEffect;”和“FrameBackground：TBitmap；”。
定义“var X:Integer;”
定义以下内容

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;

现在编译。我想你会得到所需的效果。

【讨论】：

看起来不错，但它完全没有注释——它实现了什么算法来工作？是您的代码还是来自其他地方？
赞成，因为您的代码比 Leonel Togniolli 的要快得多。不幸的是，它不能实时用于大尺寸图像！一个人只能得到8-12FPS。

【解决方案3】：

这种效果是通过对图像应用某些数值变换来产生的。它们在 CWaterEffect 类中定义，您可以在 the WaterEffect.cpp source file 中自行检查。

【讨论】：

这个问题不是和Delphi有关吗？ C或Delphi，没关系！反正链接坏了！