ripplethread.pas

FLASH贺卡代码

unit RippleThread;

interface

uses
  Classes, ExtCtrls, Windows, Graphics, SysUtils;

type
  TRipple = class(TThread)
  private
    FBgImage: TImage;
    FEnabled: Boolean;
    Buffer1, Buffer2, TempBuffer: array of SmallInt;
  protected
    procedure Execute; override;
  public
    procedure Drop(X, Y: Integer); 
    property Image: TImage read FBgImage write FBgImage;
    property Enabled: Boolean read FEnabled write FEnabled;
  end;


implementation

type
  PRgbArray = ^TRgbArray;
  TRgbArray = array[0..5] of TRGBQuad;


{ TRipple }

procedure TRipple.Drop(X, Y: Integer);
var
  Offset: Integer;
begin
  Offset := Y * FBgImage.Width + X;
  if Buffer1[Offset] - 512 < -32768 then
    Buffer1[Offset] := -32768
  else
    Buffer1[Offset] := Buffer1[Offset] - 512;
end;

procedure TRipple.Execute;
var
  K, X, Y, OffsetX, OffsetY: Integer;
  BackgroundColorArray: array of TRGBQuad;
  TheColor: TColor;
  TheRGBQuad: TRGBQuad;
  Surface: TBitmap;
begin
  inherited;

  Surface := TBitmap.Create;
  try
    // 创建缓冲Bitmap
    Surface.Assign(FBgImage.Picture.Graphic);
    Surface.PixelFormat := pf32bit; // 只有这样才能分解RGB三原色

    // 把FBgImage中的像素读到BackgroundColorArray中
    SetLength(BackgroundColorArray, FBgImage.Height * FBgImage.Width);
    K := 0;
    for Y := 0 to FBgImage.Height - 1 do
      for X := 0 to FBgImage.Width - 1 do
      begin
        TheColor := FBgImage.Canvas.Pixels[X, Y];
        TheRGBQuad.rgbBlue  := GetRValue(TheColor);
        TheRGBQuad.rgbGreen := GetGValue(TheColor);
        TheRGBQuad.rgbBlue  := GetBValue(TheColor);
        BackgroundColorArray[K] := TheRGBQuad;
        Inc(K);
      end;

    // 初始化缓冲大小
    SetLength(Buffer1, FBgImage.Width * FBgImage.Height);
    SetLength(Buffer2, FBgImage.Width * FBgImage.Height);

    Buffer1[(FBgImage.Width + 1) * FBgImage.Height div 2] := -25000;

    // OK，循环计算水波效果
    while FEnabled do
    begin
      K := FBgImage.Width;
      for Y := 1 to FBgImage.Height - 2 do
      begin
        for X := 1 to FBgImage.Width - 2 do
        begin
          // 计算水波能量并加上阻尼
          Inc(K);
          Buffer2[K] := (Buffer1[K - 1] + Buffer1[k + 1] + Buffer1[K - FBgImage.Width] +
                        Buffer1[K + FBgImage.Width]) shr 1 - Buffer2[K];
          Buffer2[k] := Buffer2[K] - Buffer2[K] shr 5;

          // 计算反射效果
          OffsetX := (Buffer2[K - 1] - Buffer2[K + 1]) mod FBgImage.Width;
          if X + OffsetX < 0 then
            OffsetX := -(X shl 1 + OffsetX);
          if X + OffsetX + 1 > FBgImage.Width then
            OffsetX := (FBgImage.Width - X - 1) shl 1 - OffsetX;

          OffsetY := (Buffer2[K - FBgImage.Width] - Buffer2[K + FBgImage.Width]) mod FBgImage.Height;
          if Y + OffsetY < 0 then
            OffsetY := -(Y shl 1 + OffsetY);
          if Y + OffsetY + 1 > FBgImage.Height then
            OffsetY := (FBgImage.Height - Y - 1) shl 1 - OffsetY;

          TheRGBQuad := BackgroundColorArray[K + OffsetX + OffsetY * FBgImage.Width];
          PRgbArray(Surface.ScanLine[Y])[X] := TheRGBQuad;
        end;
        Inc(K, 2);
      end;

      FBgImage.Picture.Assign(Surface);

      { TODO -cTips : 快速交换缓冲区 }
      // Swap the buffers
      // Delphi BBS
      // ID: 554146
      // Q: 怎样用指针快速交换两个同类型数组的数据?
      // A: 这种问题不用指针，Pascal支持同类型的数组相互赋值，而且速度极快。形如以下方式：
      //    var a,b,Temp:Array[1..100] of DataType;
      //    ...
      //    Temp:=a; a:=b; b:=Temp;
      //    不过,a,b,temp一定要在同一句中声明,否则就不行.

      TempBuffer := Buffer1;
      Buffer1 := Buffer2;
      Buffer2 := TempBuffer;
    end
  finally
    Surface.Free;
  end;
end;

end.