Помощь - Поиск - Пользователи - Календарь
Полная версия: задачка в текстовом режиме
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
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 тенкс good.gif , только вот никак нельзя без глюка в (80,25) ?
volvo
23.05.2006 2:22
А напрямую писать в видеопамять не хочешь попробовать? smile.gif
Тогда глюков с 80/25 точно не будет ...
APAL
23.05.2006 2:31
Цитата(kr3v3tkus @ 22.05.2006 22:50) *

klem4 тенкс good.gif , только вот никак нельзя без глюка в (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;




P.S.: Volvo, как обычно - опередил... ;)
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.