Генерация Лабиринтов

Тема в разделе "Visual Basic", создана пользователем Nik23, 12 апр 2009.

  1. Nik23

    Nik23 Гость

    Срочно нужен самый простой код программы Генерация лабиринтов на VB...Помогите пожалуйста
     
  2. Nik23

    Nik23 Гость

    кто нить может че нить подсказать??
     
  3. Jumpy

    Jumpy Гость

    А чего подсказывать ?)))
    Что такое лабиринт - не сказано, из чего его генерировать - не сказано. Какие у лабиринта должны быть оссобенности - не сказано ) Нет задачи - нет подсказки )

    самый простейший код - две линии на форме нарисоват с рандом координатами ) чем не лабиринт )
     
  4. Nik23

    Nik23 Гость

    Лабиринт может быть любой размерностью с 1 входом и 1 выходом и иметь 1 решение... в сети много информации но на вижуал бэйсик нету не одного кода
     
  5. alex77755

    alex77755 Well-Known Member

    Регистрация:
    15 фев 2009
    Сообщения:
    128
    Симпатии:
    0
    посмотри это
     

    Вложения:

    • 3DMAZE.ZIP
      Размер файла:
      18,6 КБ
      Просмотров:
      10
  6. Jumpy

    Jumpy Гость

    Гы, клевая штука ))) Но едва ли человеку поможет пример на 3500 строчек :)))))

    ВБ быстрее изучить, нежели понять чо там написано и как оно работает :)))

    по теме же:
    кода не дам, ибо нету.

    но самый простой алгоритм имхо такой:
    берем стартовую точку, чертим из нее "путь" (случайным образом) пока он не наткнется сам в себя (края внешние - огибаем)
    потом берем случайным образом любую точку на этом пути и опять чертим из нее путь ну итд пока не останется непройденных клеток.
     
  7. Nik23

    Nik23 Гость

    alex77755 спасибо но че то он больно большой попроще нет ничего? По идее он должегн быть гораздо проще...
     
  8. Zato

    Zato Гость

    Если нужен совсем простой способ, то попробуй создать массив, а потом случайным образом заполнять его единицами, по одной, проверяя возможно ли пройти от точки старта к точке финиша по единицам. Понятно, что 0-стенка 1-проход. Вот тебе простенький генератор лабиринтов. Могу выдать код на Purebasic, если надо.
     
  9. Nik23

    Nik23 Гость

    Zato> Во выложи пожалуйста буду очень благодарен
     
  10. Nik23

    Nik23 Гость

    Вот код на паскале довольно маленький вот тока перевести бы синтаксис на ВБ

    uses GraphABC;
    const
    szw=70;
    szh=50;
    cellsz=10;
    type
    point=record
    x,y: integer;
    end;
    var
    maze: array [0..szw-1] of array [0..szh-1] of integer;
    todo: array [0..szw*szh-1] of point;
    todonum: integer;
    const
    dx: array [0..3] of integer=(0, 0, -1, 1);
    dy: array [0..3] of integer=(-1, 1, 0, 0);
    procedure init;
    var
    x,y,n,d: integer;
    begin
    for x:=0 to szw-1 do
    for y:=0 to szh-1 do
    if (x=0) or (x=szw-1) or (y=0) or (y=szh-1) then
    maze[x][y]:=32
    else maze[x][y]:=63;
    Randomize;
    x := Random(szw-2)+1;
    y := Random(szh-2)+1;
    maze[x][y]:= maze[x][y] and not 48;
    for d:=0 to 3 do
    if (maze[x + dx[d]][y + dy[d]] and 16) <> 0 then
    begin
    todo[todonum].x:=x + dx[d];
    todo[todonum].y:=y + dy[d];
    Inc(todonum);
    maze[x + dx[d]][y + dy[d]] := maze[x + dx[d]][y + dy[d]] and not 16;
    end;
    while todonum > 0 do
    begin
    n:= Random(todonum);
    x:= todo[n].x;
    y:= todo[n].y;
    Dec(todonum);
    todo[n]:= todo[todonum];
    repeat
    d:=Random (4);
    until not ((maze[x + dx[d]][y + dy[d]] and 32) <> 0);
    maze[x][y] := maze[x][y] and not ((1 shl d) or 32);
    maze[x + dx[d]][y + dy[d]] := maze[x + dx[d]][y + dy[d]] and not (1 shl (d xor 1));
    for d:=0 to 3 do
    if (maze[x + dx[d]][y + dy[d]] and 16) <> 0 then
    begin
    todo[todonum].x := x + dx[d];
    todo[todonum].y := y + dy[d];
    Inc(todonum);
    maze[x + dx[d]][y + dy[d]] := maze[x + dx[d]][y + dy[d]] and not 16;
    end;
    end;
    maze[1][1] := maze[1][1] and not 1;
    maze[szw-2][szh-2] := maze[szw-2][szh-2] and not 2;
    end;
    procedure Draw;
    var x,y: integer;
    begin
    for x:=1 to szw-2 do
    for y:=1 to szh-2 do
    begin
    if ((maze[x][y] and 1) <> 0) then
    Line(x * cellsz, y * cellsz, x * cellsz + cellsz + 1, y * cellsz);
    if ((maze[x][y] and 2) <> 0) then
    Line(x * cellsz, y * cellsz + cellsz, x * cellsz + cellsz + 1, y * cellsz + cellsz);
    if ((maze[x][y] and 4) <> 0) then
    Line(x * cellsz, y * cellsz, x * cellsz, y * cellsz + cellsz + 1);
    if ((maze[x][y] and 8) <> 0) then
    Line(x * cellsz + cellsz, y * cellsz, x * cellsz + cellsz, y * cellsz + cellsz + 1);
    end;
    end;
    begin
    SetWindowCaption('Генерация лабиринта');
    init;
    draw;
    end.
     
  11. Nik23

    Nik23 Гость

    может кто-нибудь помоч???
     
Загрузка...
Похожие Темы - Генерация Лабиринтов
  1. lmike
    Ответов:
    3
    Просмотров:
    634
  2. framd
    Ответов:
    1
    Просмотров:
    783
  3. DamirAstana
    Ответов:
    11
    Просмотров:
    1.875
  4. Kee_Keekkenen
    Ответов:
    1
    Просмотров:
    1.295
  5. keepergf
    Ответов:
    0
    Просмотров:
    1.272

Поделиться этой страницей