05.05.2010, 20:32
общий
это ответ
Здравствуйте, Юдин Евгений Сергеевич.
Выкладываю заготовку. Если уточните, что нужно (если еще следите за этим вопросом - в чем уже сомневаюсь) - допишу, как нужно
Приложение:
uses CRT;
CONST
base_FileName = '178155.dat';
name_len = 25;
score_ar_len = 4;
stud_ar_len = 10;
TYPE
func_compare = function (var v1, v2): Integer;
TOneStud = record
name: String[name_len];
scores: array[1..score_ar_len] of byte;
mid : Real;
end;
function UpRuss(src: String): String;
{все буквы, в том числе и русские - в заглавные.
Нужна для корректного сравнения}
var i, len: Integer;
begin
len := length(src);
for i := 1 to len do
case src[i] of
'a'..'z': src[i] := UpCase(src[i]);
'а'..'п': src[i] := chr(ord(src[i]) - 32);
'р'..'я': src[i] := chr(ord(src[i]) - 80);
end;
UpRuss := src
end;
function CompareLexigraf(var value1, value2): Integer; far;
{0 - если равны, -1 - если value1 < value2, +1 - если value1 > value2
по фамилиям без учета регистра}
var r1: TOneStud absolute value1;
r2: TOneStud absolute value2;
begin
if UpRuss(r1.name) > UpRuss(r2.name) then CompareLexigraf := 1
else
if UpRuss(r1.name) < UpRuss(r2.name) then CompareLexigraf := -1
else CompareLexigraf := 0
end;
function CompareByMid(var value1, value2): Integer; far;
{0 - если равны, -1 - если value1 < value2, +1 - если value1 > value2
по средней оценке}
var r1: TOneStud absolute value1;
r2: TOneStud absolute value2;
begin
if r1.mid > r2.mid then CompareByMid := 1
else
if r1.mid < r2.mid then CompareByMid := -1
else CompareByMid := 0
end;
procedure Sort(var ar; len, size_of_one: Integer;
compare_func: func_compare);
begin
end;
procedure PrintOne(var el; position, size_of_one: Integer);
{Предполагаем, что за диапазон не выходит
position - положение элемента, счет с 1}
var t: array[1..2] of TOneStud absolute el;
i: Integer;
begin
{$R-}
Write(t[position].name,' ');
for i:=1 to score_ar_len do Write(t[position].scores[i]:4);
WriteLn(' ',t[position].mid:6:2);
{$R+}
end;
procedure PrintAll(var ar; len, size_of_one: Integer);
var r: array[1..1] of TOneStud absolute ar;
i: Integer;
begin
for i:=1 to len do begin
Write(i:2,') ');
PrintOne(ar, i, sizeof(TOneStud));
end
end;
procedure SaveToFile(aFileName: String; var ar; len: Integer);
var f: File of TOneStud;
r: array[1..1] of TOneStud absolute ar;
i: Integer;
begin
Assign(f, aFileName);
{$I-} Reset(f); {$I+}
if IOResult = 0 then begin
WriteLn('Файл ',UpRuss(aFileName),' существует. Заменить? (Y/N)');
case ReadKey of
'y','Y','н','Н': Close(f);
else begin
Close(f); Exit; {немедленный вход из подпрограммы}
end
end
end;
Rewrite(f);
{$R-} {Отключаем проверку выхода за диапазон}
for i :=1 to len do
Write(f, r[i]);
{$R+}
Close(f)
end;
function LoadFromFile(aFileName: String; var ar; maxlen: Integer): Integer;
{Возвращает число считанных элементов, но не больше maxlen}
var
f: File of TOneStud;
r: Array[1..1] of TOneStud absolute ar;
i: Integer;
begin
Assign(f, aFileName);
{$I-} Reset(f); {$I+}
if IOResult <> 0 then begin
WriteLn('Не могу открыть файл ',UpRuss(aFileName));
Exit;
end;
i := 0;
while NOT EOF(f) do
begin
inc(i);
Read(f, r[i]);
end;
LoadFromFile := i;
end;
function Input_OneStud(var ar;
max_len, size_of_one, cur_pos: Integer): Boolean;
{Если отказались от ввода, то ЛОЖЬ, если введено, то истина
cur_pos - каким элементом записать. Если больше max_len, то не вводит}
var
r: array[1..2] of TOneStud;
begin
end;
VAR
studs: array[1..stud_ar_len] of TOneStud;
i: Integer;
count: Integer;
BEGIN
randomize;
with studs[5] do
begin
name := 'abc';
for i:=1 to score_ar_len do
scores[i] := 2 + random(4);
mid := 0;
for i :=1 to score_ar_len do mid := mid + scores[i];
mid := mid / score_ar_len
end;
PrintAll(studs, 10, sizeof(TOneStud));
END.