Помощь - Поиск - Пользователи - Календарь
Полная версия: окно? процедуры с ним и задача в окне!
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Ostin
вот как это было)

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

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.
volvo
Цитата
вот что у меня вышло! проверте!

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

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

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

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

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

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

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



.DOC файл вырезан. Читаем правила!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.