unit rei10;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type // 定义精灵 记录类型
TpatDt = record
Used : Byte;
Sban : Byte;
Xpos : Integer;
Ypos : Integer;
Smov : Byte;
Sadd : Byte;
end;
TR10 = class(TForm)
tmr1: TTimer;
procedure FormCreate(Sender: TObject);
procedure tmr1Timer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure YScroll;
procedure ChrDi(Sban:Byte;X1,Y1:Integer;Bmap:TBitmap);
procedure SbanDi(Sary:array of Byte;X1,Y1:Integer;Bmap:TBitmap );
procedure PatDi(Pnum:Byte;X1,Y1:Integer;Bmap:TBitmap );
public
{ Public declarations }
end;
const
Yoko = 37;
Tate = 27;
DYoko = Yoko * 16;
Dtate = Tate *16;
PtFull = 16; //全面显示 图案数，
MaxMap = 370; //图案最大数
ScDot = 2; // 滚动点数
var
R10: TR10;
// 定义 载入用，去除模板用，背景用，绘制用 点阵图，
LoadBmap,XpatBmap,BackBmap,MakeBmap: TBitmap;
P,PX,PY,n :Byte;
RectL,RectB,RectM,RectD :TRect;
ChPon :array[0..9] of TpatDt;
Yplus :array[0..20] of Byte = (
0,10,19,27,34,40,45,49,52,54,55,
55,54,52,49,45,40,34,27,19,10);
Smap :array[0..(Yoko -1),0..(MaxMap -1)] of Byte;
// 图案点，滚动点，绘制点 的定义，初始 设置
Mpoint : Word = 0;
Spoint : Integer = 16;
Ypoint : Integer = 0;
//复合图案 数组
Spr00 : array[0..5] of Byte =(2,2,24,25,26,27);
Spr01 : array[0..5] of Byte = (2,2,28,29,30,31);
Spr02 : array[0..5] of Byte = (2,2,32,33,48,49);
implementation
{$R *.dfm}
procedure TR10.YScroll; //图像滚动
var
X : Byte;
begin
MakeBmap.Canvas.CopyMode := cmSrcCopy;
if Spoint <= 16 then
begin
RectB := Rect(0,Spoint,DYoko,Dtate + Spoint);
RectD := Rect(16,16,DYoko + 16,Dtate + 16);
MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB);
end
else begin
RectB := Rect(0,Spoint,DYoko,Dtate + 16);
RectD := Rect(16,16,Dyoko + 16,Dtate + 32- Spoint);
MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB);
RectB := Rect(0,0,DYoko,Spoint - 16);
RectD := Rect(16,Dtate + 32 - Spoint,DYoko + 16,Dtate + 16);
MakeBmap.Canvas.CopyRect(RectD,BackBmap.Canvas,RectB);
end;
//ScDot:=2,单次滚动点数 ，Spoint 累计 滚动点数
Spoint := Spoint - ScDot;
Ypoint := Ypoint - ScDot;
if Spoint < 0 then
Spoint := Dtate + 16 - ScDot;
if Ypoint < 0 then
Ypoint := Dtate + 16 - ScDot;
//累计滚动过16点，绘制一行
if (Spoint and 15 ) = 0 then
begin
for X := 0 to (Yoko -1 ) do
PatDi(Smap[X, Mpoint],X * 16,Ypoint,BackBmap );
Mpoint := Mpoint + 1;
// 最大 绘制 ，归零
if Mpoint = MaxMap then
Mpoint := 0 ;
end;
end;
procedure TR10.ChrDi(Sban:Byte;X1,Y1:Integer;Bmap:TBitmap);
begin
case Sban of
0: SbanDi(Spr00,X1 + 16,Y1+ 16,Bmap);
1: SbanDi(Spr01,X1 + 16,Y1 + 16,Bmap);
2: SbanDi(Spr02, X1 + 16,Y1 + 16,Bmap);
end;
end;
procedure TR10.SbanDi(Sary:array of Byte;X1,Y1:Integer;Bmap:TBitmap );
var
X :Byte;
Y :Word;
begin
n := 2;
for Y := 0 to ( Sary[1] -1) do
for X := 0 to ( Sary[0]-1) do
begin
if (X1 + X* 16 >= 0 )and ( X1 + X *16 <= DYoko + 16) and
( Y1 + Y *16 >= 0) and ( Y1 + Y* 16 <= Date + 16) then
PatDi(Sary[n],X1 + X * 16, Y1 + Y *16,Bmap);
n := n +1;
end;
end;
procedure TR10.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 TR10.FormCreate(Sender: TObject);
var
X,Cn :Byte;
Y :Word;
begin
R10.Height := 480;
R10.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 );
//设置背景图案
for Y := 0 to (MaxMap -1) do
for X := 0 to (Yoko -1 ) do
begin
if(X>(Y mod Yoko)) and ((X+ (Y mod Yoko)+1)< Yoko) then
P := 15
else if (X < ( Y mod Yoko ))and ((X + (Y mod Yoko )+1) > Yoko) then
P := 15
else if Y < Yoko then
P := 12
else if Y < Yoko *2 then
P := 13
else if Y < Yoko *3 then
P := 14
else if Y < Yoko * 4 then
P:= 2
else if Y < Yoko * 5 then
P:= 14
else if Y < Yoko *6 then
P := 13
else if Y < Yoko * 7 then
P:= 12
else if Y < Yoko * 8 then
P:= 13
else if Y < Yoko * 9 then
P:= 14
else
P := 15;
Smap[X,Y ] := P;
end;
BackBmap := TBitmap.Create;
BackBmap.Width:= DYoko;
BackBmap.Height:= Dtate + 16;
for Y := 0 to Tate do
begin
for X := 0 to ( Yoko -1 ) do
PatDi(Smap[X,Y ],X * 16,(Tate - Y )* 16,BackBmap);
Mpoint := Mpoint + 1;
end;
MakeBmap := TBitmap.Create;
MakeBmap.Width := DYoko + 32;
MakeBmap.Height := Dtate + 32;
//设置精灵
for Cn := 0 to 4 do
begin
ChPon[Cn *2 ].Used := 1;
ChPon[Cn * 2].Sban := 0 ;
ChPon[Cn * 2].Xpos := Cn *90 + 100;
ChPon[Cn *2 ].Ypos := (Cn and 1 )* 100 + 200;
ChPon[Cn *2 ].Smov := 0;
ChPon[Cn *2 ].Sadd := 0;
ChPon[Cn *2 + 1].Used := 1;
ChPon[Cn * 2+1 ].Sban := (Cn and 1 ) +1 ;
ChPon[Cn * 2+1 ].Xpos := Cn *90 + 100;
ChPon[Cn *2 +1 ].Ypos := 0;
ChPon[Cn *2 +1 ].Smov := 1;
ChPon[Cn *2 +1 ].Sadd := Random(21);
end;
end;
procedure TR10.tmr1Timer(Sender: TObject);
var
Cn : Byte;
begin
// 计算精灵的位置
for Cn := 0 to 4 do
if (ChPon[Cn *2 +1].Used = 1) and (ChPon[Cn *2 +1 ].Smov =1) then
begin
ChPon[Cn *2 + 1 ].Ypos := ChPon[Cn *2].Ypos - Yplus[ChPon[Cn *2 +1].Sadd];
ChPon[Cn *2 +1 ].Sadd := ChPon[Cn *2 +1].Sadd +1;
if ChPon[Cn *2+1].Sadd > 20 then
ChPon[Cn *2 +1].Sadd := 0;
end;
YScroll;
// 绘制精灵
for Cn := 0 to 9 do
if ChPon[Cn].Used = 1 then
ChrDi(ChPon[Cn].Sban,ChPon[Cn].Xpos, ChPon[Cn].Ypos,MakeBmap);
R10.Canvas.CopyMode := cmSrcCopy;
RectM := Rect(16,16, DYoko + 16,DTate + 16);
RectD := Rect(0,0,DYoko,DTate);
R10.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM);
end;
procedure TR10.FormClose(Sender: TObject; var Action: TCloseAction);
begin
LoadBmap.Free;
XpatBmap.Free;
BackBmap.Free;
MakeBmap.Free;
end;
end.