Вот полный код(некоторые моменты не относящиеся к теме мне пришлось урезать, т.к. тут ограничение в 5000 символов). Также не стал переписывать кривой русский текст в writeln, думаю он не столь важен.
Код:
program basa;
uses wincrt, crt, dos;
type nam=string[20];
hdd=record nazv:nam;
end;
base=array [1..10000] of hdd;
var x,y:hdd;
b:base;
sel,n,i:integer;
f,f1:text;
h,m,s,hund,s3,h4,h1,m1,s1,hund1,s34:word;
a,b2,a1,b3,b4,v,v1,v2,v3:word;
procedure menu; forward;
procedure sort_nazv(var b:base); forward;
procedure sort_nazv2(var b:base); forward;
procedure sort_nazv3(var b:base; l,r:integer); forward;
procedure gen; forward;
procedure time1; forward;
procedure time2; forward;
procedure pod; forward;
procedure text22(var b:base); forward;
procedure text2(var b:base); forward;
procedure text23(var b:base); forward;
procedure text2(var b:base);
var i:integer;
begin
assign(f, 'C:\data12.txt');
rewrite(f);
for i:=1 to 10000 do
begin
writeln(f,b[i].nazv);
end;
close(f);
menu;
end;
procedure text22(var b:base);
var i:integer;
begin
assign(f, 'C:\data13.txt');
rewrite(f);
for i:=1 to 10000 do
begin
writeln(f,b[i].nazv);
end;
close(f);
menu;
end;
procedure text23(var b:base);
var i:integer;
begin
assign(f, 'C:\data14.txt');
rewrite(f);
for i:=1 to 10000 do
begin
writeln(f,b[i].nazv);
end;
close(f);
menu;
end;
procedure menu;
begin
clrscr;
writeln('');
Writeln(' <<<Њ…Ќћ ЏђЋѓђЂЊЊ›>>>');
Writeln;
Writeln(' ------------------------------------');
Writeln(' 1. ѓҐ*Ґа*жЁп.');
Writeln(' 2. ‘®авЁа®ўЄ* "Џг§ламЄ®¬".');
Writeln(' 3. ‘®авЁа®ўЄ* Їа®бвл¬ ЇҐаҐЎ®а®¬.');
Writeln(' 4. ‘®авЁа®ўЄ* "Quicksort"');
Writeln(' 5. Џ®¤бзҐв.');
Writeln(' 0. ‚л室.');
Writeln(' ------------------------------------');
Writeln;
Write(' ‚*и ўлЎ®а >>> ');
readln (sel);
Case sel of
2:sort_nazv(b);
0:halt;
1:gen;
3:sort_nazv2(b);
5:pod;
4:sort_nazv3(b,1,10000); {вот тут единственный нужный вызов процедуры сортировки quicksort}
end
end;
procedure pod;
begin
writeln ('ЏҐаў*п б®авЁа®ўЄ* "Џг§ламЄ®¬" ¤«Ё«*бм ', b3, ' ᥪг*¤');
writeln ('‚в®а*п б®авЁа®ўЄ* ¬Ґв®¤®¬ Їа®бв®Ј® ЇҐаҐЎ®а* ¤«Ё«*бм ', b2, ' ᥪг*¤');
writeln ('’аҐвмп б®авЁа®ўЄ* "Quicksort" ¤«Ё«*бм ', b4, ' ᥪг*¤');
readkey;
end;
procedure time1;
begin
gettime(h,m,s,hund);
s3:=s;
h4:=hund;
end;
procedure time2;
begin
gettime(h1,m1,s1,hund1);
writeln('‘®авЁа®ўЄ* ¤«Ё«*бм: ');
if s1<s then
begin
if hund1<hund then
begin
writeln (60+s1-s3, ' ᥪг*¤ Ё ',100+hund1-h4,' ¬Ё«ЁбҐЄг*¤' );
a:=60+s1-s3;
v:=100+hund1-h4;
end;
if hund<=hund1 then
begin
writeln (60+s1-s3, ' ᥪг*¤ Ё ',hund1-h4,' ¬Ё«ЁбҐЄг*¤' );
a:=60+s1-s3;
v:=hund1-h4;
end;
end;
if s<=s1 then
begin
if hund1<hund then
begin
writeln (s1-s3, ' ᥪг*¤ Ё ',100+hund1-h4,' ¬Ё«ЁбҐЄг*¤' );
a:=s1-s3;
v:=100+hund1-h4;
end;
if hund<=hund1 then
begin
writeln (s1-s3, ' ᥪг*¤ Ё ',hund1-h4,' ¬Ё«ЁбҐЄг*¤' );
a:=s1-s3;
v:=hund1-h4;
end;
end;
writeln();
writeln('Ќ*з*«® ў ',m,' ¬Ё*гв Ё ', s3, ' ᥪг*¤');
writeln('ЋЄ®*з**ЁҐ ў ',m1, ' ¬Ё*гв Ё ',s1, ' ᥪг*¤');
writeln();
writeln('GMT+3');
end;
procedure read1(var b:base);
var i:integer;
begin
assign(f, 'C:\data11.txt');
reset(f);
for i:=1 to 10000 do
begin
readln(f,b[i].nazv);
end;
close (f);
end;
procedure sort_nazv2(var b:base);
{тут сортировка простым перебором}
end;
procedure sort_nazv(var b:base);
{тут сортировка пузырьком}
end;
procedure sort_nazv3(var b:base; l,r:integer);
var i,j:integer;
y:nam;
k,k2:nam;
begin
read1(b);
time1;
k:=b[(l+r) div 2].nazv;
i:=l;
j:=r;
repeat
while b[i].nazv>k do i:=i+1;
while b[j].nazv<k do j:=j-1;
if i<=j then
begin
y:=b[i].nazv;
b[i].nazv:=b[j].nazv;
b[j].nazv:=y;
i:=i+1;
j:=j-1;
end;
until i>j;
if l<j then sort_nazv3(b,l,j);
if i<r then sort_nazv3(b,i,r);
time2;
readkey;
text23(b);
b4:=a;
v3:=v;
end;
procedure gen;
var i,j,r:integer;
begin
assign(f, 'C:\data11.txt');
rewrite(f);
for i:=1 to 10000 do
begin
for j:=1 to 20 do
begin
r:=random(26)+97;
write(f,chr(r));
end;
writeln(f);
end;
close(f);
menu;
end;
begin
menu;
readln;
end.