image - 如何在 TImage 或任何东西上制作水效果？

Question

好的，我刚刚在我的电脑上安装了一个 Tortoise git。我对它关于页面的水效果很感兴趣。

尝试将鼠标光标移动到来自 tortoise GIT 的海龟图片上 - 关于

更像是我们在玩水。

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

Answer 1

请参阅 efg 实验室的 Leonel Togniolli 的“水效应”。

涟漪效果基于1999 年 12 月 Game Developer Magazine 文章中的 2D Water Effects 。

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

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

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

Answer 2

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

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. 在“用途”中添加“WaterEffect”。
2. 添加一个带有“Enable”属性和“Interval=25”的“Timer”。
3. 在“私人声明”中添加“水：TWaterEffect；” 和“FrameBackground：TBitmap；”。
4. 定义“var X:Integer;”
5. 定义以下

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;

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

Answer 3

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