unit rei11;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
//定义记录 类型，角色管理用
TPatDt = record
Used:Byte; //角色所使用的标记
Sban:Byte; // 复合图案的编号
Xpos:Integer; // X 坐标
Ypos:Integer; // Y 坐标
Smov:Byte; //移动方向，0右，1 左，2下，3上
Scon:Byte; // 移动计数器
end;
TRein11 = class(TForm)
tmr1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure tmr1Timer(Sender: TObject);
private
{ Private declarations }
procedure LoReg(Sban:Byte; X1,Y1 :Integer);
procedure MiReg(Sban:Byte; X1,Y1 :Integer);
procedure HiReg (Sban:Byte; X1,Y1 :Integer);
procedure DpSprite;
procedure ClSprite;
procedure ChrDi(Xsiz,Ysiz :Byte; Dpon:Word;X1,Y1 :Integer;Bmap:TBitmap);
procedure PatDi(Pnum:Byte;X1,Y1 :Integer; Bmap:TBitmap);
procedure ChrCl(Sban:Byte;X1,Y1 :Integer; Bmap:TBitmap);
public
{ Public declarations }
end;
const
Yoko = 37; //横向图案数
Tate = 27; //纵向图案数
DYoko = Yoko * 16; //横向点数
DTate = Tate * 16; //纵向点数
PtFull = 16; //全面显示的图案数
MaxSp = 6; //复合图案总数
MaxChr =120; //登场的移动角色总数 MAX 255
Mdots = 3; //角色移动的点数
var
Rein11 : TRein11;
// 载入，去除模板，背景，绘制用 点阵图
LoadBmap,XpatBmap,BackBmap,MakeBmap :TBitmap;
P,PX,PY,Sn,Rn :Byte;
Sc,Xdot,Ydot: Word;
RectL,RectB,RectM,RectD:TRect;
Y2 :Integer;
//角色数组 MAX 255
ChPon : array[0..255] of TPatDt;
// 登陆数组，在一开始时绘制，绘制顺的顺序为登陆顺序,最多处理255个，
DipLo : array[0..(3*255)] of Integer;
// 从角色的下端在画面上方的角色开始绘制
DipMi : array[0..(4*255)]of Integer;
// 在最后时绘制，绘制的顺序为登陆顺序
DipHi : array[0..(3*255)]of Integer;
//复合图案数组
// 复合图案的大小和数据 在设计程序时设置
//复合图案的大小（纵横）连续排列 ，MaxSp 复合图案总数 6
SpSiz :array[0..(MaxSp*2-1)] of Byte =(2,2, 2,2, 2,2, 2,3, 3,3, 31,1 );
//显示复合图案上的SpDat 的数据起始位置，
SpPon :array[0..(MaxSp-1)] of Word;
// 复合图案的各项数据,连续排列
SpDat :array[0..57] of Byte =(
24,25,26,27, // 对应SpSiz的2,2
28,29,30,31,
32,33,48,49,
64,65,80,81,96,97, // 对应SpSiz的2,3
0,19,0,19,0,19,0,19,0, //3,3
16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,16,
16,16,16,16,16,16,16,16,16,16,16,16,16,16,16); //31,1
implementation
{$R *.dfm}
procedure TRein11.FormCreate(Sender: TObject);
var
X,Y,Cn,n :Byte;
begin
Rein11.Height := 480;
Rein11.Width := 640;
LoadBmap := TBitmap.Create;
LoadBmap.LoadFromFile(GetCurrentDir + '/Pat_Sample.bmp');
XpatBmap := TBitmap.Create;
XpatBmap.Width := 256;
XpatBmap.Height := 256;
RectL := Rect(0,0,256,256);
XpatBmap.Canvas.CopyMode := cmSrcCopy;
XpatBmap.Canvas.CopyRect(RectL,LoadBmap.Canvas,RectL);
XpatBmap.Canvas.Brush.Color := clBlack;
XpatBmap.Canvas.BrushCopy(RectL,LoadBmap,RectL,clWhite);
XpatBmap.Canvas.CopyMode := cmMergePaint;
XpatBmap.Canvas.CopyRect(RectL,LoadBmap.Canvas,RectL);
Sc :=0; //计算复合图案的位置
for n := 0 to (MaxSp -1) do
begin
SpPon[n] := Sc;
Sc := Sc + SpSiz[n*2] * SpSiz[n*2+1] ;
end;
//绘制背景
BackBmap := TBitmap.Create;
BackBmap.Width := DYoko +32;
BackBmap.Height := DTate + 32;
for Y :=0 to (Tate -1) do
for X := 0 to (Yoko -1) do
begin
if (X = 0 ) or (Y =0 ) or (X = Yoko -1) or (Y = Tate-1) then
P :=22
else
P :=15;
PatDi(P,X*16+16,Y*16+16,BackBmap);
end;
MakeBmap :=TBitmap.Create;
MakeBmap.Width := BackBmap.Width;
MakeBmap.Height := BackBmap.Height;
MakeBmap.Canvas.Draw(0,0,BackBmap);
//角色数组初始设置
for Cn :=0 to (MaxChr -1) do
begin
ChPon[Cn].Used :=1;
ChPon[Cn].Sban := Cn and 1 +1; //1,2
ChPon[Cn].Xpos := Random(528)+ 32;
ChPon[Cn].Ypos := Cn *24 +20;
ChPon[Cn].Smov := Random(4);
ChPon[Cn].Scon := Random(20)+ 20;
end;
DipLo[0] := 0;
DipMi[0] :=0 ;
DipHi[0] :=0;
end;
procedure TRein11.LoReg(Sban:Byte; X1,Y1 :Integer);
begin
Sn := DipLo[0]; //零件贴图显示登陆 [0] 用来存放登陆计数
if Sn <> 255 then
begin
DipLo[Sn *3 + 1] := Sban ; //零件贴图编号，
DipLo[Sn *3 + 2] := X1 ; // X坐标
DipLo[Sn *3 + 3] := Y1 ; // Y 坐标
DipLo[0] := Sn + 1 ; //登陆计数+1
end;
end;
procedure TRein11.MiReg(Sban:Byte; X1,Y1 :Integer);
var
n : Byte;
begin
Sn := DipMi[0];
if Sn <> 255 then
begin
Rn := 0;
Y2 := Y1 + SpSiz[Sban * 2 + 1] * 16;
// SpSiz[Sban * 2 + 1] 其图案纵向个数
//下端Y坐标 进行比较，确定登陆排列位置
while(Rn < Sn ) and (Y2 >= DipMi[Rn *4 + 4]) do
Rn := Rn + 1;
// 位置向后移动，空出位置 SN为最尾
if Rn < Sn then
//
for n := Sn downto (Rn + 1) do
begin
DipMi[n * 4 + 4] := DipMi[(n-1) * 4 + 4]; //n,n-1 = Rn + 1 ,Rn
DipMi[n * 4 + 3] := DipMi[(n-1) * 4 + 3]; //
DipMi[n * 4 + 2] := DipMi[(n-1) * 4 + 2];
DipMi[n * 4 + 1] := DipMi[(n-1) * 4 + 1];
end;
DipMi[0] := Sn + 1;
DipMi[Rn * 4 + 1] := Sban;
DipMi[Rn * 4 + 2] := X1;
DipMi[Rn * 4 + 3] := Y1;
DipMi[Rn * 4 + 4] := Y2;
end;
end;
procedure TRein11.HiReg
(Sban:Byte; X1,Y1 :Integer);
begin
Sn := DipHi[0];
if Sn <> 255 then
begin
DipHi[Sn*3+1]:= Sban;
DipHi[Sn*3+2]:=X1;
DipHi[Sn*3+3]:=Y1;
DipHi[0]:= Sn + 1;
end;
end;
procedure TRein11.DpSprite;
var
n,Dpn : Byte;
begin
for Dpn := 1 to DipLo[0] do
begin
n := DipLo[Dpn * 3 -2]; //n 0..MaxSp-1 复合图案编号
ChrDi(SpSiz[n * 2],SpSiz[n * 2 + 1],SpPon[n],
DipLo[Dpn * 3 -1] + 16, DipLo[Dpn *3]+16,MakeBmap);
end;
for Dpn :=1 to DipMi[0] do
begin
n := DipMi[Dpn *4 -3];
ChrDi(SpSiz[n * 2],SpSiz[n *2 + 1],SpPon[n],
DipMi[Dpn * 4 -2]+ 16,DipMi[Dpn * 4 -1] + 16,MakeBmap);
end;
for Dpn := 1 to DipHi[0] do
begin
n := DipHi[Dpn * 3 - 2];
ChrDi(SpSiz[n * 2],SpSiz[n * 2 + 1],SpPon[n],
DipHi[Dpn * 3 -1] + 16,DipHi[Dpn * 3] + 16,MakeBmap);
end;
end;
procedure TRein11.ClSprite;
var
Dpn : Byte;
begin
for Dpn := 1 to DipLo[0] do
ChrCl(DipLo[Dpn * 3 - 2],DipLo[Dpn * 3 - 1] + 16,
DipLo[Dpn * 3] + 16,MakeBmap);
for Dpn := 1 to DipMi[0] do
ChrCl(DipMi[Dpn * 4 - 3],DipMi[Dpn * 4 - 2] + 16,
DipMi[Dpn *4 - 1] + 16,MakeBmap);
for Dpn := 1 to DipHi[0] do
ChrCl(DipHi[Dpn * 3 - 1],DipHi[Dpn * 3 -1] + 16,
DipHi[Dpn * 3] + 16,MakeBmap);
DipLo[0] := 0;
DipMi[0] := 0;
DipHi[0] := 0;
end;
procedure TRein11.ChrDi(Xsiz,Ysiz :Byte; Dpon:Word;X1,Y1 :Integer;Bmap:TBitmap);
var
CDX,CDY :Byte;
begin
for CDY := 0 to (Ysiz -1 ) do
for CDX :=0 to (Xsiz -1 ) do
begin
if (X1 + CDX * 16 >= 0) and (X1 + CDX *16 <= DYoko +16) and
(Y1 + CDY * 16 >= 0 ) and (Y1 + CDY *16 <= DTate + 16) then
PatDi(SpDat[Dpon],X1 + CDX *16,Y1 + CDY *16,Bmap);
Dpon := Dpon + 1;
end;
end;
procedure TRein11.PatDi(Pnum:Byte;X1,Y1 :Integer; Bmap:TBitmap);
begin
PX := (Pnum and $F)*16;
PY := (Pnum and $F0);
RectL :=Rect(PX,PY,PX +16,PY + 16);
RectD :=Rect(X1,Y1,X1 + 16,Y1 +16);
if Pnum <> 0 then
if Pnum >= PtFull then
begin
Bmap.Canvas.CopyMode := cmSrcPaint;
Bmap.Canvas.CopyRect(RectD,XpatBmap.Canvas,RectL);
Bmap.Canvas.CopyMode := cmSrcAnd;
Bmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,RectL);
end
else begin
Bmap.Canvas.CopyMode := cmSrcCopy;
Bmap.Canvas.CopyRect(RectD,LoadBmap.Canvas,rectl);
end;
end;
procedure TRein11.ChrCl(Sban:Byte;X1,Y1 :Integer; Bmap:TBitmap);
begin
Xdot := SpSiz[Sban *2] *16 +16;
Ydot := SpSiz[Sban *2 +1 ]*16 +16;
if X1 <0 then
begin
Xdot := Xdot + X1;
X1 := 0;
end;
if Y1 <0 then
begin
Ydot := Ydot + Y1;
Y1 :=0;
end;
if (X1 < DYoko + 32) and ( Y1 < DTate + 32) then
begin
if (X1 + Xdot) >= (DYoko +32) then
Xdot := DYoko +32 - X1;
if (Y1 + Ydot)>= (Dtate +32) then
Ydot := DTate + 32 - Y1;
Bmap.Canvas.CopyMode := cmSrcCopy;
RectB := Rect(X1,Y1,X1 + Xdot,Y1 + Ydot) ;
Bmap.Canvas.CopyRect(RectB,BackBmap.Canvas,RectB );
end;
end;
procedure TRein11.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LoadBmap.Free;
XpatBmap.Free;
BackBmap.Free;
MakeBmap.Free;
end;
procedure TRein11.tmr1Timer(Sender: TObject);
var
Cn : Byte;
begin
for Cn := 0 to (MaxChr - 1) do
if ChPon[Cn].Used = 1 then
begin
ChPon[Cn].Scon := ChPon[Cn].Scon - 1; //移动计数器-1
if ChPon[Cn].Scon = 0 then
begin
ChPon[Cn].Scon := Random(20) + 20; //重置移动计数器
ChPon[Cn].Smov := Random(4); //重置方向
end;
case ChPon[Cn].Smov of //方向移动
0: ChPon[Cn].Xpos := ChPon[Cn].Xpos + Mdots;
1: ChPon[Cn].Xpos := ChPon[Cn].Xpos - Mdots;
2: ChPon[Cn].Ypos := ChPon[Cn].Ypos + Mdots;
3: ChPon[cn].Ypos := ChPon[Cn].Ypos - Mdots;
end;
//边界 改变相反移动方向，
if ChPon[Cn].Xpos < 17 then
begin
ChPon[Cn].Xpos := ChPon[Cn].Xpos + Mdots;
ChPon[cn].Smov := 0;
end
else if ChPon[Cn].Xpos > DYoko - 49 then
begin
ChPon[Cn].Xpos := ChPon[Cn].Xpos - Mdots;
ChPon[Cn].Smov := 1;
end
else if ChPon[Cn].Ypos < 17 then
begin
ChPon[Cn].Ypos := ChPon[Cn].Ypos + Mdots;
ChPon[Cn].Smov := 2;
end
else if ChPon[Cn].Ypos > DTate - 49 then
begin
ChPon[Cn].Ypos := ChPon[Cn].Ypos - Mdots;
ChPon[Cn].Smov := 3;
end;
// 零件贴图登陆
MiReg(ChPon[Cn].Sban,ChPon[Cn].Xpos,ChPon[Cn].Ypos);
end;
//栅栏
MiReg(5, 3 * 16, 13 * 16);
// 树
MiReg(3, 80, 11 * 16 -6);
MiReg(3, 200, 11 * 16 + 12);
MiReg(3, 330, 11 * 16 - 8);
MiReg(3, 480, 11 * 16 + 16);
MiReg(3, 299, 11 * 3 + 16);
//黑洞
LoReg(0, 32, 32);
LoReg(0, 32, 23 * 16);
LoReg(0, 33 * 16, 32);
LoReg(0, 33 * 16, 23 * 16);
// 星星
HiReg(4, 17 * 16, 12 * 16);
DpSprite;
Rein11.Canvas.CopyMode := cmSrcCopy;
RectM := Rect(16, 16, DYoko + 16, DTate + 16);
RectD := Rect(0, 0, DYoko, DTate);
Rein11.Canvas.CopyRect(RectD, MakeBmap.Canvas, RectM);
ClSprite;
end;
end.
一个月前照着书本敲的代码，
忘的差不多了，基本一个星期不敲代码就忘了
得坚持持续的学习啊
原创文章，作者：6024010，如若转载，请注明出处：https://blog.ytso.com/273816.html