首页 > 编程语言 >Delphi 经典游戏程序设计40例 的学习 例35半自动制作迷宫的扩展，3种变化

Delphi 经典游戏程序设计40例 的学习 例35半自动制作迷宫的扩展，3种变化

时间：2022-10-25 20:16:14浏览次数：44  
标签：12 end .. Delphi array 35 40 MdMov Byte 

unit R35;

interface

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

type
  TRei35 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure MkMaze;
    procedure MdMov(n1,n2,m1,m2:Byte;Mdpon:array of Byte);
    procedure DiMaze;
  public
    { Public declarations }
  end;

const
  Mwidth = 25 * 16 + 32;         //规定的16*16的方块，25*19个，
  Mheight = 19 * 16 + 32;
  
var
  Rei35: TRei35;
  MakeBmap : TBitmap;
  RectD : TRect;
  St,n : Byte;
  Mdata : array[0..24,0..18] of Byte;        //25*19 的数组 ，

  Md011 : array[0..6 * 6 - 1] of Byte = (     //分为12格，预设的数据，这个得预先设置好 6*6方块
    0,0,0,0,0,0, 0,1,0,1,0,1, 0,1,0,1,0,1,    //编号XX + 变化X
    0,1,0,1,0,1, 0,1,0,0,0,1, 0,1,1,1,1,1);
  Md012 : array[0..6 * 6 - 1] of Byte = (
    0,0,0,0,0,0, 0,1,1,1,1,1, 0,1,0,0,0,0,
    0,1,0,1,1,1, 0,0,0,0,0,1, 0,1,1,1,1,1);
  Md013 : array[0..6 * 6 - 1] of Byte = (       //3种变化，对应数据
    0,0,0,0,0,1, 0,1,1,1,1,1, 0,1,0,0,0,1,
    1,1,1,1,0,1, 0,0,0,0,0,1, 1,1,1,1,0,1);
  Md021 : array[0..6 * 6 - 1] of Byte = (
    0,0,0,0,0,0, 1,1,1,1,0,1, 0,0,0,0,0,1,
    1,1,1,1,0,1, 0,0,0,0,0,0, 0,1,1,1,1,1);
  Md022 : array[0..6 * 6 - 1] of Byte = (
    0,1,0,0,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1,
    0,1,0,1,0,1, 0,0,0,1,0,0, 1,1,0,1,0,1);
  Md023 : array[0..6 * 6 - 1] of Byte = (
    0,0,0,0,0,1, 0,1,1,1,1,1, 0,1,0,0,0,1,
    1,1,1,1,0,1, 0,0,0,1,0,0, 1,1,1,1,0,1);
  Md031 : array[0..6 * 6 - 1] of Byte = (
    0,1,0,0,0,0, 0,1,0,1,1,1, 0,0,0,0,0,1,
    0,1,0,1,0,1, 0,1,0,1,0,1, 1,1,0,1,0,1);
  Md032 : array[0..6 * 6 - 1] of Byte = (
    0,0,0,0,0,0, 0,1,1,1,0,1, 0,0,0,0,0,1,
    1,1,0,1,1,1, 0,0,0,0,0,1, 1,1,1,1,0,1);
  Md033 : array[0..6 * 6 - 1] of Byte = (
    0,1,0,1,0,1, 0,1,0,1,0,1, 0,0,0,0,0,1,
    0,1,1,1,1,1, 0,0,0,0,0,0, 1,1,0,1,1,1);

  Md041 : array[0..7 * 6 - 1] of Byte = (       //7*6方块
    0,1,0,0,0,0,0, 0,1,0,1,1,1,0, 0,1,0,1,0,0,0,
    0,1,0,1,1,1,1, 0,0,0,0,0,0,0, 1,1,0,1,1,1,0);
  Md042 : array[0..7 * 6 - 1] of Byte = (
    0,0,0,0,0,0,0, 1,1,1,1,1,1,0, 0,1,0,0,0,1,0,
    0,1,0,1,0,1,0, 0,0,0,1,0,0,0, 0,1,1,1,1,1,0);
  Md043 : array[0..7 * 6 - 1] of Byte = (
    0,1,0,0,0,0,0, 0,1,0,1,1,1,1, 0,1,0,0,0,0,0,
    0,1,1,1,1,1,0, 0,0,0,0,0,0,0, 0,1,1,1,0,1,1);
  Md051 : array[0..7 * 6 - 1] of Byte = (
    0,1,0,0,0,1,0, 0,1,0,1,0,1,0, 0,1,0,1,0,1,0,
    0,1,0,1,0,1,0, 0,0,0,1,0,0,0, 0,1,1,1,1,1,0);
  Md052 : array[0..7 * 6 - 1] of Byte = (
    0,1,0,0,0,0,0, 0,1,0,1,1,1,1, 0,1,0,0,0,0,0,
    0,1,1,1,1,1,0, 0,0,0,0,0,0,0, 0,1,1,1,0,1,1);
  Md053 : array[0..7 * 6 - 1] of Byte = (
    0,1,0,0,0,1,0, 0,1,0,1,0,1,0, 0,1,0,1,0,1,0,
    0,1,1,1,1,1,0, 0,0,0,0,0,0,0, 0,1,1,1,0,1,1);
  Md061 : array[0..7 * 7 - 1] of Byte = (       //7*7方块
    0,0,0,1,0,1,0, 1,1,0,1,0,1,0, 0,0,0,1,0,0,0,
    0,1,1,1,1,1,1, 0,0,0,0,0,0,0, 1,1,1,1,1,1,0, 0,0,0,0,0,0,0);
  Md062 : array[0..7 * 7 - 1] of Byte = (
    0,1,0,0,0,0,0, 0,1,1,1,1,1,0, 0,0,0,0,0,1,0,
    1,1,1,1,0,1,0, 0,0,0,0,0,1,0, 0,1,1,1,1,1,0, 0,1,0,0,0,0,0);
  Md063 : array[0..7 * 7 - 1] of Byte = (
    1,1,0,1,0,1,0, 0,1,1,1,1,1,0, 0,0,0,0,0,1,0,
    1,1,1,1,0,1,0, 0,0,0,0,0,1,0, 1,1,0,1,0,1,0, 0,1,0,0,0,0,0);
  Md071 : array[0..6 * 7 - 1] of Byte = (
    0,1,0,0,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1,
    0,1,0,1,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1, 0,0,0,1,0,0);
  Md072 : array[0..6 * 7 - 1] of Byte = (
    0,0,0,0,0,1, 0,1,1,1,1,1, 0,0,0,0,0,1,
    1,1,0,1,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1, 0,0,0,1,0,0);
  Md073 : array[0..6 * 7 - 1] of Byte = (
    0,0,0,1,0,1, 0,1,1,1,0,1, 0,0,0,0,0,1,
    1,1,1,1,0,1, 0,0,0,0,0,1, 1,1,1,0,1,1, 0,0,0,0,0,0);
  Md081 : array[0..6 * 7 - 1] of Byte = (
    0,0,0,0,0,0, 0,1,1,1,0,1, 0,0,0,1,0,1,
    1,1,0,1,1,1, 0,0,0,0,0,1, 1,1,1,1,0,1, 0,0,0,0,0,1);
  Md082 : array[0..6 * 7 - 1] of Byte = (
    0,0,0,0,0,0, 0,1,0,1,1,1, 0,1,0,0,0,1,
    1,1,1,1,0,1, 0,0,0,1,0,1, 0,1,0,1,0,1, 0,1,0,0,0,1);
  Md083 : array[0..6 * 7 - 1] of Byte = (
    0,1,0,0,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1,
    0,1,0,1,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1, 0,0,0,1,0,0);
  Md091 : array[0..6 * 7 - 1] of Byte = (
    0,0,0,0,0,1, 0,1,1,1,1,1, 0,1,0,0,0,1,
    0,1,1,1,0,1, 0,0,0,0,0,1, 0,1,1,1,1,1, 0,0,0,0,0,0);
  Md092 : array[0..6 * 7 - 1] of Byte = (
    0,0,0,1,0,1, 0,1,1,1,0,1, 0,0,0,0,0,1,
    1,1,1,1,0,1, 0,0,0,0,0,1, 1,1,1,0,1,1, 0,0,0,0,0,0);
  Md093 : array[0..6 * 7 - 1] of Byte = (
    0,0,0,0,0,0, 0,1,0,1,1,1, 0,1,0,0,0,1,
    1,1,1,1,0,1, 0,0,0,1,0,1, 0,1,0,1,0,1, 0,1,0,0,0,1);
  Md101 : array[0..6 * 6 - 1] of Byte = (
    0,1,0,0,0,0, 0,1,0,1,1,1, 0,1,0,1,0,1,
    1,1,0,1,0,1, 0,0,0,1,0,1, 0,1,1,1,0,1);
  Md102 : array[0..6 * 6 - 1] of Byte = (
    0,1,0,1,0,0, 0,1,0,1,0,1, 0,0,0,1,0,1,
    1,1,0,1,0,1, 0,0,0,0,0,1, 0,1,1,1,0,1);
  Md103 : array[0..6 * 6 - 1] of Byte = (
    0,1,0,1,1,1, 0,1,0,1,0,1, 0,1,0,1,0,1,
    1,1,0,1,0,1, 0,1,0,1,1,1, 1,1,1,1,1,1);
  Md111 : array[0..6 * 6 - 1] of Byte = (
    0,1,0,1,0,1, 0,1,0,1,0,1, 0,0,0,0,0,1,
    0,1,1,1,1,1, 0,0,0,0,0,0, 1,1,0,1,1,1);
  Md112 : array[0..6 * 6 - 1] of Byte = (
    0,0,0,0,0,1, 0,1,0,1,1,1, 0,1,0,0,0,1,
    0,1,1,1,0,1, 0,1,0,0,0,0, 1,1,1,1,1,1);
  Md113 : array[0..6 * 6 - 1] of Byte = (
    0,1,0,0,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1,
    0,1,0,1,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1);
  Md121 : array[0..6 * 6 - 1] of Byte = (
    0,0,0,0,0,1, 0,1,0,1,0,1, 0,1,0,1,0,1,
    1,1,0,1,0,1, 0,0,0,0,0,1, 1,1,1,1,1,1);
  Md122 : array[0..6 * 6 - 1] of Byte = (
    0,0,0,0,0,1, 0,1,1,1,1,1, 0,1,0,0,0,1,
    1,1,1,1,0,1, 0,0,0,0,0,1, 1,1,1,1,0,1);
  Md123 : array[0..6 * 6 - 1] of Byte = (
    0,1,0,1,0,1, 0,1,0,1,1,1, 0,1,0,1,0,1,
    0,1,0,1,0,1, 0,1,0,1,0,1, 1,1,0,1,0,1);


