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

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

  1. Nik23

    Nik23 Гость

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

    Nik23 Гость

    Репутация:
    0
    кто нить может че нить подсказать??
     
  3. Jumpy

    Jumpy Гость

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

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

    Nik23 Гость

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

    alex77755 Well-Known Member

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

    Вложения:

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

    Jumpy Гость

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

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

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

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

    Nik23 Гость

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

    Zato Гость

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

    Nik23 Гость

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

    Nik23 Гость

    Репутация:
    0
    Вот код на паскале довольно маленький вот тока перевести бы синтаксис на ВБ

    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 Гость

    Репутация:
    0
    может кто-нибудь помоч???
     
Загрузка...

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