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

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

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

> Создание списка слов
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 3

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


Плз,помогите кто-нить с задачкой!Вначале была задача слова в строке отсортировать по алфавиту и по колву букв.Это я сделала.Потом нада исх строу сохранить в текстовом файле - это я тож сделала.А потом нада список слов сохранит в файле..а как сделать из массива слов список слов??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;

#27:exit;end;
readkey until false;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





- Текстовая версия 25.06.2022 17:22
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name