📄 gamelib.pas
字号:
unit GameLib;
interface
uses
Windows,SysUtils,Classes,Graphics,
DXDraws,DIB;
procedure FadeOut(DIB1,DIB2:TDIB;Step:Byte);
procedure Zoom(DIB1,DIB2:TDIB;ZoomRatio:Real);
procedure Blur(DIB1,DIB2:TDIB);
procedure FadeIn(DIB1,DIB2:TDIB;Step:Byte);
procedure FillDIB8(DIB:TDIB;Color:Byte);
procedure MaSaiKey(DX:TDXDraw;SBitMap:TBitmap);
const
MAXX = 276;
MAXY = 185;
DAMP = 4;
rIndex = 4.0;
var
tsin,tcos:array[0..511] of Single;
Closing:Boolean;
CT,NW:Byte;
dispLut:array[0..511] of Byte;
implementation
procedure FadeOut(DIB1,DIB2:TDIB;Step:Byte);
var
P1,P2:PByteArray;
W,H:Integer;
begin
P1:=DIB1.ScanLine[DIB2.Height - 1];
P2:=DIB2.ScanLine[DIB2.Height - 1];
W:=DIB1.WidthBytes;
H:=DIB1.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 Zoom(DIB1,DIB2:TDIB;ZoomRatio:Real);
var
P1,P2:PByteArray;
W,H:Integer;
X,Y:Integer;
xr,yr,xstep,ystep:Real;
xstart:Real;
begin
W:=DIB1.WidthBytes;
H:=DIB1.Height;
xstart:=(W - (W * ZoomRatio)) / 2;
xr:=xstart;
yr:=(H - (H * ZoomRatio)) / 2;
xstep:=ZoomRatio;
ystep:=ZoomRatio;
for Y:=1 to DIB1.Height - 1 do
begin
P2:=DIB2.ScanLine[Y];
if (yr >= 0) and (yr <= H) then
begin
P1:=DIB1.ScanLine[Trunc(yr)];
for X:=1 to DIB1.Width - 1 do
begin
if (xr >= 0) and (xr <= W) then
begin
P2[X]:=P1[Trunc(xr)];
end
else
begin
P2[X]:=0;
end;
xr:=xr + xstep;
end;
end
else
begin
for X:=1 to DIB1.Width - 1 do
begin
P2[X]:=0;
end;
end;
xr:=xstart;
yr:=yr + ystep;
end;
Sleep(250);
end;
procedure Blur(DIB1,DIB2:TDIB);
var
P1,P2:PByteArray;
W {,H}:Integer;
X,Y:Integer;
begin
W:=DIB1.WidthBytes;
// H := DIB1.Height;
for Y:=1 to DIB1.Height - 1 do
begin
P1:=DIB1.ScanLine[Y];
P2:=DIB2.ScanLine[Y];
for X:=1 to DIB1.Width - 1 do
begin
P2[X]:=(P1[X] + P1[X - 1] + P1[X + 1] + P1[X + W] + P1[X - W]) div 5;
end;
end;
end;
procedure FadeIn(DIB1,DIB2:TDIB;Step:Byte);
var
P1,P2:PByteArray;
W,H:Integer;
begin
P1:=DIB1.ScanLine[DIB2.Height - 1];
P2:=DIB2.ScanLine[DIB2.Height - 1];
W:=DIB1.WidthBytes;
H:=DIB1.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 FillDIB8(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 MaSaiKey(DX:TDXDraw;SBitMap:TBitmap);
var
c:TColor;
r,g,b:Byte;
sr,sg,sb:Integer;
i,j:Integer;
ix,iy:Integer;
Rsize,Pocet:Integer;
begin
//RSize=100
//Pocet=25
if Rsize <> 0 then
begin
for ix:=0 to (DX.SurfaceWidth div Rsize - 1) do
begin
for iy:=0 to (DX.SurfaceHeight div Rsize - 1) do
begin
sr:=0;sg:=0;sb:=0;
for j:=1 to Pocet do
begin
c:=SBitMap.Canvas.Pixels
[ix * (Rsize) + Random(Rsize),iy * Rsize + Random(Rsize)];
sr:=sr + GetRValue(c);
sg:=sg + GetGValue(c);
sb:=sb + GetBValue(c);
end;
r:=sr div Pocet;
g:=sg div Pocet;
b:=sb div Pocet;
DX.Surface.Canvas.Pen.Style:=psClear;
DX.Surface.Canvas.Brush.Color:=RGB(r,g,b);
DX.Surface.Canvas.Rectangle
(ix * Rsize,iy * Rsize,
(ix * Rsize + Rsize) + 1,(iy * Rsize + Rsize) + 1);
end;
end;
Rsize:=Rsize - 1;
if Rsize = 5 then Rsize:=0;
Pocet:=(Rsize div 2) + 1;
if Pocet = 1 then Pocet:=2;
end
else
begin
DX.Surface.Canvas.CopyRect
(rect(0,0,200,300),SBitMap.Canvas,
rect(0,0,200,300));
end;
DX.Flip;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -