![]() |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
![]() ![]() |
![]() |
Ostin |
![]()
Сообщение
#1
|
![]() Пионер ![]() ![]() Группа: Пользователи Сообщений: 52 Пол: Мужской Реальное имя: Стас Репутация: ![]() ![]() ![]() |
вот как это было)
вот что у меня вышло! проверте! Код 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 |
![]()
Сообщение
#2
|
Гость ![]() |
Цитата вот что у меня вышло! проверте! Ты что, в армии? Приказы раздаешь налево и направо? Тебе надо, ты и проверяй! Тем более, что в той теме, ты так и не объяснил толком, что тебе надо, а только хамил... P.S. Не обольщайся, что с тебя сняли премод... P.P.S. У тебя происходит изменение переменной цикла внутри самого цикла (где именно - ищи сам...) Результатам этого цикла в таком случае веры нет, потому что так делать НЕЛЬЗЯ (то, что Турбо Паскаль это делать позволяет - еще ничего не значит...) |
Ostin |
![]()
Сообщение
#3
|
![]() Пионер ![]() ![]() Группа: Пользователи Сообщений: 52 Пол: Мужской Реальное имя: Стас Репутация: ![]() ![]() ![]() |
ну простите простите! я больше не буду! забыл добавить ПОЖАЛУЙСТА!))))
это был не приказ! а просьба)))) это был не приказ! а просьба)))) |
volvo |
![]()
Сообщение
#4
|
Гость ![]() |
Кстати, ты работаешь (насколько я вижу - чисто теоретически, ибо откомпилировать твою программу НОРМАЛЬНЫМИ средствами я не могу, а Турбо-Паскаль запускать лень) с консолью размером 80х50? А с чего ты решил, что такая консоль у всех по-умолчанию? А если по умолчанию 80х25? Твоя программа просто перековеркает весь вывод... Неплохо было бы УСТАНОВИТЬ 80х50...
Это первое... Второе: ты бы как-то структурировал программу... У тебя однотипных действий много разбросано по программе. Выдели их в отдельные процедуры/функции; таким образом твою программу можно сократить... мммм... ну, скажем в 3 раза (это первое приближение, возможно - и в 5 тоже можно). Еще одно. Я бы все-таки не делал то, что сделал ты в первых же строках кода: {$i-} ГЛОБАЛЬНО? Ни в коем случае. Контроль ошибок ввода вывода обычно отключается только там, где эти ошибки могут возникнуть, и там же ставится IOResult... У тебя же ВСЕГДА ошибки ввода-вывода будут просто замалчиваться. А это не добавляет надежности программе... |
Ostin |
![]()
Сообщение
#5
|
![]() Пионер ![]() ![]() Группа: Пользователи Сообщений: 52 Пол: Мужской Реальное имя: Стас Репутация: ![]() ![]() ![]() |
отчет по задаче! задача сделана не очень хорошо, блок схема ей соответствует! но всеже может кому понадобится чтоб все не делать! я прокатил с таким отчетом(препод нашол ошибки но я их ручеой исправлял!)
.DOC файл вырезан. Читаем правила! Сообщение отредактировано: APAL - 25.04.2006 20:04 |
![]() ![]() |
![]() |
Текстовая версия | 20.07.2025 4:09 |