|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
18.12.2008, 21:35 | #1 |
Регистрация: 18.12.2008
Сообщений: 4
|
Народ Помогите плиз Срочно Сделаете блок схему
Unit lol;
interface procedure sort_file(var f:text; r:boolean); implementation procedure sort_file; var f1,f2:text;b1,b2,b,s:string;i,i1,i2 ,p:boolean; k:integer; function moreless(x,y:string; ort:boolean):boolean; begin if ort=true then moreless:=(x<y) else moreless:=(x>=y); end; procedure readstr(var t:text; var buf:string; var big:boolean); var s:string; begin s:=buf; readln(t,buf); if buf=s then big:=false else big:=moreless(buf,s,r); end; procedure writestr(var t:text; buf:string; var int:boolean); begin if not int then writeln(f,buf); if EOF(t) then int:=true; end; begin{sort_file} ASSIGN(f1,'1.txt'); ASSIGN(f2,'2.txt'); repeat reset(f); rewrite(f1); rewrite(f2); k:=1; readln(f,b); writeln(f1,b); while not EOF(f) do begin readstr(f,b,i); if i then k:=k+1; if (odd(k)) then writeln(f1,b) else writeln(f2,b);end; p:=r; i1:=false; i2:=false; if k>1 then begin rewrite(f); reset(f1); reset(f2); readln(f1,b1); readln(f2,b2); if moreless(b1,b2,p) then writestr(f1,b1,i1) else writestr( f2,b2,i2); repeat if moreless(b1,b2,p) then if not EOF(f1) then begin readstr(f1,b1,i1); if i1 then p:=not p; i1:=false; end else if not EOF(f2) then begin readstr(f2,b2,i2); if i2 then p:=not p; i2:=false; end else p:=not p; if moreless(b1,b2,p) then writestr(f1,b1,i1) else writestr(f2,b2,i2) until (i1 and i2); end until (k<=2); close(f); close(f1);close(f2); erase(f1); erase(f2); end;end. Program kursa4; uses crt,lol,printer; var f:text; nm,a:string; r:boolean; s,l,i:integer; begin clrscr; writeln('wwedi put k failu'); readln(nm); ASSIGN(f,nm); {$I-}RESET(f);{$I+} if IOResult<>0 then begin sort_file(f,r); RESET(f); l:=1; writeln(l); for i:=255 downto 1 do begin while not EOF(f) do begin readln(f,a); if copy(a,length(a),1)=' ' then begin repeat delete(a,length(a),1); until copy(a,length(a),1)<>' '; end; if i=length(a) then begin writeln(lst,a); inc(s); if s=60 then begin inc(l); writeln(l); s:=0; end; end; end; end;, close(f); readln; end; end. |
18.12.2008, 23:56 | #2 |
Регистрация: 18.12.2008
Сообщений: 4
|
Сама задача звучит так:Использовать процедуру sort_File,составить программу сортировки текстового файла с размещением строк в пределах каждой странице в алфовитном порядке по последниему слову строки.
|
19.12.2008, 22:10 | #3 |
Регистрация: 18.12.2008
Сообщений: 4
|
Ну народ помогите плиз
|
19.12.2008, 22:32 | #4 |
Пользователь
Регистрация: 17.12.2008
Сообщений: 51
|
Кроч есть такая прога которая сама блок-схемы ресует!!!!!!
поищи в нете!!!
Mega HiP-Hop--- http://muzxclusive.com/
|
Опции темы | Поиск в этой теме |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Помогите составить блок-схему | pymba | Помощь студентам | 6 | 20.12.2008 22:34 |
Помогите!Проверьте плиз блок-схему | ykcyc | Помощь студентам | 1 | 06.12.2008 17:54 |
помогите составить блок схему | zaq2000 | Паскаль, Turbo Pascal, PascalABC.NET | 5 | 04.12.2008 12:41 |
[срочно] нарисовать блок схему | masima | Фриланс | 3 | 29.05.2008 13:34 |