rei_37.pas

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

unit Rei_37;

interface

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

type
  TRei40_37 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ReDraw(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private 定义 }
    procedure WtMove;
    procedure RdMove;
    procedure Ncheck(X1, Y1, Dr: Byte);
    procedure Gnext(var X1: Byte; var Y1: Byte; Dr: Byte);
    procedure DiMaze;
  public
    { Public 定义 }
  end;

const
  Xmax = 28;                       //迷宫的宽度-1
  Ymax = 20;                       //迷宫的高度-1
  Mwidth = (Xmax + 1) * 16 + 32;   //迷宫显示画面的宽度
  Mheight = (Ymax + 1) * 16 + 32;  //迷宫显示画面的高度

var
  Rei40_37: TRei40_37;
  //  定义绘制用的点阵图
  Make_Bmap: TBitmap;
  //  定义各种变量（Byte类型、TRect类型、数组类型）
  St, X, Y, Wtime: Byte;
  WX, WY, WD: Byte;
  RX, RY, RD, See, Mem, PX, PY, PD: Byte;
  Rect_D: TRect;
  Dmap: array[0..3] of Byte;
  Dinf: array[0..4] of Byte;
  //  定义迷宫资料用数组
  Mdata: array[0..Xmax, 0..Ymax] of Byte =(
    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
    (0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0),
    (0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0,0,0,0),
    (0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1,1,0),
    (0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0),
    (0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0),
    (0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0,0,0,0,0,0),
    (0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0),
    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
    (0,1,1,1,1,1,0,1,0,1,0,1,0,1,1,1,1,1,1,1,0),
    (0,0,0,0,0,0,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0),
    (0,1,1,1,1,1,0,1,0,1,0,1,0,1,1,1,1,1,1,1,0),
    (0,0,0,0,0,0,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0),
    (0,1,1,1,1,1,0,1,0,1,0,1,0,1,1,1,1,1,1,1,0),
    (0,0,0,0,0,0,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0),
    (0,1,1,1,1,1,0,1,0,1,0,1,0,1,1,1,1,1,1,1,0),
    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),
    (0,1,1,1,1,1,0,1,0,1,0,1,0,1,1,1,1,1,1,1,0),
    (0,1,0,0,0,0,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0),
    (0,1,0,1,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,0),
    (0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,1,0,0,0,1,0),
    (0,1,1,1,1,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0),
    (0,1,0,0,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0),
    (0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,1,1,0),
    (0,1,1,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0,0),
    (0,0,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0),
    (0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,1,0,1,0,1,0),
    (0,1,1,1,1,1,0,1,1,1,1,1,0,1,1,1,0,1,1,1,0),
    (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
  );

implementation

{$R *.DFM}

procedure TRei40_37.FormCreate(Sender: TObject);
begin
  //  设定Form属性
  Rei40_37.Height := 480;
  Rei40_37.Width := 640;
  Rei40_37.Canvas.CopyMode := cmSrcCopy;
  Button1.Height := 50;
  Button1.Left := 530;
  Button1.Top := 16;
  Button1.Width := 90;
  //  储存绘制用的点阵图
  Make_Bmap := TBitmap.Create;
  Make_Bmap.Width := Mwidth;
  Make_Bmap.Height := Mheight;
  //  初始设定之指示
  St := 1;
  Randomize;
end;

procedure TRei40_37.Timer1Timer(Sender: TObject);
begin
  case St of
    //  若St＝0，则开始红白对抗追赶行动
    0: begin
      Wtime := Wtime xor 1;
      if (WX = RX) and (WY = RY) then
      begin
        With Rei40_37 do
          if Wtime = 0 then
            Canvas.Brush.Color := clRed
          else
            Canvas.Brush.Color := clWhite;
          Canvas.Ellipse(WX * 16 + 19, WY * 16 + 19,WX * 16 + 29, WY * 16 + 29);
      end
      else begin
        WtMove;
      if (WX <> RX) or (WY <> RY) then
        RdMove;
      end;
    end;
    //  若St＝1，则显示迷宫画面
    1: begin
      DiMaze;
      St := 2;
    end;
    //  若St＝2，则将红、白点做初始设定
    2: begin
      St := 0;
      See := 255;
      Mem := 255;
      repeat
        WX := Random(Xmax + 1);
        WY := Random(Ymax + 1);
        WD := Random(4);
      until Mdata[WX, WY] = 0;
      repeat
        RX := Random(Xmax + 1);
        RY := Random(Ymax + 1);
        RD := Random(4);
      until (Mdata[RX, RY] = 0) and (Abs(WX - RX) > 8) and (Abs(WY - RY) > 6);
    end;
  end;
end;

procedure TRei40_37.WtMove;
begin
  //  移动白点
  with Rei40_37 do
    Canvas.Brush.Color := clBlack;
    Canvas.Ellipse(WX * 16 + 19, WY * 16 + 19,WX * 16 + 29, WY * 16 + 29);
    Ncheck(WX, WY, WD);
    if (Dinf[0] = 1) or (Dinf[0] = 2) then
      WD := Dinf[1]
    else
      WD := Dinf[1 + Random(Dinf[0] - 1)];
    Gnext(WX, WY, WD);
    Canvas.Brush.Color := clWhite;
    Canvas.Ellipse(WX * 16 + 19, WY * 16 + 19,WX * 16 + 29, WY * 16 + 29);
end;

procedure TRei40_37.RdMove;
var
  //  定义局部变量
  n: Byte;
begin
  //  移动红点
  with Rei40_37 do
    Canvas.Brush.Color := clBlack;
    Canvas.Ellipse(RX * 16 + 19, RY * 16 + 19,RX * 16 + 29, RY * 16 + 29);
    Ncheck(RX, RY, RD);
    if (WY = RY) and (WX > RX) then
    begin
      See := 0;
      for n := RX + 1 to WX do
        if Mdata[n, RY] <> 0 then
          See := 255;
    end
    else if (WX = RX) and (WY < RY) then
    begin
      See := 1;
      for n := RY - 1 downto WY do
        if Mdata[RX, n] <> 0 then
          See := 255;
    end
    else if (WY = RY) and (WX < RX) then
    begin
      See := 2;
      for n := RX - 1 downto WX do
        if Mdata[n, RY] <> 0 then
          See := 255;
    end
    else if (WX = RX) and (WY > RY) then
    begin
      See := 3;
      for n := RY + 1 to WY do
        if Mdata[RX, n] <> 0 then
          See := 255;
    end;
    if See < 4 then
    begin
      if (RD = See) or (Dinf[0] > 2) or (Dinf[1] <> RD) then
      begin
        RD := See;
        Mem := 0;
      end;
      See := 255;
    end
    else if Mem = 0 then
    begin
      PX := WX;
      PY := WY;
      PD := WD;
      Mem := 1;
    end
    else if Mem = 1 then
    begin
      if (RX = PX) or (RY = PY) then
      begin
        RD := PD;
        Mem := 255;
      end;
    end
    else if Dinf[0] <= 2 then
      RD := Dinf[1]
    else
      RD := Dinf[1 + Random(Dinf[0] - 1)];
    Gnext(RX, RY, RD);
    Canvas.Brush.Color := clRed;
    Canvas.Ellipse(RX * 16 + 19, RY * 16 + 19,RX * 16 + 29, RY * 16 + 29);
end;

procedure TRei40_37.Ncheck(X1, Y1, Dr: Byte);
var
  //  定义局部变量
  n: Byte;
begin
  //  检查能够前往的位置
  if X1 < Xmax then
    Dmap[0] := Mdata[X1 + 1, Y1]
  else
    Dmap[0] := 1;
  if Y1 > 0 then
    Dmap[1] := Mdata[X1, Y1 - 1]
  else
    Dmap[1] := 1;
  if X1 > 0 then
    Dmap[2] := Mdata[X1 - 1, Y1]
  else
    Dmap[2] := 1;
  if Y1 < Ymax then
    Dmap[3] := Mdata[X1, Y1 + 1]
  else
    Dmap[3] := 1;
  n := 1;
  if Dmap[Dr] = 0 then
  begin
    Dinf[n] := Dr;
    n := n + 1;
  end;
  if Dmap[(Dr + 1) and 3] = 0 then
  begin
    Dinf[n] := (Dr + 1) and 3;
    n := n + 1;
  end;
  if Dmap[(Dr - 1) and 3] = 0 then
  begin
    Dinf[n] := (Dr - 1) and 3;
    n := n + 1;
  end;
  if Dmap[(Dr + 2) and 3] = 0 then
  begin
    Dinf[n] := (Dr + 2) and 3;
    n := n + 1;
  end;
  Dinf[0] := n - 1;
end;

procedure TRei40_37.Gnext(var X1: Byte; var Y1: Byte; Dr: Byte);
begin
  //  按各个方向依次改变座标
  case Dr of
    0: X1 := X1 + 1;
    1: Y1 := Y1 - 1;
    2: X1 := X1 - 1;
    3: Y1 := Y1 + 1;
  end;
end;

procedure TRei40_37.DiMaze;
var
  //  定义局部变量
  X, Y: Byte;
begin
  //  显示迷宫
  Rect_D := Rect(0, 0, Mwidth, Mheight);
  Make_Bmap.Canvas.Brush.Color := clOlive;
  Make_Bmap.Canvas.FillRect(Rect_D);
  Make_Bmap.Canvas.Brush.Color := clBlack;
  for X := 0 to Xmax do
    for Y := 0 to Ymax do
      if Mdata[X, Y] <> 1 then
      begin
        Rect_D := Rect(X * 16 + 16, Y * 16 + 16, X * 16 + 32, Y * 16 + 32);
        Make_Bmap.Canvas.FillRect(Rect_D);
      end;
  Rei40_37.Canvas.Draw(0, 0, Make_Bmap);
end;

procedure TRei40_37.Button1Click(Sender: TObject);
begin
  //  初始设定的指示
  St := 2;
  with Rei40_37 do
    Canvas.Brush.Color := clBlack;
    Canvas.Ellipse(WX * 16 + 19, WY * 16 + 19,WX * 16 + 29, WY * 16 + 29);
    Canvas.Ellipse(RX * 16 + 19, RY * 16 + 19,RX * 16 + 29, RY * 16 + 29);
end;

procedure TRei40_37.ReDraw(Sender: TObject);
begin
  //  重绘Form
  Rei40_37.Canvas.Draw(0, 0, Make_Bmap);
end;

procedure TRei40_37.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //  将绘制用的点阵图释放掉
  Make_Bmap.Free;
end;

end.