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

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

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

 
 Ответить  Открыть новую тему 
> окно? процедуры с ним и задача в окне!, я уже создавал такую тему но возникли не понятки!
сообщение
Сообщение #1


Пионер
**

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

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


вот как это было)

вот что у меня вышло! проверте!
Код

program notepad;
{$i-}
uses crt;
const
x1:byte=1;
y1:byte=3;
x2:byte=80;
y2:byte=48;

var i,j:byte;
    sizeX,sizeY:byte;
    n,k,l,w,x,y,e,q: byte;
    tmp: string[200];
    st: array [1..10] of string[20];
    m: set of #32..#122;
    tmp_arr: array [1..10] of string[20];
    buf: array [1..4] of byte;
    ch: char;
    pr:byte;


procedure scrol2;
begin
      if (n<=(y2-y1-1)) then
       for i:=k to n do
       begin
       if i>(n-q) then  textcolor(10)
       else textcolor(yellow);
      if (Length(st[i])<(x2-x1)) then
        for j:=l to Length(st[i]) do write (st[i,j])
       else
       if (l<=(20-x2+x1)) then
        for j:=l to (x2-x1-1+l) do write (st[i,j])
        else for j:=l to Length(st[i]) do write (st[i,j]);
        writeln;
       end
      else
      for i:=k to (y2-y1-1+k) do
       begin
       if i>(n-q) then  textcolor(10)
       else textcolor(yellow);
       if (Length(st[i])<(x2-x1)) then
        for j:=l to Length(st[i]) do write (st[i,j])
       else
        if (l<=(20-x2+x1)) then
        for j:=l to (x2-x1-1+l) do write (st[i,j])
        else for j:=l to Length(st[i]) do write (st[i,j]);
        writeln;
       end;
end;

