rei_17.pas

Delphi经典游戏程序设计40例.pdf 中国铁道出版社出版 含源码

unit Rei_17;

interface

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

type
  //  数组管理角色的记录类型
  TPatDt = record
    Used: Byte;
    Sban: Byte;
    Xpos: Integer;
    Ypos: Integer;
    Smov: ShortInt;
    Scon: Byte;
  end;

  TRei40_17 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 数组 }
    procedure HitCk;
    procedure MBalls;
    procedure MCanon;
    procedure MStars;
    procedure ChrDi(Xsiz, Ysiz: Byte; Dpon: Word; X1, Y1: Integer;
      Bmap: TBitmap);
    procedure PatDi(Pnum: Byte; X1, Y1: Integer; Bmap: TBitmap);
  public
    { Public 数组 }
  end;

const
  Yoko = 37;           //显示的横向图样数
  Tate = 27;           //显示的纵向图样数
  DYoko = Yoko * 16;   //显示的横向点数
  DTate = Tate * 16;   //显示的纵向点数
  PtFull = 16;         //全面显示（不要重叠显示）的图样数
  MaxSp = 14;          //本次使用的复合图样总数

var
  Rei40_17: TRei40_17;
  //  数组载入用、去除模版用与绘制用的点阵图
  Load_Bmap: TBitmap;
  Xpat_Bmap: TBitmap;
  Make_Bmap: TBitmap;
  //  数组各种变量(Byte类型、Word类型、Integer类型、TRect类型、数组类型)
  PX, PY: Byte;
  Sc: Word;
  X, Y: Integer;
  Rect_L, Rect_M, Rect_D: TRect;
  ChPon: array[0..10] of TPatDt;
  //  复合图样数组
  SpSiz: array[0..(MaxSp * 2 - 1)] of Byte = (
    1,1, 2,2, 2,2, 2,2, 2,2, 2,2, 2,2, 2,2, 2,2, 2,2, 1,1, 1,1, 1,1, 1,1
  );
  SpPon: array[0..(MaxSp - 1)] of Word;
  SpDat: array[0..40] of Byte = (
    0,
    76, 77, 92, 93,
    28, 29, 30, 31,
    34, 35, 50, 51,
    36, 37, 52, 53,
    38, 39, 54, 55,
    40, 41, 56, 57,
    42, 43, 58, 59,
    44, 45, 60, 61,
    46, 47, 62, 63,
    19, 20, 21, 22
  );

implementation

{$R *.DFM}

procedure TRei40_17.FormCreate(Sender: TObject);
var
  //  数组局部变量
  n, Cn: Byte;
begin
  //  设定Form属性
  Rei40_17.Height := 480;
  Rei40_17.Width := 640;
  //  载入图样
  Load_Bmap := TBitmap.Create;
  Load_Bmap.LoadFromFile(GetCurrentDir + '\ExData\Pat_Sample.bmp');
  //  储存去除用点阵图
  Xpat_Bmap := TBitmap.Create;
  Xpat_Bmap.Width := 256;
  Xpat_Bmap.Height := 256;
  //  制作去除用点阵图
  Rect_L := Rect(0, 0, 256, 256);
  Xpat_Bmap.Canvas.CopyMode := cmSrcCopy;
  Xpat_Bmap.Canvas.CopyRect(Rect_L, Load_Bmap.Canvas, Rect_L);
  Xpat_Bmap.Canvas.Brush.Color := clBlack;
  Xpat_Bmap.Canvas.BrushCopy(Rect_L, Load_Bmap, Rect_L, clWhite);
  Xpat_Bmap.Canvas.CopyMode := cmMergePaint;
  Xpat_Bmap.Canvas.CopyRect(Rect_L, Load_Bmap.Canvas, Rect_L);
  //  零件贴图指标数组的初始设定
  Sc := 0;
  for n := 0 to (MaxSp - 1) do
  begin
    SpPon[n] := Sc;
    Sc := Sc + SpSiz[n * 2] * SpSiz[n * 2 + 1];
  end;
  //  储存绘制点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := DYoko + 32;
  Make_Bmap.Height := DTate + 32;
   //  角色用数组的初始设定
  Randomize;
  ChPon[0].Used := 1;
  ChPon[0].Sban := 1;
  ChPon[0].Xpos := DYoko div 2 - 16;
  ChPon[0].Ypos := DTate - 32;
  ChPon[0].Smov := 4;
  ChPon[0].Scon := 30;
  for Cn := 1 to 4 do
  begin
    ChPon[Cn].Used := 0;
    ChPon[Cn].Scon := Random(10) + 10;
  end;
  for Cn := 5 to 10 do
    ChPon[Cn].Used := 0;
