?? ripplethread.pas
字號:
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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -