Обновленный Код По Линейной Сортировке

vladis222

Active member
06.12.2011
31
0
#1
Здравствуйте Обращаюсь к вам по такому вопросу: я по примеру из методички написал код для линейной сортировки,но программа работает как-то коряво.Подскажите,пожалуйста,в чем проблема. Вот код программы:
Код:
program laba_sort;

{$APPTYPE CONSOLE}

uses
SysUtils,CRT32;

const Nmax=10;
type first_array=array[1..Nmax] of Integer;
var i,j:Integer;
a:first_array;
ch:Byte;
n:Integer;
procedure InTab(var a:first_array);
var	 ch:Char;
fname:string;
i:integer;
f:file of Integer;
begin
ClrScr;
Writeln('Vvedite 10 elementov massiva : ');
for i:=1 to Nmax do
begin
Read(a[i]);
end;
Writeln('Sohranit massiv v faile ?(y/n) ');
ch:=ReadKey;
if ch in ['n','N','ò','Ò'] then
Exit;
Writeln('Vvedite imya faila : ');
Readln(fname);
Assign(f,fname);
{$I-}
Rewrite(f);
{$I+}
if IOresult=0 then
begin
for i:=1 to Nmax do
write(f, a[i]);
Close(f);
end
else
begin
Writeln('Oshibka pri sozdanii faila!');
ReadKey;
end;
end;
procedure InFileTab(var a:first_array );
var
f:file of Integer;
fname:string;
ch:Char;
begin
ClrScr;
repeat
Writeln('Vvedite imya faila');
Readln(fname);
Assign(f,fname);
{$I-}
Reset(f);
{$I+}
if IOResult<>0 then
begin
Writeln('Ne vozmojno naiti fail ',fname);
Writeln('Prodoljit rabotu ? y/n');
ch:=ReadKey;
if ch in ['n','N','ò','Ò'] then
Exit;
end;
until IOResult=0;
n:=0;
while not Eof(f) do
begin
n:=n+1;
read(f,a[n]);
end;
Close(f);
Writeln('Tablica zagrujena iz faila ! ', fname);
write('Najmite ljubuju klavishu : ');
ReadKey;
end;
procedure ShowTab(var a:first_array);
var i:Integer;
begin
ClrScr;
Writeln('Elementy massiva : ');
Writeln('----------------------------------');
for i:=1 to Nmax do
begin
Write('|',a[i]);
end;
Write(' Najmite ljubuju klavishu : ');
Readkey;
end;
procedure PrintTab(var a:first_array;i,imin:Integer);
var k:Integer;
begin
for k:=1 to Nmax do
begin
if k=i then
textattr:=red*16+white
else
if k=imin then
textattr:=blue*16+white
else
textattr:=black*16+white;
write(a[k]);
textattr:=black*16+white;
write('  ');
end;
Writeln;
end;
procedure SortTab(var a:first_array);
var i,imin,j:Integer;
tmp:Integer;
begin
ClrScr;
Writeln('Shagi sortirovki');
Writeln('(videleni kluchi perestavlyaemih zapisej)');
for i:=1 to Nmax-1 do
begin
imin:=i;
for j:=i+1 to Nmax do
if a[j]<a[imin] then
imin:=j;
if imin<>i then
begin
PrintTab(a,i,imin);
ReadKey;
tmp:=a[i];
a[i]:=a[imin];
a[imin]:=tmp;
end;
end;
end;

begin
repeat
ClrScr;
Writeln('1.Vvod dannih s klaviaturi');
Writeln('2.Zagruzka tablici iz faila');
Writeln('3.Vivod tablici');
Writeln('4.Sortirovka tablici metodom linejnogo vibora');
Writeln('5.Bystraja sortirovka(srednij razd.element)');
Writeln('----------------------------------------------');
Writeln('0.Vihod');

Writeln;
Write('Vash vibor : ');
Readln(ch);

Case ch of
1:InTab(a);
2:InFileTab(a);
3:ShowTab(a);
4:SortTab(a);

end;
until ch=0;
end.