Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.06.2021, 20:41   #1
Alexandrietz
Пользователь
 
Регистрация: 30.11.2017
Сообщений: 15
По умолчанию Сортировка по записи.

Не могу додуматься, как сделать ключ сортировки, который должен быть по условию задачи функциональным типом, чтобы по нему сортировать массивы записей. Помогите, пожалуйста. Вот код
Код:
Unit
  UnitLastRealization;
  
Interface

Uses
  UnitTypes;

Function Transform(const FText: TextFile; var FTyped: File of StudentInfo): Integer;
Procedure FillArray(const FTyped: File of StudentInfo; var X: arr_of_records);
Procedure Sort(var X: arr_of_records; var s: String; first, last: Integer);
Function FindBadMarks(const F: TextFile; var X: arr_of_records; bad_mark: Integer): Integer;
Function PercentOfStudents(amount_of_bad_marks, amount_of_students: Integer): Real;
Procedure WriteDataInFile(const F: TextFile; const X: arr_of_records);

Implementation

Function Transform(const FText: TextFile; var FTyped: File of StudentInfo): Integer;
var
  r: StudentInfo;
  n: Integer;
begin
  n := 0;
  if(SeekEOF(FText)) then
    Result := 0
  else
    begin
      while(not(EOF(FText))) do
        begin
          Readln(FText, r.group);
          Readln(FText, r.family_name);
          Readln(FText, r.name);
          Readln(FText, r.middle_name);
          Readln(FText, r.year_of_birth);
          Readln(FText, r.gender);
          Readln(FText, r.ph_mark);
          Readln(FText, r.math_mark);
          Readln(FText, r.it_mark);
          Readln(FText, r.scholarship);
          Readln(FText);
          n += 1;
          Write(FTyped, r);
        end;
      Result := n;   // число строк в txt-файле
    end;
end;

Procedure FillArray(const FTyped: File of StudentInfo; var X: arr_of_records);
begin
  for var i := Low(X) to High(X) do
    Read(FTyped, X[i]); 
end;

Procedure Sort(var X: arr_of_records; var s: String; first, last: Integer);
var
  i, j: Integer;
  scho_ship, swap, f_name: String;
begin 
  i := first; 
  j := last;
  if(s = 'Стипендия') then
    begin
      scho_ship := X[(i + j) div 2].scholarship; 
      repeat 
        begin
          while(X[i].scholarship < scho_ship) do
           Inc(i);
          while(X[j].scholarship > scho_ship) do
           Dec(j);
          if(i <= j) then 
            begin 
              swap := X[i].scholarship; 
              X[i].scholarship := X[j].scholarship;
              X[j].scholarship := swap; 
              i += 1;
              j -= 1; 
            end;
        end;
      until(i > j); 
      if(first < j) then 
        Sort(X, s, first, j); 
      if(i < last) then 
        Sort(X, s, i, last);
    end
  else if(s = 'Фамилия') then
    begin
      f_name := X[(i + j) div 2].family_name; 
      repeat 
        begin
          while(X[i].family_name < f_name) do
           Inc(i);
          while(X[j].family_name > f_name) do
           Dec(j);
          if(i <= j) then 
            begin 
              swap := X[i].family_name; 
              X[i].family_name := X[j].family_name;
              X[j].family_name := swap; 
              i += 1;
              j -= 1; 
            end;
        end;
      until(i > j); 
      if(first < j) then 
        Sort(X, s, first, j); 
      if(i < last) then 
        Sort(X, s, i, last);  
    end;
end;

Function FindBadMarks(const F: TextFile; var X: arr_of_records; bad_mark: Integer): Integer;
var
  flag: Boolean;
  n: Integer;
begin
  n := 0;
  for var i := Low(X) to High(X) do
    begin
      flag := False;
      if(X[i].ph_mark = IntToStr(bad_mark)) then
        flag := True;
      if(X[i].math_mark = IntToStr(bad_mark)) then
        flag := True;
      if(X[i].it_mark = IntToStr(bad_mark)) then
        flag := True;
      if(flag) then
        begin
          n += 1;
          Writeln(F, 'Полное имя студента, имеющего плохую оценку ', X[i].family_name,' ', X[i].name, ' ', X[i].middle_name, ' ');
          X[i].scholarship := '0';
        end;
    end;
  if(not(flag) and (n = 0)) then
    Writeln(F, 'Не найден.');
  Result := n;
end;

Function PercentOfStudents(amount_of_bad_marks, amount_of_students: Integer): Real;
begin
  Result := (amount_of_bad_marks / amount_of_students) * 100;
end;

Procedure WriteDataInFile(const F: TextFile; const X: arr_of_records);
begin
  for var i := Low(X) to High(X) do
    begin
      Write(F, 'Group: ');
      Writeln(F, X[i].group); 
      Write('Group: ');
      Writeln(X[i].group); 
      Write(F, 'FamilyName: ');
      Writeln(F, X[i].family_name); 
      Write('FamilyName: ');
      Writeln(X[i].family_name);
      Write(F, 'Name: ');
      Writeln(F, X[i].name); 
      Write('Name: ');
      Writeln(X[i].name); 
      Write(F, 'MiddleName: ');
      Writeln(F, X[i].middle_name); 
      Write('MiddleName: ');
      Writeln(X[i].middle_name);
      Write(F, 'YearOfBirth: ');
      Writeln(F, X[i].year_of_birth);
      Write('YearOfBirth: ');
      Writeln(X[i].year_of_birth);
      Write(F, 'Gender: ');
      Writeln(F, X[i].gender); 
      Write('Gender: ');
      Writeln(X[i].gender);
      Write(F, 'MarkOnPhysics: ');
      Writeln(F, X[i].ph_mark); 
      Write('MarkOnPhysics: ');
      Writeln(X[i].ph_mark); 
      Write(F, 'MarkOnMath: ');
      Writeln(F, X[i].math_mark);
      Write('MarkOnMath: ');
      Writeln(X[i].math_mark);
      Write(F, 'MarkOnIT: ');
      Writeln(F, X[i].it_mark);
      Write('MarkOnIT: ');
      Writeln(X[i].it_mark);
      Write(F, 'Scholarship: ');
      Writeln(F, X[i].scholarship);
      Write('Scholarship: ');
      Writeln(X[i].scholarship);
      Writeln(F);
      Writeln();
    end;
end;

end.
Код:
Unit
  UnitTypes;
  
Interface

Type
  StudentInfo = record
    group: String[20];
    family_name: String[20];
    name: String[20];
    middle_name: String[20];
    year_of_birth: String[20];
    gender: String[20];
    ph_mark: String[20];
    math_mark: String[20];
    it_mark: String[20];
    scholarship: String[20];
  end;
  
  arr_of_records = array of StudentInfo;
  
  Func = Function(const r: record): String;
 
Implementation

end.
Alexandrietz вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Списки. Сортировка записи. Делфи TImRik Помощь студентам 0 25.12.2013 23:23
Записи, массивы записей, сортировка. H4t Паскаль, Turbo Pascal, PascalABC.NET 1 27.12.2012 17:26
Тема записи. Сортировка rusfin01 Помощь студентам 1 19.06.2011 13:40
Сортировка в двоичной записи числа proag Помощь студентам 3 18.02.2011 13:21
Сортировка записи на DbGrid mavlon_m Общие вопросы Delphi 1 24.08.2009 10:01