私はデルファイの学習者です。デルファイフォームエフェクトプロジェクトを1つダウンロードしました
http://www.gamedev.net/page/resources/_/technical/graphics-programming-and-theory/the-water-effect-explained-r915
「DXDraw01」、「DXDIB01」、「DXDIB02」、「Background」、およびいくつかの「BitBtn」があります。実際のプロジェクトは*ビットカラー操作でした。私はそれを32ビットカラーで実装しようとしました。私は次のコードを実装しました：
private
{ Private declarations }
public
{ Public declarations }
procedure FrameFadeIn(DIB01, DIB02: TDIB; Step: Byte);
procedure FrameFadeOut(DIB01, DIB02: TDIB; Step: Byte);
procedure FrameFill(DIB: TDIB; Color: Byte);
procedure WaterFrameUpdate;
procedure WaterFrameInitialize;
procedure WaterFramePrepare;
procedure WaterFrameRender(DIB: TDIB);
procedure WaterBubleDrop(X, Y, W, SplashStrength: Integer);
end;
PLongArray = ^TLongArray;
TLongArray = Array[0..32767] of LongInt;
TWaterFrame = Array[0..1,0..FrameWidth,0..FrameHeight] of Smallint;
var
MainForm: TMainForm;
CT, NW: Byte;
Closing: Boolean;
WaterFrame: TWaterFrame;
TSin, TCos: Array[0..511] of Single;
UltimateDisplacement: Array[0..511] of Byte;
implementation
{$R *.DFM}
procedure TMainForm.FrameFill(DIB: TDIB; Color: Byte);
var
P: PByteArray;
W, H: Integer;
begin
P := DIB.ScanLine[DIB.Height-1];
W := DIB.WidthBytes;
H := DIB.Height;
asm
PUSH ESI
MOV ESI, P
MOV EDX, W
MOV EAX, H
IMUL EDX
MOV ECX, EAX
MOV AL, Color
@@1:
MOV [ESI], AL
INC ESI
DEC ECX
JNZ @@1
POP ESI
end;
end;
procedure TMainForm.FrameFadeIn(DIB01, DIB02: TDIB; Step: Byte);
var
W, H: Integer;
P1, P2: PByteArray;
begin
P1 := DIB01.ScanLine[DIB02.Height-1];
P2 := DIB02.ScanLine[DIB02.Height-1];
W := DIB01.WidthBytes;
H := DIB01.Height;
asm
PUSH ESI
PUSH EDI
MOV ESI, P1
MOV EDI, P2
MOV EDX, W
MOV EAX, H
IMUL EDX
MOV ECX, EAX
@@1:
MOV AL, Step
MOV AH, [ESI]
CMP AL, AH
JB @@2
MOV AL, AH
@@2:
MOV [EDI], AL
INC ESI
INC EDI
DEC ECX
JNZ @@1
POP EDI
POP ESI
end;
end;
procedure TMainForm.FrameFadeOut(DIB01, DIB02: TDIB; Step: Byte);
var
W, H: Integer;
P1, P2: PByteArray;
begin
P1 := DIB01.ScanLine[DIB02.Height-1];
P2 := DIB02.ScanLine[DIB02.Height-1];
W := DIB01.WidthBytes;
H := DIB01.Height;
asm
PUSH ESI
PUSH EDI
MOV ESI, P1
MOV EDI, P2
MOV EDX, W
MOV EAX, H
IMUL EDX
MOV ECX, EAX
@@1:
MOV AL, Step
MOV AH, [ESI]
CMP AL, AH
JA @@2
MOV AL, AH
@@2:
MOV [EDI], AL
INC ESI
INC EDI
DEC ECX
JNZ @@1
POP EDI
POP ESI
end;
end;
procedure TMainForm.BitBtn01Click(Sender: TObject);
var
Opacity: Integer;
SystemTime01, SystemTime02: TSystemTime;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
GetLocalTime(SystemTime01);
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
Opacity := 0;
while Opacity < 255 do
begin
FrameFill(DXDIB01.DIB, Byte(Opacity));
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Opacity := Opacity + 5;
Application.ProcessMessages;
if Closing then Exit;
end;
GetLocalTime(SystemTime02);
end;
procedure TMainForm.BitBtn02Click(Sender: TObject);
var
Opacity: Integer;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
FrameFill(DXDIB01.DIB, 0);
for Opacity := 0 to 255 do
begin
FrameFadeIn(BackGround.DIB, DXDIB01.DIB, Opacity);
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
if Closing then Exit;
end;
end;
procedure TMainForm.BitBtn03Click(Sender: TObject);
var
Opacity: Integer;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
FrameFill(DXDIB01.DIB, 255);
for Opacity := 255 downto 0 do
begin
FrameFadeOut(BackGround.DIB, DXDIB01.DIB, Opacity);
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
if Closing then Exit;
end;
end;
procedure TMainForm.BitBtn04Click(Sender: TObject);
const
NumberOfRotation = 10;
var
CosY,SinY: real;
P1,P2: PByteArray;
X1, Y1, X2, Y2, FrameHorizontalCenter, FrameVerticalCenter, RotationSpeed, RotationAngle: Integer;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
FrameHorizontalCenter := Background.DIB.Width div 2;
FrameVerticalCenter := Background.DIB.Height div 2;
for RotationSpeed := 0 to 64 do
begin
RotationAngle := 384 + (RotationSpeed*NumberOfRotation);
for Y1 := 0 to BackGround.DIB.Height -1 do
begin
P1 := DXDIB01.DIB.ScanLine[Y1];
CosY := (Y1 - FrameVerticalCenter) * TCos[RotationAngle and $1ff];
SinY := (Y1 - FrameVerticalCenter) * TSin[RotationAngle and $1ff];
for X1 := 0 to Background.DIB.Width-1 do
begin
X2 := Trunc((X1 - FrameHorizontalCenter) * TSin[RotationAngle and $1ff] + CosY) + FrameHorizontalCenter;
Y2 := Trunc((X1 - FrameHorizontalCenter) * TCos[RotationAngle and $1ff] - SinY) + FrameVerticalCenter;
{ Required Logic if Background.DIB.BitCount=32 }
if (Y2 >= 0) and (Y2 < Background.DIB.Height) and (X2 >= 0) and (X2 < Background.DIB.Width) then
begin
PLongArray(P2) := Background.DIB.ScanLine[Y2];
PLongArray(P1)[X1] := PLongArray(P2)[FrameWidth - x2];
end
else
begin
if PLongArray(P1)[X1] > 4 then PLongArray(P1)[X1] := PLongArray(P1)[X1] - 4 else PLongArray(P1)[X1] := 0;
end;
{ Required Logic if Background.DIB.BitCount=32 }
end
end;
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
if Closing then Exit;
end;
BitBtn11Click(Sender);
end;
procedure TMainForm.BitBtn05Click(Sender: TObject);
var
P1,P2: PByteArray;
ActualDistance, Distance, CosY, SinY: real;
X1, Y1, X2, Y2, HorizontalCenter, VerticalCenter, A, B, Angle, DistortionFactor: Integer;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
HorizontalCenter := Background.DIB.Width div 2;
VerticalCenter := Background.DIB.Height div 2;
Distance := sqrt(sqr(HorizontalCenter) + sqr(VerticalCenter));
for A := 0 to 16 do
begin
B := A*8;
for Y1 := 0 to DXDIB01.DIB.Height - 1 do
begin
P1 := DXDIB01.DIB.ScanLine[Y1];
DistortionFactor := sqr(Y1-VerticalCenter);
for X1 := 0 to (DXDIB01.DIB.Width) - 1 do
begin
ActualDistance := (sqrt((sqr(X1 - HorizontalCenter) + DistortionFactor))/Distance);
ActualDistance := TSin[ (Trunc(ActualDistance*1024)) and $1ff ];
Angle := 384 + Trunc( (ActualDistance)* B );
CosY := (Y1 - VerticalCenter) * TCos[Angle and $1ff];
SinY := (Y1 - VerticalCenter) * TSin[Angle and $1ff];
X2 := Trunc((X1 - HorizontalCenter) * TSin[Angle and $1ff] + CosY) + HorizontalCenter;
Y2 := Trunc((X1 - HorizontalCenter) * TCos[Angle and $1ff] - SinY) + VerticalCenter;
{ Required Logic if Background.DIB.BitCount=32 }
if (Y2 >= 0) and (Y2 < Background.DIB.Height) and (X2 >= 0) and (X2 < Background.DIB.Width) then
begin
PLongArray(P2) := Background.DIB.ScanLine[Y2];
PLongArray(P1)[X1] := PLongArray(P2)[FrameWidth - X2];
end
else
begin
if P1[X1] > 2 then PLongArray(P1)[X1] := PLongArray(P1)[X1] - 2 else PLongArray(P1)[X1] := 0;
end;
{ Required Logic if Background.DIB.BitCount=32 }
end;
end;
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
if Closing then Exit;
end;
for A := 16 downto 0 do
begin
B := A*8;
for Y1 := 0 to DXDIB01.DIB.Height - 1 do
begin
P1 := DXDIB01.DIB.ScanLine[Y1];
DistortionFactor := sqr(Y1 - VerticalCenter);
for X1 := 0 to (DXDIB01.DIB.Width) - 1 do
begin
ActualDistance := (sqrt((sqr(X1 - HorizontalCenter) + DistortionFactor))/Distance);
ActualDistance := TSin[ (Trunc(ActualDistance*1024)) and $1ff ];
Angle := 384 + Trunc( (ActualDistance)* B );
CosY := (Y1 - VerticalCenter) * TCos[Angle and $1ff];
SinY := (Y1 - VerticalCenter) * TSin[Angle and $1ff];
X2 := Trunc((X1 - HorizontalCenter) * TSin[Angle and $1ff] + CosY) + HorizontalCenter;
Y2 := Trunc((X1 - HorizontalCenter) * TCos[Angle and $1ff] - SinY) + VerticalCenter;
{ Required Logic if Background.DIB.BitCount=32 }
if (Y2 >= 0) and (Y2 < Background.DIB.Height) and (X2 >= 0) and (X2 < Background.DIB.Width) then
begin
PLongArray(P2) := Background.DIB.ScanLine[Y2];
PLongArray(P1)[X1] := PLongArray(P2)[FrameWidth - X2];
end
else
begin
if P1[X1] > 2 then PLongArray(P1)[X1] := PLongArray(P1)[X1] - 2 else PLongArray(P1)[X1] := 0;
end;
{ Required Logic if Background.DIB.BitCount=32 }
end;
end;
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
if Closing then Exit;
end;
BitBtn11Click(Sender);
end;
procedure TMainForm.BitBtn06Click(Sender: TObject);
var
P1, P2: PByteArray;
ActualDistance, Distance,CosY, SinY: real;
X1, Y1, X2, Y2, HorizontalCenter, VerticalCenter, A, B, Angle, DistortionFactor: Integer;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
HorizontalCenter := Background.DIB.Width div 2;
VerticalCenter := Background.DIB.Height div 2;
Distance := sqrt(sqr(HorizontalCenter) + sqr(VerticalCenter)) * 0.75;
for A := 0 to 63 do
begin
B := A*8;
for Y1 := 0 to DXDIB01.DIB.Height - 1 do
begin
P1 := DXDIB01.DIB.ScanLine[Y1];
DistortionFactor := sqr(Y1 - VerticalCenter);
for X1 := 0 to (DXDIB01.DIB.Width) - 1 do
begin
ActualDistance := 1 - (sqrt((sqr(X1 - HorizontalCenter) + DistortionFactor))/Distance);
Angle := 384 + Trunc( (ActualDistance)* B );
CosY := (Y1 - VerticalCenter) * TCos[Angle and $1ff];
SinY := (Y1 - VerticalCenter) * TSin[Angle and $1ff];
X2 := Trunc((X1 - HorizontalCenter) * TSin[Angle and $1ff] + CosY) + HorizontalCenter;
Y2 := Trunc((X1 - HorizontalCenter) * TCos[Angle and $1ff] - SinY) + VerticalCenter;
{ Required Logic if Background.DIB.BitCount=32 }
if (Y2 >= 0) and (Y2 < Background.DIB.Height) and (X2 >= 0) and (X2 < Background.DIB.Width) then
begin
PLongArray(P2) := Background.DIB.ScanLine[Y2];
PLongArray(P1)[X1] := PLongArray(P2)[FrameWidth - X2];
end
else
begin
if P1[X1] > 2 then PLongArray(P1)[X1] := PLongArray(P1)[X1] - 2 else PLongArray(P1)[X1] := 0;
end;
{ Required Logic if Background.DIB.BitCount=32 }
end;
end;
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
if Closing then Exit;
end;
for A := 64 downto 0 do
begin
B := A*8;
for Y1 := 0 to DXDIB01.DIB.Height - 1 do
begin
P1 := DXDIB01.DIB.ScanLine[Y1];
DistortionFactor := sqr(Y1 - VerticalCenter);
for X1 := 0 to (DXDIB01.DIB.Width)-1 do
begin
ActualDistance := 1-(sqrt((sqr(X1 - HorizontalCenter) + DistortionFactor))/Distance);
Angle := 384 + Trunc( (ActualDistance)* B );
CosY := (Y1 - VerticalCenter) * TCos[Angle and $1ff];
SinY := (Y1 - VerticalCenter) * TSin[Angle and $1ff];
X2 := Trunc((X1 - HorizontalCenter) * TSin[Angle and $1ff] + CosY) + HorizontalCenter;
Y2 := Trunc((X1 - HorizontalCenter) * TCos[Angle and $1ff] - SinY) + VerticalCenter;
{ Required Logic if Background.DIB.BitCount=32 }
if (Y2 >= 0) and (Y2 < Background.DIB.Height) and (X2 >= 0) and (X2 < Background.DIB.Width) then
begin
PLongArray(P2) := Background.DIB.ScanLine[Y2];
PLongArray(P1)[X1] := PLongArray(P2)[FrameWidth - X2];
end
else
begin
if P1[X1] > 2 then PLongArray(P1)[X1] := PLongArray(P1)[X1] - 2 else PLongArray(P1)[X1] := 0;
end;
{ Required Logic if Background.DIB.BitCount=32 }
end;
end;
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
if Closing then Exit;
end;
BitBtn11Click(Sender);
end;
procedure TMainForm.BitBtn07Click(Sender: TObject);
const
AmountOfSpray = 500;
var
X, Y, C: Integer;
AllBlack: Boolean;
P1, P2, P3: PByteArray;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
DXDIB01.DIB.SetSize(Background.DIB.Width,Background.DIB.Height,Background.DIB.BitCount);
for C:=0 to AmountOfSpray do begin
DXDIB01.DIB.Pixels[ random(Background.DIB.Width-1), random(Background.DIB.Height-1)] :=0;
end;
repeat
AllBlack := True;
for Y:=0 to DXDIB01.DIB.Height -1 do
begin
P2 := DXDIB01.DIB.ScanLine[Y];
for X:=0 to DXDIB01.DIB.Width-1 do
begin
{ Required Logic if Background.DIB.BitCount=32 }
if PLongArray(P2)[X] < 16 then
begin
if PLongArray(P2)[X] > 0 then AllBlack := false;
if Y > 0 then
begin
PLongArray(P1) := DXDIB01.DIB.ScanLine[Y - 1];
if PLongArray(P1)[X] > 4 then PLongArray(P1)[X] := PLongArray(P1)[X] - 4 else PLongArray(P1)[X] := 0;
if X > 0 then if PLongArray(P1)[X - 1] > 2 then PLongArray(P1)[X - 1] := PLongArray(P1)[X - 1] - 2 else PLongArray(P1)[X - 1] := 0;
if X < (DXDIB01.DIB.Width - 1) then if PLongArray(P1)[X + 1] > 2 then PLongArray(P1)[X + 1] := PLongArray(P1)[X + 1] - 2 else PLongArray(P1)[X + 1] := 0;
end;
if Y < (DXDIB01.DIB.Height - 1) then
begin
PLongArray(P3) := DXDIB01.DIB.ScanLine[Y + 1];
if PLongArray(P3)[X] > 4 then PLongArray(P3)[X] := PLongArray(P3)[X] - 4 else PLongArray(P3)[X] := 0;
if X > 0 then if PLongArray(P3)[X - 1] > 2 then PLongArray(P3)[X - 1] := PLongArray(P3)[X - 1] - 2 else PLongArray(P3)[X - 1] := 0;
if X < (DXDIB01.DIB.Width - 1) then if PLongArray(P3)[X + 1] > 2 then PLongArray(P3)[X + 1] := PLongArray(P3)[X + 1] - 2 else PLongArray(P3)[X + 1] := 0;
end;
if PLongArray(P2)[X] > 8 then PLongArray(P2)[X] := PLongArray(P2)[X] - 8 else PLongArray(P2)[X] := 0;
if X > 0 then if PLongArray(P2)[X - 1] > 4 then PLongArray(P2)[X - 1] := PLongArray(P2)[X - 1] - 4 else PLongArray(P2)[X - 1] := 0;
if X < (DXDIB01.DIB.Width - 1) then if PLongArray(P2)[X + 1] > 4 then PLongArray(P2)[X + 1] := PLongArray(P2)[X + 1] - 4 else PLongArray(P2)[X + 1] := 0;
end;
{ Required Logic if Background.DIB.BitCount=32 }
end;
end;
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
until (AllBlack or Closing);
end;
procedure TMainForm.BitBtn08Click(Sender: TObject);
var
Tmp: Byte;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
CT := 0;
NW := 1;
repeat
WaterFrameUpdate;
WaterFrameRender(DXDIB01.DIB);
Tmp := CT;
CT := NW;
NW := Tmp;
if DXDraw01.CanDraw then begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
until (Closing);
end;
procedure TMainForm.BitBtn09Click(Sender: TObject);
var
Tmp: Byte;
x,y: Smallint;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
CT := 0;
NW := 1;
repeat
x := 40 + random(FrameWidth - 40);
y := 40 + random(FrameHeight - 40);
WaterBubleDrop(X, Y, 10, 25);
WaterFrameUpdate;
WaterFrameRender(DXDIB01.DIB);
Tmp := CT;
CT := NW;
NW := Tmp;
if DXDraw01.CanDraw then begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
until (Closing);
end;
procedure TMainForm.BitBtn10Click(Sender: TObject);
var
Tmp: Byte;
CosY, SinY: real;
X1, Y1, X2, Y2, HorizontalIncrement, VerticalIncrement, HorizontalCenter, VerticalCenter, Angle: Smallint;
const
HorizontalStartingPoint = 80;
VerticalStartingPoint = 80;
begin
Closing := True;
Application.ProcessMessages;
Closing := False;
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
HorizontalCenter := Background.DIB.Width div 2;
VerticalCenter := Background.DIB.Height div 2;
CT := 0;
NW := 1;
Angle := 0;
X2 := 4; HorizontalIncrement := 4;
Y2 := 4; VerticalIncrement := 3;
WaterBubleDrop(HorizontalCenter,VerticalCenter,40,-100);
repeat
CosY := (VerticalStartingPoint - VerticalCenter) * TCos[Angle and $1ff];
SinY := (VerticalStartingPoint - VerticalCenter) * TSin[Angle and $1ff];
X1 := Trunc((HorizontalStartingPoint - HorizontalCenter) * TSin[Angle and $1ff] + CosY) + HorizontalCenter;
Y1 := Trunc((HorizontalStartingPoint - HorizontalCenter) * TCos[Angle and $1ff] - SinY) + VerticalCenter;
Angle := Angle + 8;
WaterBubleDrop(X1, Y1, 4, -500);
WaterBubleDrop(X2, Y2, 4, -500);
X2 := X2 + HorizontalIncrement;
Y2 := Y2 + VerticalIncrement;
if (X2 < 4) or (X2 > FrameWidth - 4) then HorizontalIncrement := -HorizontalIncrement;
if (Y2 < 4) or (Y2 > FrameHeight - 4) then VerticalIncrement := -VerticalIncrement;
WaterFrameUpdate;
WaterFrameRender(DXDIB01.DIB);
Tmp := CT;
CT := NW;
NW := Tmp;
if DXDraw01.CanDraw then begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
Application.ProcessMessages;
until (Closing);
end;
procedure TMainForm.BitBtn11Click(Sender: TObject);
begin
DXDIB01.DIB.SetSize(Background.DIB.Width, Background.DIB.Height, Background.DIB.BitCount);
DXDIB01.DIB.Assign(Background.DIB);
if DXDraw01.CanDraw then begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
DXDraw01.Flip;
end;
end;
procedure TMainForm.BitBtn12Click(Sender: TObject);
begin
MainForm.Close;
end;
procedure TMainForm.WaterFrameUpdate;
const
DampingCoefficient = 4;
var
X, Y, N: Smallint;
begin
for Y := 2 to FrameHeight-2 do begin
for X := 2 to FrameWidth-2 do begin
N := ( WaterFrame[CT, X-1, Y] + WaterFrame[CT, X-2, Y] + WaterFrame[CT, X+1, Y] + WaterFrame[CT, X+2, Y] +
WaterFrame[CT, X, Y-1] + WaterFrame[CT, X, Y-2] + WaterFrame[CT, X, Y+1] + WaterFrame[CT, X, Y+2] +
WaterFrame[CT, X-1, Y-1] + WaterFrame[CT, X+1, Y-1] + WaterFrame[CT, X-1, Y+1] + WaterFrame[CT, X+1, Y+1] )
div 6 - WaterFrame[NW, X, Y];
asm
PUSH BX
MOV BX, N
SAR BX, DampingCoefficient
SUB N, BX
POP BX
end;
WaterFrame[NW, X, Y] := N;
end;
end;
end;
procedure TMainForm.WaterFrameInitialize;
var
X, Y: SmallInt;
begin
for Y := 0 to FrameHeight do begin
for X := 0 to FrameWidth do begin
WaterFrame[CT, X, Y] := 0;
WaterFrame[NW, X, Y] := 0;
end;
end;
end;
procedure TMainForm.WaterFramePrepare;
const
RefractiveIndex = 4.0;
var
C, D: SmallInt;
begin
for C := -256 to 255 do begin
D := C div 4;
UltimateDisplacement[C + 256] := Byte(Trunc(Tan(ArcSin((Sin(ArcTan(D)) / RefractiveIndex))) * D));
end;
for C := 0 to 511 do begin
TSin[C] := Sin( ((C * 360) / 511) * Pi / 180 );
TCos[C] := Cos( ((C * 360) / 511) * Pi / 180 );
end;
WaterFrameInitialize;
end;
procedure TMainForm.WaterFrameRender(DIB: TDIB);
var
X, Y, NewColor, HorizontalDifference, VerticalDifference, HorizontalDisplacement, VerticalDisplacement: Smallint;
begin
for Y := 0 to FrameHeight do begin
for X := 0 to FrameWidth do begin
HorizontalDifference := WaterFrame[NW, X+1, Y] - WaterFrame[NW, X, Y];
VerticalDifference := WaterFrame[NW, X, Y+1] - WaterFrame[NW, X, Y];
HorizontalDisplacement := UltimateDisplacement[HorizontalDifference + 256];
VerticalDisplacement := UltimateDisplacement[VerticalDifference + 256];
if HorizontalDifference < 0 then begin
if (VerticalDifference<0) then
NewColor := Background.DIB.Pixels[X-HorizontalDisplacement,Y-VerticalDisplacement]
else
NewColor := Background.DIB.Pixels[X-HorizontalDisplacement,Y+VerticalDisplacement]
end else begin
if (VerticalDifference<0) then
NewColor := Background.DIB.Pixels[X+HorizontalDisplacement,Y-VerticalDisplacement]
else
NewColor := Background.DIB.Pixels[X+HorizontalDisplacement,Y+VerticalDisplacement]
end;
DIB.Pixels[X, Y] := NewColor;
end;
end;
end;
procedure TMainForm.WaterBubleDrop(X,Y,W,SplashStrength: Integer);
var
U, V: Integer;
HorizontalDistanceSquare, VerticalDistanceSquare, BubbleWidthSquare: Integer;
begin
BubbleWidthSquare := sqr(W);
if (X > W) and (X < FrameWidth - W) and (Y > W) and (Y < FrameHeight - W) then begin
for V := Y - W to Y + W do begin
VerticalDistanceSquare := sqr(V - Y);
for U := X - W to X + W do begin
HorizontalDistanceSquare := sqr(U - X);
if (HorizontalDistanceSquare + VerticalDistanceSquare) <= BubbleWidthSquare then begin
WaterFrame[CT, U, V] := SplashStrength*Trunc(W - sqrt(HorizontalDistanceSquare + VerticalDistanceSquare));
end;
end;
end;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
WaterFramePrepare;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DXTimer01.Enabled := true;
Closing := True;
end;
procedure TMainForm.DXDraw01Finalize(Sender: TObject);
begin
DXTimer01.Enabled := false;
end;
procedure TMainForm.DXDraw01Initialize(Sender: TObject);
begin
DXTimer01.Enabled := true;
end;
procedure TMainForm.DXDraw01MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
WaterBubleDrop(X, Y, 15, -4);
end;
procedure TMainForm.DXDraw01MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if (X > 0) and (X < FrameWidth) and (Y > 0) and (Y < FrameHeight) then begin
WaterBubleDrop(X, Y, 8, -64);
end;
end;
procedure TMainForm.DXTimer01Timer(Sender: TObject; LagCount: Integer);
begin
if not DXDraw01.CanDraw then exit;
DXDraw01.Surface.Fill(0);
DXDIB01.DIB.SetSize(Background.DIB.Width,Background.DIB.Height,Background.DIB.BitCount);
DXDIB01.DIB.Assign(Background.DIB);
if DXDraw01.CanDraw then
begin
DXDraw01.Surface.Assign(DXDIB01.DIB);
with DXDraw01.Surface.Canvas do
begin
Brush.Style := bsClear;
Font.Color := $efefef;
Font.Size := 30;
Textout((Background.DIB.Width - TextWidth('M/DD/YY HH:MM:SS AM')) div 2, (Background.DIB.Height - 30) div 2, DateTimeToStr(Now));
Release;
end;
end;
DXDraw01.Flip;
end;
end.
私の問題は、水と雨の効果を除くすべての効果が正しく機能していることです。私のプロジェクトでは、Background.DIBは32ビット画像です。Plaeseは私を助けてくれます。私の知る限り、問題は次の手順の定義にあります。
procedure WaterFrameUpdate;
procedure WaterFrameInitialize;
procedure WaterFramePrepare;
procedure WaterFrameRender(DIB: TDIB);
procedure WaterBubleDrop(X, Y, W, SplashStrength: Integer);
1つまたは複数のプロシージャ定義で8ビットカラー操作が行われていると思います。どちらが8ビットカラー動作なのかわかりません。LongArrayも実装しようとしましたが、エラーが発生します。それから私は試しました
asm
PUSH BX
MOV BX, N
SAR BX, DampingCoefficient
SUB N, BX
POP BX
end;
なので
asm
PUSH ESI
MOV ESI, N
SAR ESI, DampingCoefficient
SUB N, ESI
POP ESI
end;
また
asm
PUSH EDI
MOV EDI, N
SAR EDI, DampingCoefficient
SUB N, EDI
POP EDI
end;
ただし、「オペランドサイズの不一致」というエラーが表示されます。Plaese、助けてください。