rei_36.pas

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

unit Rei_36;

interface

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

type
  //  定义房间记录类型
  TRoom = record
    Used: Byte;
    Xpos: Byte;
    Ypos: Byte;
    Xsiz: Byte;
    Ysiz: Byte;
    UX: Byte;
    UY: Byte;
    DX: Byte;
    DY: Byte;
    LX: Byte;
    LY: Byte;
    RX: Byte;
    RY: Byte;
  end;

  TRei40_36 = class(TForm)
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ReDraw(Sender: TObject);
  private
    { Private 定义 }
    procedure MkRoom;
    procedure MkMaze;
    procedure Tline(a, b: Byte);
    procedure Lway;
    procedure Mway;
    procedure Rway;
    procedure DiMaze;
  public
    { Public 定义 }
  end;

const
  Mwidth = 50 * 10 + 20;    //迷宫画面的宽度
  Mheight = 30 * 10 + 20;   //迷宫画面的高度

var
  Rei40_36: TRei40_36;
  //  定义绘制用的点阵图
  Make_Bmap: TBitmap;
  //  定义各种变量（Byte类型、TRect类型）
  St, m, max: Byte;
  Rect_D: TRect;
  //  定义迷宫资料用数组
  Mdata: array[0..49, 0..29] of Byte;
  Box: array[0..14] of TRoom;

implementation

{$R *.DFM}

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

procedure TRei40_36.Timer1Timer(Sender: TObject);
begin
  case St of
    //  若St＝1，则显示迷宫的外框
    1:begin
      Rect_D := Rect(0, 0, Mwidth, Mheight);
      Make_Bmap.Canvas.Brush.Color := clOlive;
      Make_Bmap.Canvas.FillRect(Rect_D);
      Rect_D := Rect(10, 10, Mwidth-20, Mheight-20);
      Make_Bmap.Canvas.Brush.Color := clBlack;
      Make_Bmap.Canvas.FillRect(Rect_D);
      Rei40_36.Canvas.Draw(0, 0, Make_Bmap);
      St := 2
    end;
    //  若St＝2则制作新的迷宫并显示出来
    2:begin
      MkRoom;
      MkMaze;
      DiMaze;
      Rei40_36.Canvas.Draw(0, 0, Make_Bmap);
      St := 0;
    end;
  end;
end;

procedure TRei40_36.MkRoom;
var
  //  定义局部变量
  n: Byte;
begin
  //  制作房间资料
  for n := 0 to 14 do
    Box[n].Used := 0;
  max := 5 + Random(5);
  m := 0;
  repeat
    n := Random(15);
    if (Odd(n) = False) and (Box[n].Used = 0) then
    begin
      Box[n].Used := 1;
      m := m + 1;
    end;
  until m = 4;
  repeat
    n := Random(15);
    if (n <> 7) and (Box[n].Used = 0) then
    begin
      Box[n].Used := 1;
      m := m + 1;
    end;
  until m > max;
  for n := 0 to 14 do
    with Box[n] do
    begin
      if Used = 1 then
      begin
        Xsiz := 4 + ((n + 1) mod 2) * 2 + Random(4);
        Ysiz := 4 + ((n + 1) mod 2) * 2 + Random(4);
      end
      else begin
        Xsiz := 4;
        Ysiz := 4;
      end;
      Xpos := (n mod 5) * 10 + (10 - Xsiz) div 2;
      Ypos := (n div 5) * 10 + (10 - Ysiz) div 2;
      if Used = 1 then
      begin
        UX := Xpos + 1 + Random(Xsiz - 2);
        UY := Ypos;
        DX := Xpos + 1 + Random(Xsiz - 2);
        DY := Ypos + Ysiz - 1;
        LX := Xpos;
        LY := Ypos + 1 + Random(Ysiz - 2);
        RX := Xpos + Xsiz - 1;
        RY := Ypos + 1 + Random(Ysiz - 2);
      end
      else begin
        UX := Xpos;
        UY := Ypos;
        DX := UX;
        DY := UY;
        LX := UX;
        LY := UY;
        RX := UX;
        RY := UY;
      end;
    end;
  //  通道狭窄时的调整
  for n := 0 to 3 do
    if Box[n + 1].LX - Box[n].RX <= 3 then
    begin
      Box[n].RY := 4 + Random(2);
      Box[n + 1].LY := Box[n].RY;
    end;
  for n := 5 to 8 do
    if Box[n + 1].LX - Box[n].RX <= 3 then
    begin
      Box[n].RY := 14 + Random(2);
      Box[n + 1].LY := Box[n].RY;
    end;
  for n := 10 to 13 do
    if Box[n + 1].LX - Box[n].RX <= 3 then
    begin
      Box[n].RY := 24 + Random(2);
      Box[n + 1].LY := Box[n].RY;
    end;
  for n := 0 to 4 do
  begin
    if Box[n + 5].UY - Box[n].DY <= 3 then
    begin
      Box[n].DX := 4 + Random(2) + n * 10;
      Box[n + 5].UX := Box[n].DX;
    end;
    if Box[n + 10].UY - Box[n + 5].DY <= 3 then
    begin
      Box[n + 5].DX := 4 + Random(2) + n * 10;
      Box[n + 10].UX := Box[n + 5].DX;
    end;
  end;
end;

procedure TRei40_36.MkMaze;
var
  //  定义局部变量
  X, Y, n: Byte;
begin
  //  制作房间资料
  for X := 0 to 49 do
    for Y := 0 to 29 do
      Mdata[X, Y] := 1;
  for n := 0 to 14 do
    if Box[n].Used = 1 then
      for X := Box[n].LX to Box[n].RX do
        for Y := Box[n].UY to Box[n].DY do
          Mdata[X, Y] := 2;
  //  制作通道资料
  Lway;
  Mway;
  Rway;
end;

procedure TRei40_36.Lway;
begin
  //  制作左侧的通道资料
  if Random(2) = 0 then
  begin
    Tline(0, 1);
    Tline(0, 5);
    Tline(1, 6);
    if (Box[5].Used and Box[6].Used = 0) or (Random(2) = 0) then
      Tline(5, 6);
    if Box[10].Used = 1 then
    begin
      Tline(5, 10);
      if Random(2) = 0 then
        Tline(10, 11)
      else
        Tline(6, 11);
    end
    else if Random(2) = 0 then
    begin
      Tline(5, 10);
      Tline(10, 11);
    end
    else
      Tline(6, 11);
  end
  else begin
    Tline(10, 11);
    Tline(5, 10);
    Tline(6, 11);
    if (Box[5].Used and Box[6].Used = 0) or (Random(2) = 0) then
      Tline(5, 6);
    if Box[0].Used = 1 then
    begin
      Tline(0, 5);
      if Random(2) = 0 then
        Tline(0, 1)
      else
        Tline(1, 6);
    end
    else if Random(2) = 0 then
    begin
      Tline(0, 5);
      Tline(0, 1);
    end
    else
      Tline(1, 6);
  end
end;

procedure TRei40_36.Mway;
begin
  //  制作中央的通道资料
  case Random(4) of
    0: begin
      Tline(1, 2);
      Tline(2, 3);
      Tline(11, 12);
      if Random(2) = 0 then
        Tline(12, 13);
    end;
    1: begin
      Tline(1, 2);
      Tline(2, 3);
      Tline(12, 13);
      if Random(2) = 0 then
        Tline(11, 12);
    end;
    2: begin
      Tline(11, 12);
      Tline(12, 13);
      Tline(1, 2);
      if Random(2) = 0 then
        Tline(2, 3);
    end;
    3: begin
      Tline(11, 12);
      Tline(12, 13);
      Tline(2, 3);
      if Random(2) = 0 then
        Tline(1, 2);
    end;
  end;
end;

procedure TRei40_36.Rway;
begin
  //  制作右侧的通道资料
  if Random(2) = 0 then
  begin
    Tline(3, 4);
    Tline(3, 8);
    Tline(4, 9);
    if (Box[8].Used and Box[9].Used = 0) or (Random(2) = 0) then
      Tline(8, 9);
    if Box[14].Used = 1 then
    begin
      Tline(9, 14);
      if Random(2) = 0 then
        Tline(13, 14)
      else
        Tline(8, 13);
    end
    else if Random(2) = 0 then
    begin
      Tline(9, 14);
      Tline(13, 14);
    end
    else
      Tline(8, 13);
  end
  else begin
    Tline(13, 14);
    Tline(8, 13);
    Tline(9, 14);
    if (Box[8].Used and Box[9].Used = 0) or (Random(2) = 0) then
      Tline(8, 9);
    if Box[4].Used = 1 then
    begin
      Tline(4, 9);
      if Random(2) = 0 then
        Tline(3, 4)
      else
        Tline(3, 8);
    end
    else if Random(2) = 0 then
    begin
      Tline(3, 4);
      Tline(4, 9);
    end
    else
      Tline(3, 8);
  end;
end;

procedure TRei40_36.Tline(a, b: Byte);
var
  //  定义局部变量
  nn, MX, MY: Byte;
begin
  if (b - a) = 1 then
  begin
    //  横向将迷宫连接起来
    MX := Box[b].LX - (Box[b].LX - Box[a].Xpos - Box[a].Xsiz + 2) div 2;
    for nn := Box[a].RX to MX do
      Mdata[nn, Box[a].RY] := Mdata[nn, Box[a].RY] and 2;
    for nn := MX to Box[b].LX do
      Mdata[nn, Box[b].LY] := Mdata[nn, Box[b].LY] and 2;
    if Box[a].RY > Box[b].LY then
      for nn := Box[b].LY to Box[a].RY do
        Mdata[MX, nn] := Mdata[MX, nn] and 2
    else if Box[a].RY < Box[b].LY then
      for nn := Box[a].RY to Box[b].LY do
        Mdata[MX, nn] := Mdata[MX, nn] and 2
  end
  else begin
    //  纵向将迷宫连接起来
    MY := Box[b].UY - (Box[b].UY - Box[a].Ypos - Box[a].Ysiz + 2) div 2;
    for nn := Box[a].DY to MY do
      Mdata[Box[a].DX, nn] := Mdata[Box[a].DX, nn] and 2;
    for nn := MY to Box[b].UY do
      Mdata[Box[b].UX, nn] := Mdata[Box[b].UX, nn] and 2;
    if Box[a].DX > Box[b].UX then
      for nn := Box[b].UX to Box[a].DX do
        Mdata[nn, MY] := Mdata[nn, MY] and 2
    else if Box[a].DX < Box[b].UX then
      for nn := Box[a].DX to Box[b].UX do
        Mdata[nn, MY] := Mdata[nn, MY] and 2
  end;
end;

procedure TRei40_36.DiMaze;
var
  //  定义局部变量
  X, Y: Byte;
begin
  //  显示迷宫
  for X := 0 to 49 do
    for Y := 0 to 29 do
      begin
        case Mdata[X, Y] of
          0: Make_Bmap.Canvas.Brush.Color := clBlack;  //通道颜色
          1: Make_Bmap.Canvas.Brush.Color := clOlive;  //墙壁颜色
          2: Make_Bmap.Canvas.Brush.Color := clNavy;   //房间颜色
        end;
        Rect_D := Rect(X * 10 + 10, Y * 10 + 10, X * 10 + 20, Y * 10 + 20);
        Make_Bmap.Canvas.FillRect(Rect_D);
      end;
end;

procedure TRei40_36.Button1Click(Sender: TObject);
begin
  //  迷宫制作的指示
  St := 2;
end;

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

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

end.