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

本文主要是介绍Delphi 经典游戏程序设计40例的学习例7 星星的诞生与陨落，对大家解决编程问题具有一定的参考价值，需要的程序猿们随着小编来一起学习吧！

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 里面进行对星星的参数设置的。

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

这篇关于Delphi 经典游戏程序设计40例的学习例7 星星的诞生与陨落的文章就介绍到这儿，希望我们推荐的文章对大家有所帮助，也希望大家多多支持为之网！

Java教程

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

前端开发

后端开发

移动端开发

数据库

服务器运维

人工智能

区块链

游戏开发

网站运营

大数据/云计算

软件工程

软件/开发工具使用

资讯

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

前端开发

后端开发

移动端开发

数据库

服务器运维

人工智能

区块链

游戏开发

网站运营

大数据/云计算

软件工程

软件/开发工具使用

资讯

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