1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Плз,помогите кто-нить с задачкой!Вначале была задача слова в строке отсортировать по алфавиту и по колву букв.Это я сделала.Потом нада исх строу сохранить в текстовом файле - это я тож сделала.А потом нада список слов сохранит в файле..а как сделать из массива слов список слов??HELP ???
uses crt; type stroka=record clovo:string[80] end; fslov=file of stroka; arrslov=array[1..100] of stroka; arr=array[1..100]of string[80];
procedure enter(var s:string); {ввели строку} begin write('Vvedite stroky:');readln(s) end;
procedure save1(fn:string;s:string); {сохранили строку} var f:text;i:integer; begin assign(f,fn); rewrite(f); write(f,s); close(f); writeln('Save Is Done!!!') end;
procedure words(s:string;var y:arr;var k:integer); {разбили строку на слова и создали массив из слов} var i:integer;slovo:string; begin i:=1;k:=0; while i<=length(s) do begin slovo:=''; while (s[i] in ['A'..'Z'])or(s[i] in ['a'..'z']) do begin slovo:=slovo+s[i];i:=i+1;end; k:=k+1;y[k]:=slovo; while not((s[i] in ['A'..'Z'])or(s[i] in ['a'..'z']))do i:=i+1; end; end;
procedure save2(fn:string;y:arrslov;n:integer); {сохранили список слов} var f1:fslov;i:integer; begin assign(f1,fn); rewrite(f1); for i:=1 to n do write(f1,y[i]); close(f1); writeln('Save Is Done!!!') end;
procedure load1(fn:string;var s:string); {загрузили исх строку} var f:text; begin assign(f,fn);reset(f); while not eof(f) do begin read(f,s);end; close(f);end;
procedure sort(x:arr;nx:integer;var y:arr); {сортировка по колву букв} var i,j:integer;tmp:string; begin y:=x; for i:=1 to nx-1 do for j:=i+1 to nx do if length(y[i])>length(y[j]) then begin tmp:=y[i];y[i]:=y[j];y[j]:=tmp;end; end;
procedure sort2(x:arr;nx:integer;var y:arr); {сортировка по алфавиту} var i,j:integer;tmp:string; begin y:=x; for i:=1 to nx-1 do for j:=i+1 to nx do if y[i]>y[j] then begin tmp:=y[i];y[i]:=y[j];y[j]:=tmp;end; end;
procedure slova(x:arr;nx:integer); {вывод массива слов} var i:integer; begin for i:=1 to nx do write(x[i],#32) end;
procedure load2(fn:string;var z:arrslov;var n:integer); {загрузить список слов из файла} var f1:fslov; begin n:=0; assign(f1,fn);reset(f1); while not eof(f1) do begin read(f1,z[n+1]);n:=n+1 end; close(f1); end;
procedure vivod(z:arrslov;n:integer); {вывод списка слов} var i:integer; begin for i:=1 to n do writeln(z[i].clovo:10); end;
function fname:string; var s:STRING; begin write('Vvedi FileName:');readln(s); fname:=s end;
var my:string;n,k:integer;word,srtwrd:arr;flag:integer;slv:arrslov; begin textcolor(4); repeat clrscr; writeln('1-Vvod,2-Vivod,3-Save1,4-load1,'+ '5-slova,6-save2,7-load2,8-_sort,Esc-Quit');
case readkey of '1':enter(my); '2':writeln(my); '5':begin words(my,word,n); slova(word,n) end; '8':begin write('1-po kolvy bykv,0-po alfavity'); writeln('flag='); readln(flag); if flag=1 then begin sort(word,n,srtwrd);slova(srtwrd,n) end else begin sort2(word,n,srtwrd);slova(srtwrd,n) end; end; '3':save1(fname,my); '4':begin load1(fname,my); writeln(my)end; '6':save2(fname,slv,k); '7':begin load2(fname,slv,k);vivod(slv,k) end;