Delphi 经典游戏程序设计40例的学习例7 星星的诞生与陨落

2022-01-03 21:35:38 阅读：170 来源： 互联网

标签：Canvas end 16 ChPon Delphi 陨落 begin 40 X1

unit rei4007;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type

  TpatDt = record
    Used : Byte;        //角色使用的标记
    Xpos :Integer;
    Ypos : Integer;
    Sban : Byte;    //复合图案编号
    Smov : Byte;
    Slife : Byte;
    Count : Byte;
  end;


  TRei07 = class(TForm)
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }

    procedure StChk(var Chpon: TpatDt);
    procedure Stars( var Chpon : TpatDt);
    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);

    procedure ChrCl(Sban :Byte;X1,Y1 :Integer;Bmap : TBitmap);
    procedure SbanCl(Xdot,Ydot:Word;X1,Y1: Integer;Bmap : TBitmap);
  public
    { Public declarations }
  end;

const
  Yoko = 37;
  Tate = 27;
  DYoko = Yoko * 16;
  DTate = Tate *16;
  PtFull = 16;    //全面显示的图案数
  ChMax = 30;      //角色总数

var
  Rei07: TRei07;
  // 载入用，去除模板用，背景用，绘制用 的点阵图
  LoadBmap,XpatBmap,BackBmap,MakeBmap : TBitmap;
  PX,PY,n : Byte;
  RectL,RectB,RectM,RectD : TRect;
          //角色，复合图案用数组
  ChPon : array[0..(ChMax-1)] of TpatDt;
  Spr00 : array[0..2] of Byte = (1,1,0);
  Spr01:  array[0..2] of Byte = ( 1,1,19) ;
  Spr02 : array[0..2] of Byte = (1,1,23);


implementation

{$R *.dfm}

procedure TRei07.FormCreate(Sender: TObject);
var
  X,Y,Cn :Byte;
begin
  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);

  //    背景用点阵图
  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
    PatDi(2,X*16 +16,Y*16 + 16 ,BackBmap);
  //绘制用点阵图，复制背景
  MakeBmap := TBitmap.Create;
  MakeBmap.Width := BackBmap.Width;
  MakeBmap.Height := BackBmap.Height;
  MakeBmap.Canvas.Draw(0,0,BackBmap);
  // 设置角色初始值
  Randomize;
  for Cn :=0 to (ChMax - 1) do
  begin
    ChPon[Cn].Used :=0;
    ChPon[Cn].Count := Random(15);

  end;


end;

procedure TRei07.StChk(var Chpon: TpatDt);
 //管理新出现的星星
begin
  if (ChPon.Count > 20) and (Random(100)<3) then
  begin
    ChPon.Used :=1;
    ChPon.Xpos := Random(DYoko -16);
    ChPon.Ypos := Random(DTate -16);
    ChPon.Sban := 1;
    ChPon.Smov :=0 ;
    ChPon.Slife := Random(80) + 100;
    ChPon.Count :=0;
  end;
end;


procedure TRei07.Stars( var Chpon : TpatDt);

//管理 使用中 角色的动作  SMOV
begin
  case ChPon.Smov of
      //conut 在  time1 中 进行 +1 ，间隔 20毫秒
      //  星星寿命到了？进入状态1
    0 : begin
      if ChPon.Count > ChPon.Slife then
      begin
        ChPon.Smov :=1;
        ChPon.Count :=1;

      end;
    end;
         //状态1，复合图案设置，闪动
    1 : begin
      ChPon.Sban := Chpon.Count and 1;    //位运算？ 0/1实现闪动？
      if ChPon.Count > 16 then    //记次16次后状态2，图案2
      begin
        ChPon.Smov :=2;
        ChPon.Count :=0;
        ChPon.Sban :=2 ;
      end;
    end;

    2:begin
      if Chpon.Count > 5 then      //记次5次后状态3
      begin
        Chpon.Smov :=3;
        Chpon.Count :=0;
      end;
    end;
      // 3 坠落 ,记次7次 140毫秒？，后加速坠落
    3:begin
      Chpon.Ypos  := Chpon.Ypos + 1;
      if Chpon.Count > 7 then
      begin
        Chpon.Smov :=4;
        Chpon.Count :=0;
      end;
    end;
     //4  加速坠落
    4: ChPon.Ypos := Chpon.Ypos + Chpon.Count;

    end;

     //判断坠落出界，此星星进行重置。

    if Chpon.Ypos > Tate * 16 then
      begin
        Chpon.Used := 0;
        Chpon.Count :=0;
      end;
    end;



procedure  TRei07.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 TRei07.SbanDi(Sary : array of Byte; X1,Y1 : Integer;Bmap : TBitmap);
var
  X,Y :Byte;
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 <= Dtate +16) then
         PatDi(Sary[n],X1+ X*16,Y1 +Y*16,Bmap);
      n := n+1;
    end;
end;

procedure TRei07.PatDi(Pnum:Byte;X1,Y1: Integer;Bmap :TBitmap);
begin
  PX := (Pnum mod 16 )*16;
  PY := (Pnum div 16 )*16;

  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 Trei07.ChrCl(Sban :Byte;X1,Y1 :Integer;Bmap : TBitmap);
begin
  case Sban of
    0 : SbanCl(Spr00[0]*16,Spr00[1]*16, X1+ 16,Y1 + 16,Bmap);
    1 : SbanCl(Spr01[0]*16,Spr01[1]*16,X1 +16,Y1 + 16, Bmap);
    2 : SbanCl(Spr02[0]*16,Spr02[1]*16,X1 + 16,Y1 + 16,Bmap);
  end;
end;


procedure TRei07.SbanCl(Xdot,Ydot:Word;X1,Y1: Integer;Bmap : TBitmap);
begin
   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 TRei07.tmr1Timer(Sender: TObject);
var
  Cn :Byte;
begin
  //确认角色的行动
  for Cn :=0 to (ChMax-1 )do
  begin
    ChPon[Cn].Count :=   chPon[Cn].Count + 1;   //角色计数次
    if ChPon[Cn].Used = 0 then    //该角色没有使用
      StChk( ChPon[Cn])           //进行管理设置
    else
      Stars(ChPon[Cn]);
  end;
  // 绘制所有角色 在绘制用点阵图
  for cn:=0 to (ChMax -1) do
    if ChPon[Cn].Used =1 then
    ChrDi(ChPon[Cn].Sban,ChPon[Cn].Xpos,ChPon[Cn].Ypos,MakeBmap);
  // 将绘制点阵图 显示到 FORM上
  Rei07.Canvas.CopyMode := cmSrcCopy;
  RectM :=Rect(16,16,DYoko + 16, DTate + 16);
  RectD := Rect(0,0,DYoko,DTate);
  Rei07.Canvas.CopyRect(RectD,MakeBmap.Canvas,RectM);
  // 以背景除去所有的角色
  for Cn :=0 to (ChMax -1 ) do
    if ChPon[Cn].Used =1 then
      ChrCl(ChPon[Cn].Sban,ChPon[Cn].Xpos,ChPon[Cn].Ypos,MakeBmap);
end;

procedure TRei07.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  LoadBmap.Free;
  XpatBmap.Free;
  BackBmap.Free;
  MakeBmap.Free;
end;

end.

贴图都是前一个程序延续而来的，

核心的变化是对星星这个设置了更多的参数，来组成一个记录，

所有的星星又组成一个记录数组。

用了一个 STARS 方法来做星星状态的改变，

通过记录里面的一个元素变量来当计数器，

而他是通过时间组件 TIMER1 间隔 20毫秒来 +1 的，

从而实现的新生，闪耀，坠落，加速坠落。

新生的设置是在 STCHK 里面进行对星星的参数设置的。

嗯，还有随即数这个的运用。

标签：Canvas,end,16,ChPon,Delphi,陨落,begin,40,X1
来源： https://www.cnblogs.com/D7mir/p/15760567.html

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

ICode9

Delphi 经典游戏程序设计40例 的学习 例7 星星的诞生与陨落

Delphi 经典游戏程序设计40例的学习例7 星星的诞生与陨落