Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Упорядочивание слов по алфавиту

16K
25 декабря 2007 года
Fatality
7 / / 08.06.2006
Добрый вечер. Дана функция, которая должна упорядочивать при создании формы фамилии в файле bokok.txt по первой букве. Где то ошибка, сортируются неправильно. Подскажите пожалуйста где ошибка, и, если есть возможность дополните код чтобы фамилии сортировались по алфавиту( не по первой букве, а по алфавиту полностью) Мои готовии исходники стерли, и за неимением времени для восстановления прошу помощи тут. Место, где происходит само сравнение букв пометил комментарием.
Код:
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;
347
25 декабря 2007 года
Maniak
319 / / 05.11.2005
код у тебя конечно загадочный...я даже не смог разобраться в этих рунах.
вот тебе то что я понял из твоего прошения:
Код:
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;

сартирует по первой букве (нада будет подкорректируй)...вся загадка в той строчке "if ord(mas[k][1])>ord(mas[k+1][1]) then" - тут мы что б массив не индексировать и патом еще с индексами возицца просто сравниваем порядковый номер буквы из таблицы ascii.
16K
26 декабря 2007 года
Fatality
7 / / 08.06.2006
Про ascsii забыл спасибо :) а код у меня побольше потому что у меня кроме book.txt еще с 3 файлами нужно работать. Сейчас не успеваю проверить - но вроде все правильно (только вот в сортировка обменом не совсем правильна - приду проверю)
286
26 декабря 2007 года
misha_turist
572 / / 28.11.2005
Цитата: 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;
242
26 декабря 2007 года
Оlga
2.2K / / 04.02.2006
Fatality
[COLOR="Red"]Перечитайте правила раздела Дельфи. Получаете предупреждение.[/COLOR]
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог