В задаче по массиву-лабиринту передвигается человек в виде циферки. А можно ли как то сделать так, чтобы именно рисунок человечка передвигался в нем, т.е. что-то нарисованное, а не простая цифра? Если можно, то примерно как это реализовать?
Можно, отрисовывать фигуру относительно базовой точки, проверяя условие выхода за границы массива.
подозреваю, что сделать это нужно в текстовом режиме.
Если так, то придется перепрограммировать знакогенератор... вечером посмотрю как это делается...
Вот накатал
Управление
w - up
s - down
a - left
d - right
escape - exit
uses crt;
const
FIELD_SIZE = 20;
type
TField = array [1..FIELD_SIZE, 1..FIELD_SIZE] of byte;
TMan = object
public
constructor Init;
destructor Done;
function CanMove(dRow, dCol : integer) : boolean;
procedure Move(dRow, dCol : integer);
procedure Show;
private
row, col : integer;
coords : array [0..7] of record row, col : byte; end;
end;
constructor TMan.Init;
begin
row := FIELD_SIZE div 2;
col := row;
Move(0, 0);
end;
destructor TMan.Done;
begin
end;
function TMan.CanMove(dRow, dCol : integer) : boolean;
var
stop : boolean;
begin
row := row + dRow;
col := col + dCol;
// столкновение с "бортами" возможно в 4-х точках, проверим их
stop := false;
stop := ((row - 1) < 1);
if not stop then stop := ((row + 3) > FIELD_SIZE);
if not stop then stop := ((col - 1) < 1);
if not stop then stop := ((col + 1) > FIELD_SIZE);
if stop then begin
row := row - dRow;
col := col - dCol;
end;
CanMove := not stop;
end;
procedure TMan.Move(dRow, dCol : integer);
begin
coords[0].row := row;
coords[0].col := col;
coords[1].row := row - 1;
coords[1].col := col;
coords[2].row := row;
coords[2].col := col - 1;
coords[3].row := row;
coords[3].col := col + 1;
coords[4].row := row + 1;
coords[4].col := col;
coords[5].row := row + 2;
coords[5].col := col;
coords[6].row := row + 3;
coords[6].col := col - 1;
coords[7].row := row + 3;
coords[7].col := col + 1
end;
procedure TMan.Show;
begin
end;
procedure PrintField(f : TField; m : TMan);
var
i, j : byte;
begin
FillChar(f, sizeof(f), 0);
with m do begin
for i := 1 to 7 do
with coords[i] do
f[row, col] := 1;
end;
for i := 1 to FIELD_SIZE do begin
writeln;
for j := 1 to FIELD_SIZE do begin
case f[i,j] of
0 : TextColor(White);
1 : TextColor(Blue);
end;
write(f[i,j] : 2);
end;
end;
end;
var
man : TMan;
field : TField;
ch : char;
dr, dc : integer;
begin
Clrscr;
man.Init;
repeat
dr := 0;
dc := 0;
clrscr;
PrintField(field, man);
ch := readkey;
case ch of
'w' : begin dr := -1; dc := 0; end;
's' : begin dr := +1; dc := 0; end;
'a' : begin dc := -1; dr := 0; end;
'd' : begin dc := +1; dr := 0; end;
end;
if man.CanMove(dr, dc) then man.Move(dr, dc);
until ch = #27;
man.Done;
end.
спасибо, будем разбираться с объектами=) жалко, что разрешение экрана маленькое и шрифт большой, а то в самый раз бы.
вот... нашел на винте, авторство не мое:
font_change.rar ( 2.05 килобайт )
Кол-во скачиваний: 425
использование:
uses crt,tpVfont;
var m:array [1..16] of byte;
i:byte;
begin
for i:=1 to 16 do m[i]:=i;
changeSymbol(100,16,@m);
write(#100);
readkey;
end.
textmode(co40);
m[1]:=56;
m[2]:=56;
m[3]:=16;
m[4]:=60;
m[5]:=84;
m[6]:=84;
m[7]:=84;
m[8]:=16;
m[9]:=16;
m[10]:=56;
m[11]:=40;
m[12]:=40;
m[13]:=40;
m[14]:=40;
m[15]:=40;
m[16]:=40;
спасибо. Буду разбираться.