implementation

{$R *.dfm}

procedure TRei35.FormCreate(Sender: TObject);
begin
  Rei35.Canvas.CopyMode := cmSrcCopy;
  MakeBmap := TBitmap.Create;      //少写这句程序可以编译出来，但是运行显示错误
  MakeBmap.Width := Mwidth;
  MakeBmap.Height := Mheight;

  St := 1;
  Randomize;
end;

procedure TRei35.MkMaze;
begin     //12格随机选择图案

  case Random(3) of          //3种变化
   0:  MdMov(0,5,0,5,md011);
   1:  MdMov(0,5,0,5,md012);
   2:  MdMov(0,5,0,5,md013);
  end;
  case Random(3) of
   0:  MdMov(6,11,0,5,Md021);
   1:  MdMov(6,11,0,5,Md022);
   2:  MdMov(6,11,0,5,Md023);
  end;
  case Random(3) of
   0:  MdMov(12,17,0,5,Md031);
   1:  MdMov(12,17,0,5,Md032);
   2:  MdMov(12,17,0,5,Md033);
  end;
  case Random(3) of
   0:   MdMov(18,24,0,5,Md041);
   1:   MdMov(18,24,0,5,Md042);
   2:   MdMov(18,24,0,5,Md043);
  end;
  case Random(3) of
   0:  MdMov(18,24,6,11,Md051);
   1:  MdMov(18,24,6,11,Md052);
   2:  MdMov(18,24,6,11,Md053);
  end;
  case Random(3) of
   0:   MdMov(18,24,12,18,Md061);
   1:   MdMov(18,24,12,18,Md062);
   2:   MdMov(18,24,12,18,Md063);
  end;

  case Random(3) of
   0:  MdMov(12,17,12,18,Md071);
   1:  MdMov(12,17,12,18,Md072);
   2:  MdMov(12,17,12,18,Md073);
  end;
  case Random(3) of
   0:  MdMov(6,11,12,18,Md081);
   1:  MdMov(6,11,12,18,Md082);
   2:  MdMov(6,11,12,18,Md083);
  end;
  case Random(3) of
   0:   MdMov(0,5,12,18,Md091);
   1:   MdMov(0,5,12,18,Md092);
   2:   MdMov(0,5,12,18,Md093);
  end;
  case Random(3) of
   0:   MdMov(0,5,6,11,Md101);
   1:   MdMov(0,5,6,11,Md102);
   2:   MdMov(0,5,6,11,Md103);
  end;
  case Random(3) of
   0:  MdMov(6,11,6,11,Md111);
   1:  MdMov(6,11,6,11,Md112);
   2:  MdMov(6,11,6,11,Md113);
  end;
  case Random(3) of
   0:   MdMov(12,17,6,11,Md121);
   1:   MdMov(12,17,6,11,Md122);
   2:   MdMov(12,17,6,11,Md123);
  end;

end;

procedure TRei35.MdMov(n1,n2,m1,m2:Byte;Mdpon:array of Byte);
var
  x,y : Byte;
begin
  n := 0;
  for y := m1 to m2 do          //m1,m2 对应12大格Y格标
    for x := n1 to n2 do        //n1,n1对饮12格的X坐标
    begin
      Mdata[x,y] := Mdpon[n];     //搬运 预设数据
      n := n + 1;
    end;
end;

procedure TRei35.DiMaze;
var
  x,y : Byte;

begin
  for x := 0 to 24 do         //根据数据画出 16*16的黑格
    for y := 0 to 18 do
      begin
        if Mdata[x,y] = 0 then
          MakeBmap.Canvas.Brush.Color := clBlack
        else
          MakeBmap.Canvas.Brush.Color := clOlive;
        RectD := Rect(x * 16 + 16,y * 16 + 16,x * 16 + 32,y * 16 + 32);
        //RectD := Rect(x * 16 + 0,y * 16 + 0,x * 16 + 16,y * 16 + 16);  //0，0坐标绘制
        MakeBmap.Canvas.FillRect(RectD);
      end;
end;
procedure TRei35.Timer1Timer(Sender: TObject);
begin
  case St of
    1:begin                                        //画面初始化
      MakeBmap.Canvas.Brush.Color := clOlive;     //刷褐色 ，大一圈，形成边界图案
      RectD := Rect(0,0,Mwidth,Mheight);
      MakeBmap.Canvas.FillRect(RectD);
      MakeBmap.Canvas.Brush.Color := clBlack;     //刷黑色，
      RectD := Rect(16,16,Mwidth - 32,Mheight - 32);
      MakeBmap.Canvas.FillRect(RectD);
      Rei35.Canvas.Draw(0,0,MakeBmap);      //将制作好的图案画到界面上
      St := 2;
      end;
    2:begin
      MkMaze;                          //将制作好的图案画到界面上
      DiMaze;
      Rei35.Canvas.Draw(0,0,MakeBmap);
      St := 0;                         //绘制完成进入状态0，
    end;
  end;
end;

procedure TRei35.Button1Click(Sender: TObject);
begin
  St := 2;
end;

procedure TRei35.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MakeBmap.Free;
end;

end.

 

标签：12,end,..,Delphi,array,35,40,MdMov,Byte
From： https://www.cnblogs.com/D7mir/p/16826120.html

相关文章

  • HDU 3535 AreYouBusy
    题目链接：​​传送门​​题面：AreYouBusyProblemDescriptionHappyNewTerm!Ashavingbecomeajunior,xiaoArecognizesthatthereisnotmuchtimeforhertoAC......
  • ASEMI代理的安森美车规级mos管NVHL040N65S3F怎么选型
    编辑-Z随着车规级mos管的应用得到全面推广，在不同工作环境中广泛应用的普及，这导致生产加工行业受到发展的带动，各种不同类型的品种层出不穷，为了工作中具有强大的优势和特点，......
  • 周鸿祎谈程序员35岁就会被淘汰：越老越吃香
    作为程序员节的10月24日，360创始人周鸿祎通过个人微博发布相关内容，祝所有程序员节日快乐。视频中，周鸿祎表示，作为程序员，我一直都很骄傲。程序员是未来世界的架构师，是非常了不......
  • vue项目中使用axios获取本地json文件，报404错（已解决✔）
    vue项目中VueX的组件store里面有个actions的axiosget请求，请求本地的JSON文件的时候就报错404了。看了好久资料最终解决了。虽然刚开始的时候我已近把静态资源放在了pub......
  • HDU 4135 Co-prime
    题目链接：​​传送门​​多组数据问区间内与互质的数的个数区间问题显然要转化成两个区间相减的问题也就是的答案减去的答案这里反过来求不互质的数的个数筛法可以提示我......
  • POJ 3575(计算几何与二分-无尽的小数处理）
    这题写了将近半个月……总是在D各种Bug总的说来-这题最难应该是在精度处理上11001这组数据过了就说明精度处理差不多了……Programkingdom;constmaxn=100;maxm=10......
  • Python报错-UnicodeDecodeError: 'gbk' codec can't decode byte 0x81 in position 35
    问题描述：读文件报错  【代码】：withopen("D:\Code\Python\data.txt")asfile_object:contents=file_object.read()print(contents)【报错提示】：Trace......
  • 苹果14Pro Max拆解:AFEM-8240、SKY58853-17、SKY52628、SKY5xx92-16模块
    近期，iFixit对苹果最新iPhone14的拆解终于完成了，认为这次iPhone14最值得点赞的不是更强的处理器，也不是卫星SOS功能和更大的摄像头，而是完全重新设计的内部结构——显示面......
  • 洛谷 P3401
    甚么神仙题啊……#include<iostream>#include<vector>#include<cstdio>#include<cstring>#include<iterator>#include<utility>#defineintlonglongusin......
  • Solve CG FC200 E135 Device not activated
    SolveCGFC200E135Devicenotactivated   HowtoSolveCGFC200E135Devicenotactivated?HeresharesthesolutiontoresolveCGFC200Error‘E135:......

赞助商

阅读排行

网站主页关于我们联系我们网站地图

本网站内容转载自其他媒体，侵权联系[admin##ips99.com]。

Copyright © 2020-2023 IPS99 版权所有 IPS99