如何使的TImage或任何水的效果呢？(How to make a water effect on

2019-07-29 02:08发布

站内文章 / 移动开发
26 0 0

好吧，我刚刚安装在我的电脑龟饭桶。 同时，我对从有关页面水效果安静逗。

尝试移动您的鼠标光标从GIT龟龟的画面 - 关于

它更像是我们打了手指上的水。

有谁知道怎么做让那种在Delphi中水的效果呢？

Answer 1:

见莱昂内尔Togniolli的“水效应”在EFG的实验室。

连锁反应是基于1999年12月游戏开发者杂志文章2D水分效应 。

该算法在这里所描述的2D水 ，如由弗朗索瓦和在源代码的引用提及。

莱昂内尔的实现是部分基于gamedev文章的水效果的解释由Roy WILLEMSE。 这里也是PASCAL代码。

有一个在EFG的一个更德尔福例如所谓的“涟漪工程”，屏幕截图如下图所示。



Answer 2:

请执行下列操作：01.创建一个名为“WaterEffect.pas”德尔福单位并粘贴以下代码： 

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. 添加“定时器”与“启用”属性和“间隔= 25”。
  3. 在“私人宣言”加“水：TWaterEffect;” 和 “FrameBackground：TBitmap;”。
  4. 定义“变种X：整数。”
  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源文件 。



文章来源: How to make a water effect on TImage or anything?
标签： image delphi effect
举报

收藏的人(0)

Ta的文章 更多文章
登录 后发表评论
0条评论
还没有人评论过~