标签：贴图 11 begin end Cn 16 ChPon Delphi Dpn

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.

一个月前照着书本敲的代码，

忘的差不多了，基本一个星期不敲代码就忘了

得坚持持续的学习啊

标签：贴图,11,begin,end,Cn,16,ChPon,Delphi,Dpn
来源： https://www.cnblogs.com/D7mir/p/16469235.html

本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享；
2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关；
3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关；
4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除；
5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。