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.