вот мой пузырек , даже разложеный на этапы. из проги сортировщика для
макс ридера. for delphi: (извиняйте за полный код. лень вырезать)
сортирует статьи от большего к меньшему по длине и обратному алфавиту.
возможно переделать и улучшить на свой вкус. unit d_sort;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, mmsystem;
type
TForm1 = class(TForm)
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
precount_st, count_st: integer;
implementation
{$R *.DFM}
procedure sort(fdName_m: string);
var
b, change, w, q, p:integer;
lng, s1, s2: string;
fd: TextFile; // файл string
buf: String;
sort: array of AnsiString;
size_sort: integer;
begin
// вычисляем максимальный размер массива
size_sort:= 0; // размер массива
precount_st:= 0;
AssignFile(fd, fdName_m); {$I+}
Reset(fd); // открыть для чтения {$I+}
while not EOF (fd) do begin
readln(fd, buf); // прочитать строку из файла
size_sort:= size_sort + 1; // накапливаем размерность
// подсчитываем общее количество статей до обработки
b:= pos('=', buf);
if b<> 0 then precount_st:= precount_st + 1;
end; // while
CloseFile(fd);
// устанавливаем максимальный размер массива
SetLength(sort, size_sort + 1); // устанавливаем размер массива
// q:= 0;
// открываем файл словаря max reader
AssignFile(fd, fdName_m); {$I+}
Reset(fd); // открыть для чтения {$I+}
while not EOF (fd) do begin
q:= q + 1;
readln(fd, buf); // прочитать строку из файла
//buf:= AnsiLowerCase(buf); // преобразовываем строку к нижнему регистру
sort[q]:= buf; // помещаем строку в массив
end; // while
CloseFile(fd);
//// маркируем, если не статья
for q:= 1 to size_sort do begin
b:= pos('=', sort[q]);
if b= 0 then sort[q]:= '@=@';
end; // for. маркируем
// удаление лишних пробелов
for q:= 1 to size_sort do begin
repeat
b:= pos(' ', sort[q]); delete(sort[q], b, 1);
until b= 0;
end; // for. удаление лишних пробелов
// индексируем правила
for q:= 1 to size_sort do begin
// ищем позицию знака равно
b:= pos('=', sort[q]);
// отделяем статью - что
s1:= Copy(sort[q], 1, b-1);
// присваеваем правила
b:= length(s1); // крайний правый символ
lng:= IntToStr(b);
// подставляем нули
if length(lng)= 1 then lng:= '00' + lng;
if length(lng)= 2 then lng:= '0' + lng;
if (s1[1]= ' ') And (s1[b]= ' ') then
sort[q]:= lng + ':1:' + sort[q];
if (s1[1]= ' ') And (s1[b]<> ' ') then
sort[q]:= lng + ':2:' + sort[q];
if (s1[1]<> ' ') And (s1[b]= ' ') then
sort[q]:= lng + ':3:' + sort[q];
if (s1[1]<> ' ') And (s1[b]<> ' ') then
sort[q]:= lng + ':4:' + sort[q];
end; //for
// сортировка массива
w:= 0;
repeat
change:= 0;
for q:= 1 to size_sort-1 do begin
s1:= sort[q]; s2:= sort[q+1];
// [1] ищем позицию знака равно
b:= pos('=', s1);
// отделяем статью - что
s1:= Copy(s1, 1, b-1);
// [2] ищем позицию знака равно
b:= pos('=', s2);
// отделяем статью - что
s2:= Copy(s2, 1, b-1);
// сравнение
p:= AnsiCompareStr(s1, s2);
if p< 0 then begin
change:= 1;
sort[0]:= sort[q];
sort[q]:= sort[q+1];
sort[q+1]:= sort[0];
end; // begin
end; // for
// звуковая индикация
w:= w + 1; // подсчитываем статьи
if w= 5 then w:= 0;
if w= 0 then PlaySound('done_st.wav',0,SND_ASYNC);
until change= 0;
// удаляем правила
for q:= 1 to size_sort do
delete(sort[q], 1, 6);
// удаляем повторения
for q:= 1 to size_sort-1 do begin
s1:= sort[q]; s2:= sort[q+1];
// [1] ищем позицию знака равно
b:= pos('=', s1);
// отделяем статью - что
s1:= Copy(s1, 1, b-1);
// [2] ищем позицию знака равно
b:= pos('=', s2);
// отделяем статью - что
s2:= Copy(s2, 1, b-1);
if s1 = s2 then
sort[q]:= '@=@';
end; // for
// записываем массив в файл
count_st:= 0;
AssignFile(fd, fdName_m);
Rewrite(fd);
for q:= 1 to size_sort do
if (sort[q] <> '') And (sort[q]<> '@=@') then begin
writeln(fd, sort[q]); // записать строкуу в файл
count_st:= count_st + 1; // статистика полезных статей
end; // запись
CloseFile(fd);
MessageBeep(MB_ICONASTERISK); // *
end; // procedure sort
procedure TForm1.FormCreate(Sender: TObject);
var
fdName_m: string;
b, q, e : integer;
begin
OpenDialog1.Title:= 'Сортировка: Укажите путь к словарю произношений Max-Reader';
repeat
e:= 0;
if OpenDialog1.Execute then begin
e:= 1;
fdName_m:= OpenDialog1.FileName;
// проверяем правильность идентификации словаря
B:= pos('\settings\dictionary.txt', fdName_m);
if b <> 0 then begin
// проверяем наличие словаря как файла
if FileExists(fdName_m) = False then begin
MessageBeep(MB_ICONHAND);//ошибка
halt;
end; // наличие словаря
PlaySound('mess.wav',0,SND_SYNC);
sort(fdName_m); // сортируем
PlaySound('complete.wav',0,SND_SYNC);
ShowMessage('Операция завершена' + chr(13)
+ 'Общее количество статей:' + chr(13)
+ 'до сортировки ' + IntToStr(precount_st) + chr(13)
+ 'после сортировки ' + IntToStr(count_st));
end; //begin. b
end; // begin. opendialog1
until (b<> 0) Or (e= 0);
Form1.Hide;
halt;
end; // create form
end.
24 января 2010