end;

procedure TRei40_17.Timer1Timer(Sender: TObject);
var
  //  数组局部变量
  Cn: Byte;
begin
  //  碰撞检查与全部角色的行动管理
  HitCk;
  MBalls;
  MCanon;
  MStars;
  //  将全部的角色绘制至绘制点阵图上并显示在Form上
  Rect_M := Rect(16, 16, DYoko + 16, DTate + 16);
  Make_Bmap.Canvas.Brush.Color := clBlack;
  Make_Bmap.Canvas.Fillrect(Rect_M);
  Rei40_17.Canvas.CopyMode := cmSrcCopy;
  for Cn := 10 downto 0 do
    if (ChPon[Cn].Used <> 0) and (ChPon[Cn].Sban <> 0) then
    begin
      ChrDi(SpSiz[ChPon[Cn].Sban * 2], SpSiz[ChPon[Cn].Sban * 2 + 1],
        SpPon[ChPon[Cn].Sban], ChPon[Cn].Xpos + 16,
        ChPon[Cn].Ypos + 16, Make_Bmap);
    end;
  Rect_D := Rect(0, 0, DYoko, DTate);
  Rei40_17.Canvas.CopyRect(Rect_D, Make_Bmap.Canvas, Rect_M);
end;

procedure TRei40_17.HitCk;
var
  //  数组局部变量
  Cn, n: Byte;
begin
  //  检查人面球是否与星星碰撞
  for Cn := 1 to 4 do
    if ChPon[Cn].Used = 2 then
      for n := 5 to 10 do
        if ChPon[n].Used = 1 then
        begin
          X := ChPon[Cn].Xpos - ChPon[n].Xpos;
          Y := ChPon[Cn].Ypos - ChPon[n].Ypos;
          if (X >= -28) and (X <= 12) and (Y >= -28) and (Y <= 12) then
          begin
            ChPon[Cn].Used := 255;
            ChPon[n].Used := 0;
          end;
        end;
end;

procedure TRei40_17.MBalls;
var
  //  数组局部变量
  Cn: Byte;
begin
  //  人面球的移动与出现
  for Cn := 1 to 4 do
  begin
    ChPon[Cn].Scon := ChPOn[Cn].Scon + 1;
    case ChPon[Cn].Used of
      0: begin
        if (ChPon[Cn].Scon > 30) and (Random(100) < 15) then
        begin
          ChPon[Cn].Used := 1;
          ChPon[Cn].Sban := 2;
          ChPon[Cn].Xpos := (Cn - 1) * 160 + 15 + Random(50);
          ChPon[Cn].Ypos := -31;
        end;
      end;
      1: begin
        ChPon[Cn].Ypos := ChPon[Cn].Ypos + 2;
        ChPon[Cn].Sban := ChPon[Cn].Sban xor 2;
        if ChPon[Cn].Ypos > 100 then
        begin
          ChPon[Cn].Used := 2;
          ChPon[Cn].Sban := 2;
          ChPon[Cn].Scon := 0;
        end;
      end;
      2: begin
        if ChPon[Cn].Scon = 255 then
          ChPon[Cn].Used := 3;
      end;
      3: begin
        ChPon[Cn].Ypos := ChPon[Cn].Ypos - 4;
        ChPon[Cn].Sban := ChPon[Cn].Sban xor 2;
        if ChPon[Cn].Ypos < -31 then
        begin
          ChPon[Cn].Used := 0;
          ChPon[Cn].Scon := 0;
        end;
      end;
      255: begin
        if ChPon[Cn].Sban = 2 then
        begin
          ChPon[Cn].Sban := 3;
          ChPon[Cn].Scon := 0;
          ChPon[Cn].Smov := 0;
        end
        else begin
          ChPon[Cn].Sban := ChPon[Cn].Sban + 1;
          if (ChPon[Cn].Sban = 7) and (ChPon[Cn].Smov <= 2) then
          begin
            ChPon[Cn].Sban := 3;
            ChPon[Cn].Smov := ChPon[Cn].Smov + 1;
          end
          else if ChPon[Cn].Sban = 10 then
          begin
            ChPon[Cn].Used := 0;
            ChPon[Cn].Scon := 0;
          end;
        end;
      end;
    end;
  end;