procedure scrol;
begin
repeat
  repeat
   ch:=readkey;
  until (ch=#72){^} or (ch=#80) or (ch=#75){<} or (ch=#77){>} or (ch=#13) or (ch=#27);

case ch of
#72:begin
     clrscr;
     if (k>1) then
      dec(k);
      scrol2;
   end;

#80:begin
      clrscr;
      if (k<=n) then
      inc(k);
      scrol2;
  end;

#75:begin
     clrscr;
     if (l>1) then
     dec(l);
     scrol2;
end;

#77:  begin
  if (l<=20) then
  inc (l);
   clrscr;
     scrol2;
  end;
end
until (ch=#27) or (ch=#13);
end;

procedure size;
begin
repeat

  repeat
   ch:=readkey;
  until (ch=#72){^} or (ch=#80) or (ch=#75){<} or (ch=#77){>} or (ch=#13) or (ch=#27);

  if (ch<>#13) then
  begin
   window (1,1,80,50);
   textbackground (0);
   clrscr;
   textcolor (15);
   write ('izmenenie okna:');
   gotoxy (1,50);
   write ('і<',#027'>',' <',#026,'>',' <',#025,'>',' <',#024,'> : ypravlenie і <Esc> - exit і <Enter> - zavershit''');
  end;

case ch of
#72:begin
  if ((y2-y1)>=4) then
   if (y2>=6) then
    begin
      if ((y2-y1)<>4) then
     if (y2<>6) then
      dec(y2);
      window (x1,y1,x2,y2);
      textbackground (blue);
      clrscr;
      textcolor (yellow);
      scrol2;
      end;
end;

#80:begin
  if (y2<=48) then
   begin
    if (y2<>48) then
      inc(y2);
      window (x1,y1,x2,y2);
      textbackground (blue);
      clrscr;
      textcolor (yellow);
      scrol2;
   end;
  end;

#75:begin
   if ((x2-x1)>=6) then
  if (x2>=7) then
   begin
    if ((x2-x1)<>6) then
    if (x2<>7) then
     dec(x2);
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
     scrol2;
   end;
  end;

#77:begin
    if (x2<=80) then
     begin
     if (x2<>80) then
      inc (x2);
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
      scrol2;
    end;
   end;
   end
until (ch=#13) or (ch=#27);
end;

procedure move;
begin
repeat

  repeat
   ch:=readkey;
  until (ch=#72){^} or (ch=#80) or (ch=#75){<} or (ch=#77){>} or (ch=#13) or (ch=#27);

  if (ch<>#13) then
  begin
   window (1,1,80,50);
   textbackground (0);
   clrscr;
   textcolor (15);
   write ('moving:');
   gotoxy (1,50);
   write ('і<',#027'>',' <',#026,'>',' <',#025,'>',' <',#024,'> : ypravlenie і <Esc> - exit і <Enter> - zavershit''');
  end;

case ch of
#72:begin
  if (y1>=2) then
  if (y2>6) then
    begin
    if (y1<>2) then
    if (sizeY>(y2-y1)) then
     dec(y1)
    else
      begin
       dec(y1);
       dec(y2);
      end;
     end;
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
    scrol2;
end;

#80:begin
  if (y1<=44) then
   if (y2<=48) then
    begin
     if (y1<>44) then
      inc(y1);
     if (y2<>48) then
      inc(y2);
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
      scrol2;
    end
   else
    begin
      inc(y1);
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
     scrol2;
    end;
  end;

#75:begin
  if (x2>=7) then
  if (x1>1) then
   begin
   if (x2<>7) then
   if (sizeX>(x2-x1)) then
    dec (x1)
   else
    begin
     dec(x1);
     dec(x2);
    end;
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
    scrol2;
  end
  else
   begin
     if (x2<>7) then
     dec(x2);
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
     if (x2<>7) then
     inc (l);
     scrol2;
   end;
  end;

#77:begin
  if (x1<=74) then
  if (x2<80) then
   begin
    if (x1<>74) then
     if (sizeX>(x2-x1)) then
     inc(x2)
     else
      begin
      inc (x1);
      inc (x2);
      end;
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
    if (x1=1) then
     begin
      if (x2<>8) then
      if (l>1) then
      dec(l);
      scrol2;
     end
    else
    scrol2;
   end
   else
    begin
     if (x1<>74) then
     inc (x1);
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
     scrol2;
    end
  end;
end
until (ch=#13) or (ch=#27);
end;

procedure text_sort;
begin
  textcolor(10);
  writeln;
  w:=1;
  tmp:='';
  q:=1;
  for i:=1 to n do
  for j:=1 to length(st[i]) do
   if st[i,j]<>#32 then
    begin
      tmp:=tmp+st[i,j];
      inc(w);
     end
    else
    begin
      if tmp[1] = tmp[length(tmp)] then
      if length(tmp)>1 then
      begin
      tmp_arr[q]:=tmp_arr[q]+tmp;
      inc(q);
      writeln(tmp);
      end;
     tmp:='';
    end;
    st[n+1]:='';
    for i:=1 to q do
    st[n+i+1]:=tmp_arr[i];
    n:=n+q;
    textcolor(15);
end;

procedure text_ins;
begin
      for i:=1 to n do
      begin
      st[i]:=''; ch:=#0; j:=1;
       while (j<=20) and (ch<>#13) do
       begin
       pr:=1;
       ch:=readkey;
       if (ch=#0) then
       begin
       ch:=readkey;
       pr:=pr+1;
       end;
       if pr=1 then
       begin
        if ch in m then
         begin
          st[i]:=st[i]+ch;
          write (ch);
          inc (j);
         end;
        if (ch=#8) then
         begin
         if (j>1) then
          begin
          dec (j);
          delete(st[i],j,1);
          end
         else
          if (i>1) then
          begin
           delete(st[i],j,1);
           if (st[i]='') then
           delline;
           dec(i);
           j:=20;
           delete(st[i],j,1);
          end;
          gotoxy(j,i);
          clreol;
          x:=wherex;
          y:=wherey;
          for e:=j to length(st[i]) do
          write (st[i,e]);
          gotoxy(x,y);
         end;
        if (ch=#27) then halt;
        end;
        end;
       writeln;
    end;
end;

begin
      textbackground (0);
      textcolor (15);
      clrscr;
      settextbuf (input,buf);
       repeat
        write ('vvedite chislo strok:  ');
        readln (n);
        gotoxy (1,1);
        clreol;
       until (ioresult=0) and ((n>=1) and (n<=10));
      write ('vvedite stroki');
      gotoxy(1,50);
      write ('і<Backspase> - delete simbol і <Esc> - exit');
      w:=0; k:=1; l:=1;
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
       m:=[#32,#65..#90,#97..#122];
      text_ins;
  window (1,1,80,50);
  textbackground (0);
  textcolor (15);
  write ('vivesti slova gde 1 i poslednaya bykvi odinakovie?');
  gotoxy (1,50);
  delline;
  write ('<Y>: da і <N>: net і <Esc> - exit');
  window(x1,y1,x2,y2);
  textcolor(yellow);
  textbackground(blue);
  gotoxy(1,n+1);
   repeat
    ch:=readkey;
   until (ch='y') or (ch='Y') or (ch='n') or (ch='N') or (ch=#27);
   if (ch=#27) then halt
   else
   if ((ch='y') or (ch='Y')) then text_sort;

repeat
  window (1,1,80,50);
  textbackground (0);
  textcolor (15);
  clreol;
  write ('viberete rezim');
  gotoxy (1,50);
  clreol;
  write ('<1>: izmenenie okna і <2>: scrolling і <3>: move window і <Esc> - exit');
   repeat
    ch:=readkey;
    if (ch=#0) then ch:=readkey;
   until (ch='1') or (ch='2') or (ch='3') or (ch=#27);

case ch of
'1': begin
  textbackground (0);
  textcolor (15);
  window (1,1,80,50);
      gotoxy (1,50);
      clreol;
      write ('і<',#027'>',' <',#026,'>',' <',#025,'>',' <',#024,'> : ypravlenie і <Esc> - exit і <Enter> - zavershit''');
      gotoxy (1,1);
      clreol;
      write ('izmenenie okna:');
      sizeX:=x2-x1;
      sizeY:=y2-y1;
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
      scrol2;
      size;
     end;
'2': begin
  textbackground (0);
  textcolor (15);
  window (1,1,80,50);
      gotoxy (1,50);
      clreol;
      write ('і<',#027'>',' <',#026,'>',' <',#025,'>',' <',#024,'> : ypravlenie і <Esc> - exit і <Enter> - zavershit''');
      gotoxy (1,1);
      clreol;
      write ('scrolling:');
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
      scrol2;
      scrol;
     end;
'3': begin
      gotoxy (1,50);
      clreol;
      write ('і<',#027'>',' <',#026,'>',' <',#025,'>',' <',#024,'> : ypravlenie і <Esc> - exit і <Enter> - zavershit''');
      gotoxy (1,1);
      clreol;
      write ('moving:');
      sizeX:=x2-x1;
      sizeY:=y2-y1;
     window (x1,y1,x2,y2);
     textbackground (blue);
     clrscr;
     textcolor (yellow);
      scrol2;
      move;
     end;
end;
until (ch=#27);
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Цитата
вот что у меня вышло! проверте!

Ты что, в армии? Приказы раздаешь налево и направо? Тебе надо, ты и проверяй! Тем более, что в той теме, ты так и не объяснил толком, что тебе надо, а только хамил...

P.S. Не обольщайся, что с тебя сняли премод...

P.P.S.
У тебя происходит изменение переменной цикла внутри самого цикла (где именно - ищи сам...) Результатам этого цикла в таком случае веры нет, потому что так делать НЕЛЬЗЯ (то, что Турбо Паскаль это делать позволяет - еще ничего не значит...)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Пионер
**

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

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


ну простите простите! я больше не буду! забыл добавить ПОЖАЛУЙСТА!))))

это был не приказ! а просьба))))

это был не приказ! а просьба))))
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Кстати, ты работаешь (насколько я вижу - чисто теоретически, ибо откомпилировать твою программу НОРМАЛЬНЫМИ средствами я не могу, а Турбо-Паскаль запускать лень) с консолью размером 80х50? А с чего ты решил, что такая консоль у всех по-умолчанию? А если по умолчанию 80х25? Твоя программа просто перековеркает весь вывод... Неплохо было бы УСТАНОВИТЬ 80х50...

Это первое... Второе: ты бы как-то структурировал программу... У тебя однотипных действий много разбросано по программе. Выдели их в отдельные процедуры/функции; таким образом твою программу можно сократить... мммм... ну, скажем в 3 раза (это первое приближение, возможно - и в 5 тоже можно).

Еще одно. Я бы все-таки не делал то, что сделал ты в первых же строках кода: {$i-} ГЛОБАЛЬНО? Ни в коем случае. Контроль ошибок ввода вывода обычно отключается только там, где эти ошибки могут возникнуть, и там же ставится IOResult... У тебя же ВСЕГДА ошибки ввода-вывода будут просто замалчиваться. А это не добавляет надежности программе...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Пионер
**

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

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


отчет по задаче! задача сделана не очень хорошо, блок схема ей соответствует! но всеже может кому понадобится чтоб все не делать! я прокатил с таким отчетом(препод нашол ошибки но я их ручеой исправлял!)



.DOC файл вырезан. Читаем правила!

Сообщение отредактировано: APAL -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 




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