编程语言
首页 > 编程语言> > Delphi 经典游戏程序设计40例 的学习 例11 零件贴图中的优先顺序

Delphi 经典游戏程序设计40例 的学习 例11 零件贴图中的优先顺序

作者:互联网

 

 

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