Помощь - Поиск - Пользователи - Календарь
Полная версия: Создание списка слов
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
annie
Плз,помогите кто-нить с задачкой!Вначале была задача слова в строке отсортировать по алфавиту и по колву букв.Это я сделала.Потом нада исх строу сохранить в текстовом файле - это я тож сделала.А потом нада список слов сохранит в файле..а как сделать из массива слов список слов??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.
DI
я вобщето не специалист,но зачем из массива слов делать список слов.Не лучше ли записывать в файл(текстовый) каждый элемент массива в цикле
var
arr:array[1..100]of string;
i:integer;
g2:text;
begin
assign(g2,'1.txt');
append(g2);
while i<=100 do
begin
writeln(g2,arr[i]);
flush(g2);
inc(i);
end;
end;

извиняюсь , что не просмотрел прогу,поэтому переменные бери свои.
AlaRic
Предупреждение: название темы "Помогите со списками" для меня равносильно "Помогите плиз"!
annie
Может так оно и лучше,но мне нада строку в текстовом файле..а потом строку представить ввиде списка, а список сохранить в виде файла компонента..задача такая..((
trminator
Пока что название темы изменил сам. В дальнейшем темы с подобными названиями будут закрываться! >:(
annie
sad.gifмлин,че,типа никто помочь не может?=(
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.