Сортировка Таблицы Линейным Поиском

vladis222

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

{$APPTYPE CONSOLE}

uses
Crt;
const Nmax=100;
type Rec=record
Name:string[15];
Area:Real;
end;
Table=array [1..Nmax] of Rec;
var T:table;
n:Integer;
ch:byte;
function IOResult:Integer;
begin
end;
procedure InTab(var T:Table;var n:Integer);
var ch:Char;
fname:string;
i:Integer;
f:file of rec;
begin
ClrScr;
n:=0;
repeat
n:=n+1;
Writeln(,n,'-ja zapis tablici');
Writeln('Gosudarstvo:');
Readln(t[n].name);
Writeln('Ploshad:');
Readln(t[n].area);
Writeln('prodoljit'' vvod ? y/n');
Readln(ch);
until ch in ['n','N','ò','Ò'];
Writeln('Sohranit vvedennie dannie v faile ? y\n');
Readln(ch);
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 n do
write (f,t[i]);
Close(f);
end
else
begin
Writeln('Oshibka pri sozdanii faila!!!');
Readkey;
end;
end;
procedure InFileTab(var T:Table;var n:integer);
var
f:file of Rec;
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 mogu naiti file ',fname);
Writeln('Prodoljit rabotu? y/n');
Readln(ch);
if ch in ['n','N','t','T'] then
Exit;
end;
until IOResult=0;
n:=0;
while not eof(f) do
begin
n:=n+1;
read(f,T[n]);
end;
Close(f);
Writeln('Tablica zagrujena iz faila ',fname);
write('Najmite lubuju klavishu...');
Readkey;
end;
procedure ShowTab(var T:Table;n:Integer);
var i:integer;
begin
ClrScr;
Writeln('Zapisi tablicy:');
Writeln('-----------T-----------');
Writeln('| Gosudarstvo | Ploshad  |');
Writeln('+----------------------------+');
for i:=1 to n do
Writeln(' | ',T[i].Name:12,' |',T[i].Area:9,' | ');
Writeln('L----------------+------------------');
write('Najmite lubuju klavishu...');
Readkey;
end;
procedure PrintTab(var T:Table;n,i,imin:Integer);
var k:Integer;
begin
for k:=1 to n 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(t[k].Area);
textattr:=black*16+white;
write(' ');
end;
Writeln;
end;
procedure SortTab(var T:Table;n:Integer);
var i,imin,j:Integer;
tmp:Rec;
begin
ClrScr;
Writeln('Shagi sortorovki(videleni kluchi perestavlyaemih zapisej)');
for i:=1 to n-1 do
begin
imin:=i;
for j:=i+1 to n do
if t[j].Area<t[imin].Area then
imin:=j;
if imin <>i then
begin
PrintTab(T,n,i,imin);
Readkey;
tmp:=t[i];
t[i]:=t[imin];
t[imin]:=tmp;
end;
end;
end;
begin
n:=0;
repeat
ClrScr;
Writeln('1.Vvod dannih');
Writeln('2.Zagruzka tablicy iz faila ');
Writeln('3.Vivod tablicy');
Writeln('4.Sortirovka tablicy metodom linejnogo vibora');
Writeln('-----------------------------------------------');
Writeln('0.Vihod');
writeln;
write('Vash vibor:');
Readln(ch);
Case ch of
1:InTab(T,n);
2:InFileTab(T,n);
3:if n<>0 then
ShowTab(T,n)
else
begin
Writeln('Tablica ne sozdana!!!');
Readkey;
end;
4:if n<>0 then
SortTab(T,n)
else
begin
Writeln('Tablica ne sozdana!!!');
Readkey;
end;
end;
until ch=0;
end.