end;

procedure TRei40_17.MCanon;
var
  //  数组局部变量
  Cn: Byte;
begin
  //  检查炮台的移动与星星的发射情形
  ChPon[0].Xpos := ChPon[0].Xpos + ChPon[0].Smov;
  if (ChPon[0].Xpos < 0) or (ChPon[0].Xpos > DYoko - 32) then
  begin
    ChPon[0].Smov := -ChPon[0].Smov;
    ChPon[0].Xpos := ChPon[0].Xpos + ChPon[0].Smov;
  end;
  ChPon[0].Scon := ChPon[0].Scon + 1;
  if (ChPon[0].Scon > 15) and (Random(100) < 35) then
  begin
    Cn := 5;
    while (Cn < 11) and (ChPon[Cn].Used = 1) do
      Cn := Cn + 1;
    if Cn < 11 then
    begin
      ChPon[Cn].Used := 1;
      ChPon[Cn].Xpos := ChPon[0].Xpos + 8;
      ChPon[Cn].Ypos := DTate - 45;
      ChPon[Cn].Smov := 10 + Random(5);
      ChPon[0].Scon := 0;
    end;
  end;
end;

procedure TRei40_17.MStars;
var
  //  数组局部变量
  Cn: Byte;
begin
  //  星星的移动
  for Cn := 5 to 10 do
    if ChPon[Cn].Used = 1 then
    begin
      ChPon[Cn].Scon := ChPon[Cn].Scon + 1;
      ChPon[Cn].Sban := 10 + ChPon[Cn].Scon and 3;
      ChPon[Cn].Ypos := ChPon[Cn].Ypos - ChPon[Cn].Smov;
        if ChPon[Cn].Ypos < -15 then
          ChPon[Cn].Used := 0;
    end;
end;

procedure TRei40_17.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 TRei40_17.PatDi(Pnum: Byte; X1, Y1: Integer; Bmap: TBitmap);
begin
  //  将指定的图样绘制至指定点阵图的指定位置上（重叠显示适用）
  PX := (Pnum and $F) * 16;
  PY := Pnum and $F0;
  Rect_L := Rect(PX, PY, PX + 16, PY + 16);
  Rect_D := Rect(X1, Y1, X1 + 16, Y1 + 16);
  if Pnum <> 0 then
    if Pnum >= PtFull then
    begin
      Bmap.Canvas.CopyMode := cmSrcPaint;
      Bmap.Canvas.CopyRect(Rect_D, Xpat_Bmap.Canvas, Rect_L);
      Bmap.Canvas.CopyMode := cmSrcAnd;
      Bmap.Canvas.CopyRect(Rect_D, Load_Bmap.Canvas, Rect_L);
    end
    else begin
      Bmap.Canvas.CopyMode := cmSrcCopy;
      Bmap.Canvas.CopyRect(Rect_D, Load_Bmap.Canvas, Rect_L);
    end;
end;

procedure TRei40_17.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将载入用、去除用、绘制用的点阵图释放掉
  Load_Bmap.Free;
  Xpat_Bmap.Free;
  Make_Bmap.Free;
end;

end.