Lab5.1 (Delphi)

-----------------------------------FormMain-------------------------------------

unit Unit2;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls, Vcl.Menus;

type
    TFormMain = class(TForm)
        StringGridMain: TStringGrid;
        ButtonInfo: TButton;
        ButtonAdd: TButton;
        MainMenu1: TMainMenu;
        Task: TMenuItem;
        Develop: TMenuItem;
        FOpen: TMenuItem;
        FSave: TMenuItem;
        N7: TMenuItem;
        FOut: TMenuItem;
        F: TMenuItem;
        SaveDialog1: TSaveDialog;
        OpenDialog1: TOpenDialog;
        procedure FormCreate(Sender: TObject);
        procedure ButtonAddClick(Sender: TObject);
        procedure ButtonInfoClick(Sender: TObject);
        procedure StringGridMainKeyDown(Sender: TObject; var Key: Word;
          Shift: TShiftState);
        procedure DevelopClick(Sender: TObject);
        procedure FSaveClick(Sender: TObject);
        procedure TaskClick(Sender: TObject);
        procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
        procedure FOutClick(Sender: TObject);
        procedure FOpenClick(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;


var
    FormMain: TFormMain;
    Path: String;

implementation

{$R *.dfm}

uses Unit1, Unit4;

procedure TFormMain.ButtonAddClick(Sender: TObject);
var
    Size, I: Integer;
begin
    Size := StringGridMain.RowCount;
    For I := 1 to Size - 1 do
        StringGridMain.Rows[I].Clear;
    StringGridMain.RowCount := 1;
    FormAdd.ShowModal
end;

procedure PrintStudentsWithLowGrades(GroupList: PStudent);
var
    CurrentStudent: PStudent;
    CurrentGrade: PMarks;
    HasLowGrade: Boolean;
    I: Integer;
begin
    I := FormInfo.StringGridInfo.RowCount;
    CurrentStudent := GroupList;

    while Assigned(CurrentStudent) do
    begin
        HasLowGrade := False;
        CurrentGrade := CurrentStudent.marks;

        // Проверяем оценки студента
        while Assigned(CurrentGrade) do
        begin
            if CurrentGrade.mark < 4 then
            begin
                HasLowGrade := True;
                Break; // Если есть оценка ниже 4, то выходим из цикла
            end;
            CurrentGrade := CurrentGrade^.Next;
        end;

        // Выводим информацию о студенте, у которого есть оценка ниже 4
        if HasLowGrade then
        Begin
            FormInfo.StringGridInfo.Cells[0, I] :=
              IntToStr(CurrentStudent.code);
            FormInfo.StringGridInfo.Cells[1, I] := CurrentStudent.name;
            Inc(I);
            FormInfo.StringGridInfo.RowCount := I;
        End;
        CurrentStudent := CurrentStudent^.Next;
        // Переходим к следующему студенту
    end;
end;

procedure TFormMain.ButtonInfoClick(Sender: TObject);

var
    cur: PStudent;
    I, J: Integer;
    Bol: Boolean;

begin
    PrintStudentsWithLowGrades(GroupList);
    If FormInfo.StringGridInfo.RowCount = 1 Then
        Application.MessageBox('Нет студентов с оценками ниже 4',
          'Предупреждение', 0)
    Else
        FormInfo.ShowModal;

end;

procedure TFormMain.DevelopClick(Sender: TObject);
begin
    Application.MessageBox('Выполнил студент группы 251004, Сымоник Вадим',
      'О разработчике', 0);
end;

function AddGrade(var head: PMarks; subCode, Grade: Integer): PMarks;
var
    NewGradeNode, LastGradeNode: PMarks;
begin
    New(NewGradeNode);
    NewGradeNode.subCode := subCode;
    NewGradeNode.mark := Grade;
    NewGradeNode^.Next := nil;

    if head = nil then
        head := NewGradeNode
    else
    begin
        LastGradeNode := head;
        while LastGradeNode^.Next <> nil do
            LastGradeNode := LastGradeNode^.Next;
        LastGradeNode^.Next := NewGradeNode;
    end;
    Result := NewGradeNode;
end;

function AddStudent(var head: PStudent; code: Integer; name: String;
  Grades: PMarks): PStudent;
var
    NewStudentNode, LastStudentNode: PStudent;
begin
    New(NewStudentNode);
    NewStudentNode.code := code;
    NewStudentNode.name := Name;
    NewStudentNode.marks := Grades;
    NewStudentNode^.Next := nil;

    if head = nil then
        head := NewStudentNode
    else
    begin
        LastStudentNode := head;
        while LastStudentNode^.Next <> nil do
            LastStudentNode := LastStudentNode^.Next;
        LastStudentNode^.Next := NewStudentNode;
    end;
    Result := NewStudentNode;
end;

procedure AddGradeToStudent(var head: PStudent; GroupCode: Integer;
  const name: string; subCode, Grade: Integer);
var
    CurrentStudent: PStudent;
    NewGrade: PMarks;
begin
    CurrentStudent := head;

    // Проверяем, существует ли студент с указанными данными
    while Assigned(CurrentStudent) do
    begin
        if (CurrentStudent.code = GroupCode) and (CurrentStudent.name = Name)
        then
        begin
            // Студент найден, добавляем оценку
            NewGrade := AddGrade(CurrentStudent.marks, subCode, Grade);
            Exit; // Завершаем процедуру, так как студент найден и оценка добавлена
        end;
        CurrentStudent := CurrentStudent^.Next;
    end;

    // Если студент не найден, создаем новый элемент списка студентов и добавляем оценку
    CurrentStudent := AddStudent(head, GroupCode, Name, nil);
    AddGrade(CurrentStudent.marks, subCode, Grade);
end;


Procedure GetLineFromF(var FileInput: TextFile);
Var
    I, J, num, code, mark: Integer;
    name, Grade: String;
    IsCorrect, cor: Boolean;
Begin
    IsCorrect := True;
    Try
        Readln(FileInput, code);
    Except
        Application.MessageBox('Ошибка чтения кода', 'Ошибка', MB_ICONSTOP);
        IsCorrect := False;
    End;
    If not IsCorrect Or ((code <= 0) Or (code >= 1000)) Then
    Begin
        IsCorrect := False;
    End;

    Readln(FileInput, Name);

    J := 0;
    While not SeekEoln(FileInput) do
    Begin
        cor := True;
        try
            Read(FileInput, num);
        Except
            cor := False;
        end;
        If cor And ((num > 0) And (num <= 10)) Then
        Begin
            SetLength(arrOfGrade, J + 1);
            arrOfGrade[J] := num;
            Inc(J);
        End;
    End;

    If IsCorrect Then
    Begin
        for I := 0 to Length(arrOfGrade) - 1 do
        Begin
            mark := arrOfGrade[I];
            AddGradeToStudent(GroupList, code, Name, code, mark);
        End;
    End;

End;

procedure TFormMain.FOpenClick(Sender: TObject);
var
    F: TextFile;
    Correct: Boolean;
    I, J, mark, Size, code: Integer;
    name, Path: String;
    NewStudentNode, LastStudentNode, head, CurrentStudent: PStudent;
    NewGrade: PMarks;

begin

    If OpenDialog1.Execute Then
    Begin

        Size := StringGridMain.RowCount;
        For I := 1 to Size - 1 do
            StringGridMain.Rows[I].Clear;
        StringGridMain.RowCount := 1;

        AssignFile(F, OpenDialog1.FileName);

        Try
            Try
                Reset(F);
                While not eof(F) do
                Begin
                    GetLineFromF(F);
                    Readln(F);
                End;

            Finally
                CloseFile(F);
            End;
        Except

        End;

        FormAdd.ButtonList.Click;

    end;
end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    CanClose := Application.MessageBox('Вы действительно хотите выйти?',
      'Выход', MB_YESNO) = ID_YES;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
    StringGridMain.RowCount := 1;
    StringGridMain.Cells[0, 0] := 'Код';
    StringGridMain.Cells[1, 0] := 'Фамилия и инициалы';
    StringGridMain.Cells[2, 0] := 'Оценки';
end;

procedure TFormMain.FOutClick(Sender: TObject);
begin
    FormMain.Close
end;

procedure TFormMain.FSaveClick(Sender: TObject);
var
    F: TextFile;
    I: Integer;
    Str, marks, mark: String;
    CurrentStudent: PStudent;
    CurrMarks: PMarks;
begin
    If (SaveDialog1.Execute) Then
    Begin
        Try
            Path := SaveDialog1.FileName;
            Str := ExtractFileExt(Path);
            If (Str = '') Then
                Path := Path + '.txt';
            CurrentStudent := GroupList;
            AssignFile(F, Path);
            Rewrite(F);
            While CurrentStudent <> nil do
            Begin
                marks := '';
                CurrMarks := CurrentStudent.marks;
                While CurrMarks <> nil do
                Begin
                    mark := IntToStr(CurrMarks.mark);
                    marks := marks + mark + ' ';
                    CurrMarks := CurrMarks.next;
                End;
                Writeln(F, IntToStr(CurrentStudent.code));
                Writeln(F, CurrentStudent.name);
                Writeln(F, marks);
                CurrentStudent := CurrentStudent.Next;
            End;
            CloseFile(F);
        Except
            Application.MessageBox('Некорректный файл!', 'Ошибка', MB_ICONSTOP);
        End;
    End;
end;

procedure deleteNode(Value: Integer);
var
    currNode: PStudent;
    prevNode: PStudent;
    temp: Integer;
Begin
    currNode := head;
    prevNode := nil;
    temp := 1;

    while (currNode <> nil) And (temp <> Value) do
    Begin
        prevNode := currNode;
        currNode := currNode.Next;
        Inc(temp);
    End;

    If currNode <> nil Then
    Begin
        If prevNode <> nil Then
            prevNode.Next := currNode.Next
        else
            head := currNode.Next;

        Dispose(currNode);
    End;

End;

procedure editData(val, code, name: Integer);
var
    curr: PStudent;
    temp: Integer;
Begin
    curr := head;
    temp := 1;

    while (curr <> nil) and (temp <> val) do
        curr := curr.Next;

    If curr <> nil Then
    Begin

    End;

End;


procedure FreeGrades(var head: PMarks);
var
    CurrentGrade, NextGrade: PMarks;
begin
    CurrentGrade := head;
    while Assigned(CurrentGrade) do
    begin
        NextGrade := CurrentGrade^.Next;
        Dispose(CurrentGrade);
        CurrentGrade := NextGrade;
    end;
    head := nil; // Обнуляем указатель на голову списка
end;

procedure DeleteStudent(var head: PStudent; GroupCode: Integer;
  const name: string);
var
    CurrentStudent, PrevStudent: PStudent;
begin
    CurrentStudent := head;
    PrevStudent := nil;

    // Поиск студента по указанным данным
    while Assigned(CurrentStudent) do
    begin
        if (CurrentStudent.code = GroupCode) and (CurrentStudent.name = Name)
        then
        begin
            // Найден студент, удаляем его из списка
            if Assigned(PrevStudent) then
                PrevStudent^.Next := CurrentStudent^.Next
            else
                head := CurrentStudent^.Next;

            // Освобождаем память, занятую узлом студента и его оценками
            FreeGrades(CurrentStudent.marks);
            Dispose(CurrentStudent);
            Exit; // Завершаем процедуру, так как студент найден и удален
        end;

        PrevStudent := CurrentStudent;
        CurrentStudent := CurrentStudent^.Next;
    end;
end;

procedure TFormMain.StringGridMainKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
    SelectedRow, Size, I, code: Integer;
    name: String;
    cur: PStudent;
begin
    If Key = VK_DELETE Then
    Begin
        SelectedRow := StringGridMain.Row;
        code := StrToInt(StringGridMain.Cells[0, SelectedRow]);
        Name := StringGridMain.Cells[1, SelectedRow];
        If SelectedRow > 0 Then
        Begin
            If Application.MessageBox('Вы действительно хотите удалить строку?',
              'Удалить строку', MB_YESNO + MB_ICONQUESTION) = ID_YES Then
            Begin

                For I := SelectedRow to StringGridMain.RowCount - 2 do
                Begin
                    StringGridMain.Cells[0, I] := StringGridMain.Cells
                      [0, I + 1];
                    StringGridMain.Cells[1, I] := StringGridMain.Cells
                      [1, I + 1];
                    StringGridMain.Cells[2, I] := StringGridMain.Cells
                      [2, I + 1];
                End;
                StringGridMain.RowCount := StringGridMain.RowCount - 1;

                DeleteStudent(GroupList, code, Name);

            End;
        End;

    End;

    If StringGridMain.RowCount = 1 Then
        FSave.Enabled := False
    Else
        FSave.Enabled := True;

end;

procedure TFormMain.TaskClick(Sender: TObject);
const
    str1 = 'Имеется упорядоченный по коду группы линейный односвязный список,';
    str2 = #10#13'содержащий сведения о студентах колледжа: код группы, фамилия и ';
    str3 = #10#13'инициалы студента, оценки. Требуется вывести код группы, фамилии и ';
    str4 = #10#13'инициалы всех студентов данной группы, у которых есть ';
    str5 = #10#13'оценки ниже четверки.';
begin
    Application.MessageBox(str1 + str2 + str3 + str4 + str5, 'Задание', 0)
end;

end.


----------------------------FormAdd----------------------------------------

unit Unit1;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus;

type
    TFormAdd = class(TForm)
        ButtonAdd: TButton;
        ButtonList: TButton;
        EditCode: TEdit;
        EditName: TEdit;
        EditMark: TEdit;
        Label1: TLabel;
        Label2: TLabel;
        Label3: TLabel;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
        procedure ButtonAddClick(Sender: TObject);
        procedure ButtonListClick(Sender: TObject);
        procedure EditCodeChange(Sender: TObject);
        procedure EditCodeKeyPress(Sender: TObject; var Key: Char);
        procedure EditMarkChange(Sender: TObject);
        procedure EditMarkKeyPress(Sender: TObject; var Key: Char);
        procedure EditNameChange(Sender: TObject);
        procedure EditNameKeyPress(Sender: TObject; var Key: Char);
        procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;

type

    PMarks = ^TMarks;

    TMarks = record
        subCode: Integer;
        mark: Integer;
        next: PMarks;
    end;

    PStudent = ^TStudent;

    TStudent = record
        code: Integer;
        name: String[20];
        marks: PMarks;
        next: PStudent;
    end;

var
    FormAdd: TFormAdd;
    head: PStudent;
    hd: PMarks;
    bol1, bol2, bol3: Boolean;
    GroupList: PStudent;
    arrOfGrade: array of Integer;

implementation

{$R *.dfm}

uses Unit2, Unit4;

function AddGrade(var head: PMarks; subCode, Grade: Integer): PMarks;
var
    NewGradeNode, LastGradeNode: PMarks;
begin
    New(NewGradeNode);
    NewGradeNode.subCode := subCode;
    NewGradeNode.mark := Grade;
    NewGradeNode^.next := nil;

    if head = nil then
        head := NewGradeNode
    else
    begin
        LastGradeNode := head;
        while LastGradeNode^.next <> nil do
            LastGradeNode := LastGradeNode^.next;
        LastGradeNode^.next := NewGradeNode;
    end;

    // сделали из процедуры функцию

    Result := NewGradeNode;
end;

function AddStudent(var head: PStudent; code: Integer; name: String;
  Grades: PMarks): PStudent;
var
    NewStudentNode, LastStudentNode: PStudent;
begin
    New(NewStudentNode);
    NewStudentNode.code := code;
    NewStudentNode.name := Name;
    NewStudentNode.marks := Grades;
    NewStudentNode^.next := nil;

    if head = nil then
        head := NewStudentNode
    else
    begin
        LastStudentNode := head;
        while LastStudentNode^.next <> nil do
            LastStudentNode := LastStudentNode^.next;
        LastStudentNode^.next := NewStudentNode;
    end;

    // сделали из процедуры функцию
    Result := NewStudentNode;
end;

procedure AddGradeToStudent(var head: PStudent; GroupCode: Integer;
  const name: string; subCode, Grade: Integer);
var
    CurrentStudent: PStudent;
    NewGrade: PMarks;
begin
    CurrentStudent := head;

    // Проверяем, существует ли студент с указанными данными
    while Assigned(CurrentStudent) do
    begin
        if (CurrentStudent.code = GroupCode) and (CurrentStudent.name = Name)
        then
        begin
            // Студент найден, добавляем оценку
            NewGrade := AddGrade(CurrentStudent.marks, subCode, Grade);
            Exit; // Завершаем процедуру, так как студент найден и оценка добавлена
        end;
        CurrentStudent := CurrentStudent^.next;
    end;

    // Если студент не найден, создаем новый элемент списка студентов и добавляем оценку
    CurrentStudent := AddStudent(head, GroupCode, Name, nil);
    AddGrade(CurrentStudent.marks, subCode, Grade);
end;


procedure TFormAdd.ButtonAddClick(Sender: TObject);
var
    J, I: Integer;
    Correct: Boolean;
    Size, code, mark: Integer;
    name, str, strOfGrade: String;

begin

    strOfGrade := EditMark.Text;

    str := '';
    I := 1;
    J := 0;
    Correct := True;

    while I <= Length(strOfGrade) + 1 do
    Begin
        If (strOfGrade[I] <> ' ') And (I <= Length(strOfGrade)) Then
            str := str + strOfGrade[I]
        Else
        Begin
            if ((str <> '') And (StrToInt(str) > 0) And (StrToInt(str) <= 10))
            then
            Begin
                SetLength(arrOfGrade, J + 1);
                arrOfGrade[J] := StrToInt(str);
                Inc(J);
                str := '';
            End;
        End;
        Inc(I);
    End;

    code := StrToInt(EditCode.Text);
    Name := EditName.Text;

    for I := 0 to Length(arrOfGrade) - 1 do
    Begin
        mark := arrOfGrade[I];
        AddGradeToStudent(GroupList, code, Name, code, mark);
    End;

    EditMark.Text := '';

    FormMain.FSave.Enabled := True;

end;

procedure TFormAdd.ButtonListClick(Sender: TObject);
var

    Size, I: Integer;

    CurrStudent: PStudent;
    CurrGrade: PMarks;
begin

    EditCode.Text := '';
    EditName.Text := '';
    EditMark.Text := '';

    I := FormMain.StringGridMain.RowCount;
    CurrStudent := GroupList;

    while Assigned(CurrStudent) do
    begin
        CurrGrade := CurrStudent.marks;

        FormMain.StringGridMain.Cells[0, I] := IntToStr(CurrStudent.code);
        FormMain.StringGridMain.Cells[1, I] := CurrStudent.name;

        while Assigned(CurrGrade) do
        begin
            FormMain.StringGridMain.Cells[2, I] := FormMain.StringGridMain.Cells[2, I] + IntToStr(CurrGrade.mark) + ' ';
            CurrGrade := CurrGrade^.next;
        end;

        Inc(I);
        FormMain.StringGridMain.RowCount := I;

        CurrStudent := CurrStudent^.next;
        // Переходим к следующему студенту
    end;

    If FormMain.StringGridMain.RowCount = 1 Then
        FormMain.FSave.Enabled := False
    Else
        FormMain.FSave.Enabled := True;

    ModalResult := MrOk;

end;

procedure TFormAdd.EditCodeChange(Sender: TObject);
var
    num: Integer;
begin
    bol1 := True;
    try
        num := StrToInt(EditCode.Text);
    except
        bol1 := False;
        EditCode.Text := '';
    end;
    if Length(EditCode.Text) <> 3 Then
        bol1 := False;

    If (bol1 = True) And (bol2 = True) and (bol3 = True) Then
        ButtonAdd.Enabled := True
    Else
        ButtonAdd.Enabled := False;

end;

procedure TFormAdd.EditCodeKeyPress(Sender: TObject; var Key: Char);
begin
    If not(Key in ['0' .. '9', #8, #13]) Then
        Key := #0;
    If (Key = #13) And (ButtonAdd.Enabled = True) Then
        ButtonAdd.Click;
end;

procedure TFormAdd.EditMarkChange(Sender: TObject);
var
    str, strOfGrade: String;
    Correct: Boolean;
    I, J: Integer;
begin

    bol3 := True;

    if (Length(EditMark.Text) = 0) or (EditMark.Text = '') then
        bol3 := False;

    If (bol1 = True) And (bol2 = True) and (bol3 = True) Then
        ButtonAdd.Enabled := True
    Else
        ButtonAdd.Enabled := False;

end;

procedure TFormAdd.EditMarkKeyPress(Sender: TObject; var Key: Char);
begin
    If not(Key in ['0' .. '9', ' ', #13, #8]) Then
        Key := #0;
    If (Key = #13) And (ButtonAdd.Enabled = True) Then
        ButtonAdd.Click;
end;

procedure TFormAdd.EditNameChange(Sender: TObject);
begin
    bol2 := True;
    If Length(EditName.Text) > 20 Then
    Begin
        EditName.Text := '';
        bol2 := False;
        Application.MessageBox('Максимальная длина строки', 'Ошибка', 0);
    End;

    If Length(EditName.Text) = 0 Then
        bol2 := False;

    If (bol1 = True) And (bol2 = True) and (bol3 = True) Then
        ButtonAdd.Enabled := True
    Else
        ButtonAdd.Enabled := False;
end;

procedure TFormAdd.EditNameKeyPress(Sender: TObject; var Key: Char);
begin
    If (Key = #13) And (ButtonAdd.Enabled = True) Then
        ButtonAdd.Click;
end;

procedure TFormAdd.FormCreate(Sender: TObject);
begin
    GroupList := nil;
end;

procedure TFormAdd.N1Click(Sender: TObject);
const
    str1 = '1. Код группы - трехзначное число'#13#10;
    str2 = '2. Максимальная длина строки имени - 20 символов'#13#10;
    str3 = '3. Оценки вводятся через пробел. При вводе чисел больше 10,'#13#10;
    str4 = 'они будут удалены при добавлении.'#13#10;
    str5 = '4. Если среди чисел нет которые находятся в диапазон от 1 до 10,'#13#10;
    str6 = 'то запись не будет добавлена в список.';
begin
    Application.MessageBox(str1 + str2 + str3 + str4 + str5 + str6, 'Инструкция', 0)
end;

end.


-----------------------------FormInfo------------------------------------------

unit Unit4;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.StdCtrls;

type
  TFormInfo = class(TForm)
    StringGridInfo: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
TArrRec = record
    code: Integer;
    name: String[20];
    mark: Real;
end;
TArray = array of TArrRec;

var
  FormInfo: TFormInfo;

implementation

{$R *.dfm}

uses unit1;

procedure SortList();
var
    I, J, Max: Integer;
    arr: TArray;
Begin
    For I := 1 to FormInfo.StringGridInfo.RowCount - 2 do
    Begin
        Max := I;
        For J := 1 to FormInfo.StringGridInfo.RowCount - 2 do
        Begin

        End;
    End;
End;

procedure TFormInfo.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    StringGridInfo.RowCount := 1;
end;

procedure TFormInfo.FormCreate(Sender: TObject);
begin
    StringGridInfo.RowCount := 1;
    StringGridInfo.Cells[0, 0] := 'Код';
    StringGridInfo.Cells[1, 0] := 'фамилия и инициалы';
end;

end.