IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> задачка в текстовом режиме, пожалуйста подправьте, завтра зачёт :)
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


вот такая задачка
Разделить экран перегородкой по вертикали на полэкрана. Перегородка движется сама вверх
и вниз. Двигать минимальный прямоугольник.
как ни странно, несмотря на лёгкость не могу сделать ( чтото не так, когда перемещаешься на (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.


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


Хм у меня твоя программа вообще ничего неделает (рисует перегородку и отделюную точку и все)

Объясни пожалуйста по подробней, по поводу перегородки я понял, она должна двигаться вверх - вниз, а вот вторая часть задания ?


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


В общем вот набрасал быстренько ... если что я думаю подправишь сам, будут вопросы, спрашивай.

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.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Пионер
**

Группа: Пользователи
Сообщений: 111
Пол: Мужской
Реальное имя: Рома

Репутация: -  0  +


klem4 тенкс good.gif , только вот никак нельзя без глюка в (80,25) ?


--------------------
Цитата
          .     .
           \__/
          (**)
(>:=:=:~~ 
  ^ ^ ^ ^ 

Креветка присваивания :DDD
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






А напрямую писать в видеопамять не хочешь попробовать? smile.gif
Тогда глюков с 80/25 точно не будет ...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Смотрю...
*****

Группа: Пользователи
Сообщений: 1 055
Пол: Мужской
Реальное имя: Пшеничный Алексей Анатольевич

Репутация: -  6  +


Цитата(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, как обычно - опередил... ;)

Сообщение отредактировано: APAL -


--------------------
Если что-то не делает того, что вы запланировали ему делать - это еще не означает, что оно бесполезно.
--------------------
Прежде, чем задать вопрос - Правила :: FAQ :: Поиск
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 23.10.2017 0:32
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"