var
Form1: TForm1;
f,f2,f3,f4: TextFile;
dan,dan2,dan3,dan4,d1,d2,d3,d4,str1,str2: string;
danik,slv: boolean;
i,ster,id2,id3,str:integer;
mem1,mem2,mem3,mem4:array of String;
procedure TForm1.MoyaFuncia;
begin
AssignFile(f,'book.txt');
Reset(f);
i:=0;
while not eof(f)=true do begin
readln(f,dan);
i:=i+1;
end;
CloseFile(f);
AssignFile(f,'book.txt');
AssignFile(f2,'book2.txt');
AssignFile(f3,'book3.txt');
AssignFile(f4,'book4.txt');
Reset(f);
Reset(f2);
Reset(f3);
Reset(f4);
Memo1.Clear;
Memo2.Clear;
Memo3.Clear;
Memo4.Clear;
SetLength(mem1,i); // Распределение памяти
SetLength(mem2,i); // для
SetLength(mem3,i); // массивов
SetLength(mem4,i); //
for str:=0 to i-1 do begin
readln(f,dan);
readln(f2,dan2);
readln(f3,dan3);
readln(f4,dan4);
mem1[str]:=dan;
mem2[str]:=dan2;
mem3[str]:=dan3;
mem4[str]:=dan4;
end;
CloseFile(f);
CloseFile(f2);
CloseFile(f3);
CloseFile(f4);
// Сортировка
for id2:=0 to i-1 do begin
for id3:=id2+1 to i-1 do begin
str1:=copy(mem1[id2],1,1);
str2:=copy(mem1[id3],1,1);
if str1>str2 then begin
d1:=mem1[id2];
d2:=mem2[id2];
d3:=mem3[id2];
d4:=mem4[id2];
mem1[id2]:=mem1[id3];
mem2[id2]:=mem2[id3];
mem3[id2]:=mem3[id3];
mem4[id2]:=mem4[id3];
mem1[id3]:=d1;
mem2[id3]:=d2;
mem3[id3]:=d3;
mem4[id3]:=d4;
slv:=True;
end;
end;
end;
AssignFile(f,'book.txt');
AssignFile(f2,'book2.txt');
AssignFile(f3,'book3.txt');
AssignFile(f4,'book4.txt');
Rewrite(f);
Rewrite(f2);
Rewrite(f3);
Rewrite(f4);
for id2:=0 to i-1 do begin
writeln(f,mem1[id2]);
writeln(f2,mem2[id2]);
writeln(f3,mem3[id2]);
writeln(f4,mem4[id2]);
end;
CloseFile(f);
CloseFile(f2);
CloseFile(f3);
CloseFile(f4);
AssignFile(f,'book.txt');
AssignFile(f2,'book2.txt');
AssignFile(f3,'book3.txt');
AssignFile(f4,'book4.txt');
Reset(f);
Reset(f2);
Reset(f3);
Reset(f4);
i:=1;
while not eof(f)=true do begin
readln(f,dan);
readln(f2,dan2);
readln(f3,dan3);
readln(f4,dan4);
Memo1.Lines.Add('#'+IntToStr(i)+' '+dan);
Memo2.Lines.Add(dan2);
Memo3.Lines.Add(dan3);
Memo4.Lines.Add(dan4);
i:=i+1;
end;
CloseFile(f);
CloseFile(f2);
CloseFile(f3);
CloseFile(f4);
end;
Упорядочивание слов по алфавиту
Добрый вечер. Дана функция, которая должна упорядочивать при создании формы фамилии в файле bokok.txt по первой букве. Где то ошибка, сортируются неправильно. Подскажите пожалуйста где ошибка, и, если есть возможность дополните код чтобы фамилии сортировались по алфавиту( не по первой букве, а по алфавиту полностью) Мои готовии исходники стерли, и за неимением времени для восстановления прошу помощи тут. Место, где происходит само сравнение букв пометил комментарием.
вот тебе то что я понял из твоего прошения:
Код:
var f1:textfile;
mas:array[0..100]of string;
i,k,size:integer;
change:boolean;
m:string;
begin
assignfile(f1,'book.txt');
reset(f1);
i:=0;
repeat
inc(i);
readln(f1,mas);
until eof(f1);
closefile(f1);
size:=i;
//dalee sortirovka obmenom
repeat
change:=false;
for k:=1 to size-1 do begin
if ord(mas[k][1])>ord(mas[k+1][1]) then
begin
m:=mas[k];
mas[k]:=mas[k+1];
mas[k+1]:=m;
change:=true;
end;
end;
until not change;
for i:=1 to size do memo1.Lines.add(mas);
end;
mas:array[0..100]of string;
i,k,size:integer;
change:boolean;
m:string;
begin
assignfile(f1,'book.txt');
reset(f1);
i:=0;
repeat
inc(i);
readln(f1,mas);
until eof(f1);
closefile(f1);
size:=i;
//dalee sortirovka obmenom
repeat
change:=false;
for k:=1 to size-1 do begin
if ord(mas[k][1])>ord(mas[k+1][1]) then
begin
m:=mas[k];
mas[k]:=mas[k+1];
mas[k+1]:=m;
change:=true;
end;
end;
until not change;
for i:=1 to size do memo1.Lines.add(mas);
end;
сартирует по первой букве (нада будет подкорректируй)...вся загадка в той строчке "if ord(mas[k][1])>ord(mas[k+1][1]) then" - тут мы что б массив не индексировать и патом еще с индексами возицца просто сравниваем порядковый номер буквы из таблицы ascii.
Про ascsii забыл спасибо :) а код у меня побольше потому что у меня кроме book.txt еще с 3 файлами нужно работать. Сейчас не успеваю проверить - но вроде все правильно (только вот в сортировка обменом не совсем правильна - приду проверю)
Цитата: Fatality
....а код у меня побольше потому что у меня кроме book.txt еще с 3 файлами нужно работать....
А не проще написать процедуру и её для каждого файла вызывать??:)
/*******************************/
А что вы мучаетесь...
Код:
procedure TForm1.BitBtn1Click(Sender: TObject);
var list : TStringList;
begin
list:=TStringList.Create;
try
if OpenDialog1.Execute
then list.LoadFromFile(OpenDialog1.FileName);
list.Sort;
if SaveDialog1.Execute
then list.SaveToFile(SaveDialog1.FileName);
finally
list.Free;
end;
end;
var list : TStringList;
begin
list:=TStringList.Create;
try
if OpenDialog1.Execute
then list.LoadFromFile(OpenDialog1.FileName);
list.Sort;
if SaveDialog1.Execute
then list.SaveToFile(SaveDialog1.FileName);
finally
list.Free;
end;
end;
[COLOR="Red"]Перечитайте правила раздела Дельфи. Получаете предупреждение.[/COLOR]