Форум «Всё о Паскале» _ Задачи _ задачка в текстовом режиме
Автор: kr3v3tkus 22.05.2006 23:31
вот такая задачка Разделить экран перегородкой по вертикали на полэкрана. Перегородка движется сама вверх и вниз. Двигать минимальный прямоугольник. как ни странно, несмотря на лёгкость не могу сделать ( чтото не так, когда перемещаешься на (80,25) начинается ахинея, да и когда полоска доходит до верха и низа тоге не фонтан, вощем плз укажите ошибку
Код
uses crt; var x, y, a, b: integer; ch : char;
procedure down (var x,y : integer); var i : integer; begin i := 12; gotoxy (x,y); textcolor (black); write ('Ы'); textcolor (white); while i <> 0 do begin gotoxy (x,y+i); write ('Ы'); dec(i); end; gotoxy (x,y); end;
procedure up (var x,y : integer); var i : integer; begin gotoxy (x,y); textcolor (white); for i := 1 to 12 do begin gotoxy (x,y+i); write ('Ы'); end; gotoxy(x,y+13); textcolor (black); write ('Ы'); gotoxy (x,y); end;
procedure pres (var a,b : integer; ch : char); var q, k: integer; begin case ch of #72 : if (b <> 1) then begin gotoxy(a,b); textcolor (black); write ('Ы'); textcolor (white); dec (b); gotoxy (a,b); write ('Ы'); gotoxy(a,b); end; #80 : if (b <> 25) then begin gotoxy(a,b); textcolor (black); write ('Ы'); textcolor (white); inc (b); gotoxy (a,b); write ('Ы'); gotoxy(a,b); end; #75 : if (a <> 1) then begin gotoxy(a,b); textcolor (black); write ('Ы'); textcolor (white); dec (a); gotoxy (a,b); write ('Ы'); gotoxy(a,b); end; #77 : if (a <> 80) then begin gotoxy(a,b); textcolor (black); write ('Ы'); textcolor (white); inc (a); gotoxy (a,b); write ('Ы'); gotoxy(a,b); end; end; end;
begin clrscr;
x := 40; y := 1; a := 25; b := 13;
repeat
repeat textcolor(white); gotoxy (a,b); write('Ы'); down (x,y); inc (y); if keypressed then begin ch := readkey; pres (a,b,ch); end; delay (55000); until y = 13;
repeat textcolor(white); gotoxy (a,b); write('Ы'); up (x,y); dec (y); if keypressed then begin ch := readkey; pres (a,b,ch); end; delay (55000); until y = 0;
until ch=#27;
end.
Автор: klem4 22.05.2006 23:39
Хм у меня твоя программа вообще ничего неделает (рисует перегородку и отделюную точку и все)
Объясни пожалуйста по подробней, по поводу перегородки я понял, она должна двигаться вверх - вниз, а вот вторая часть задания ?
Автор: klem4 23.05.2006 0:08
В общем вот набрасал быстренько ... если что я думаю подправишь сам, будут вопросы, спрашивай.
uses crt;
const
mx = 79; my = 24;
len = 5;
procedure ShowWall(p : integer); var i : integer; begin for i := p - len to p + len do begin GoToXY(mx div 2, i); writeln('|'); end; end;
var
centr, delta, nx, ny : integer;
ch : char;
begin
clrscr;
centr := my div 2;
delta := +1;
nx := 5; ny := 7;
repeat
while keypressed do ch := readkey;
case ch of 'w' : if ny > 1 then dec(ny); 's' : if ny < my then inc(ny); 'a' : if nx > 1 then dec(nx); 'd' : if nx < mx then inc(nx); end;
ShowWall(centr);
GoToXY(nx, ny);
writeln('*');
Delay(100);
Clrscr;
if (centr + len >= my) or (centr - len <= 0) then delta := - delta;
inc(centr, delta);
until ch = #27; readln; end.
Автор: kr3v3tkus 23.05.2006 1:50
klem4 тенкс , только вот никак нельзя без глюка в (80,25) ?
Автор: volvo 23.05.2006 2:22
А напрямую писать в видеопамять не хочешь попробовать? Тогда глюков с 80/25 точно не будет ...
Автор: APAL 23.05.2006 2:31
Цитата(kr3v3tkus @ 22.05.2006 22:50)
klem4 тенкс , только вот никак нельзя без глюка в (80,25) ?
Попробуй для вывода использовать видеопамять.
Код
Var Ma : Ekr absolute $B800:$0000; Type St80 = string[80]; Ekr = array[1..4000] of Byte; Procedure W(x,y : Byte; St : St80); Var is : Byte; Begin For is:=x to Length(St)+x-1 do Ma[2*is+(y-1)*160-1]:=Ord(St[is]); GoToXY(x+Length(St),y); End;