Записи. Работа с бинарными файлами. Решение тематических задач.

В этом разделе попробуем решить задачи, охватывающие две последние темы: "Пакеты. Приватные и ограниченные приватные типы", и "Записи. Работа с бинарными файлами." Так как темы обширные, предлагаю Вам предварительно с ними ознакомится. Задачи довольно большие (для обучающего материала), поэтому пока их всего четыре. Они, в принципе, охватывают пройденный материал, но если что-то ещё придумаю - выложу.

  • Сформировать массив записей, описывающих следующую таблицу:

    Деталь Время обработки, мин
    Точение Сверление Шлифование

    В массиве должно быть не менее 10 записей. Итоговую таблицу нужно вывести на экран.

    P.S.: Для решения Задачи 2 понадобятся итоговые данные этой задачи. Поэтому в решение включено сохранение результата в файл, хотя в условии об этом не сказано

  • В итоге должно получиться нечто подобное (детали я придумал отфонаря, ибо ни разу не токарь):

    +----------------------------------------------------------------------------+
    |                                 |            Время обработки, мин          |
    |            Деталь               +------------------------------------------+
    |                                 | точение     | сверление    | шлифование  |
    +---------------------------------+-------------+--------------+-------------+
    |гвоздь                           |         5.00|          0.00|         3.20|
    |болт                             |        10.00|          0.00|         5.30|
    |шуруп                            |        15.00|          0.00|         4.70|
    |гайка                            |        12.00|          2.90|         2.70|
    |шайба                            |         3.00|          1.10|         1.70|
    |цилиндр                          |        15.00|         25.30|         4.60|
    |вал                              |         8.00|          0.00|         1.00|
    |анкер                            |         5.60|          0.00|         5.20|
    |кольцо уплотнительное            |         9.00|          0.50|         1.00|
    |шар                              |         6.00|          2.10|         1.70|
    +----------------------------------------------------------------------------+
    

  • with Ada.Text_IO; use Ada.Text_IO;
    with Ada.Float_Text_IO; use Ada.Float_Text_IO;
    with Ada.Strings; use Ada.Strings;
    with Ada.Sequential_IO;
     
    procedure main is
        Max_Name_Len : constant Integer := 100; --Ограничение названия детали - 100 символов
     
        type Detail is Record
            Name : String(1..Max_Name_Len); --Наименование детали
            Name_Len : Integer; --Реальная длина названия детали
            Whet : Float; --Точение
            Rub_Down : Float; --Шлифовка
            Drill : Float; --Сверление
        end Record;
     
        --Массив деталей
        type Vector is array(1..10) of Detail;
        det : Vector;
     
        --Итоговые данные этой задачи понадобятся для решения следующей задачи,
        --поэтому, предлагаю заранее сохранить результат выполнения программы в файл
        package Det_IO is new Ada.Sequential_IO(Detail);
        Det_File : Det_IO.File_Type;
        Det_File_Name : String := "Details.dat";
     
        procedure Print_Table(det : in Vector) is
        --Печатает таблицу на экране
        begin
            --Шапка таблицы
            Put_Line("+----------------------------------------------------------------------------+");
            Put_Line("|                                 |            Время обработки, мин          |");
            Put_Line("|            Деталь               +------------------------------------------+");
            Put_Line("|                                 | точение     | сверление    | шлифование  |");
            Put_Line("+---------------------------------+-------------+--------------+-------------+");
            --Заполнение таблицы
            for i in det'Range loop
                Put("|");
                --Вывод названия детали посимвольно с проверкой выхода за границы таблицы
                --Ширина первого поля таблицы - 33 символа
                for j in 1..det(i).Name_Len loop
                    Put(det(i).Name(j));
                    --Если название детали длинное, то оно займет несколько строк
                    if (j < det(i).Name_Len) and then (j rem 33 = 0) then
                        Put("|             |              |             |");
                        New_Line;
                        Put("|");
                    end if;
                    --Если количество выведенных в строке символов меньше,
                    --чем отведено под столбец, то заполним остаток пробелами
                    if j = det(i).Name_Len then
                        for k in 1..(33 - (j rem 33)) loop
                            Put(' ');
                        end loop;
                    end if;
                end loop;
                Put("|");
                --Ширина второго поля таблицы - 13 символов. Из них 10 до точки,
                --1 символ - сама точка и 2 символа после точки
                Put(Item => det(i).Whet, Fore => 10, Aft => 2, Exp => 0);
                Put("|");
                --Ширина третьего поля таблицы - 14 символов. Из них 11 до точки,
                --1 символ - сама точка и 2 символа после точки
                Put(Item => det(i).Drill, Fore => 11, Aft => 2, Exp => 0);
                Put("|");
                --Ширина четвертого поля таблицы - 13 символов. Из них 10 до точки,
                --1 символ - сама точка и 2 символа после точки
                Put(Item => det(i).Rub_Down, Fore => 10, Aft => 2, Exp => 0);
                Put("|");
                New_Line;
            end loop;
            --завершение таблицы
            Put_Line("+----------------------------------------------------------------------------+");
        end Print_Table;
     
    begin
        --Ввод деталей и времени их обработки
        for i in det'Range loop
            Put("Название детали: ");
            Get_Line(Item => det(i).Name, Last => det(i).Name_Len);
            --Проверка, не превышает ли длина вводимого названия допустимого количества символов
            if det(i).Name_len = Max_Name_Len then
                Skip_Line;
            end if;
            Put("Время точения, мин: ");
            Get(Item => det(i).Whet);
            Skip_Line;
            Put("Время сверления, мин: ");
            Get(Item => det(i).Drill);
            Skip_Line;
            Put("Время шлифовки, мин: ");
            Get(Item => det(i).Rub_Down);
            Skip_Line;
        end loop;
     
        --Вывод итоговой таблицы на экран
        Print_Table(det);
        --Для следующей задачи (задачи 2) нам понадобятся данные из таблицы,
        --поэтому предлагаю сохранить массив записей в файл
        Det_IO.Create(File => Det_File, Mode => Det_IO.Out_File, Name => Det_File_Name);
        for i in det'Range loop
            Det_IO.Write(File => Det_File, Item => det(i));
        end loop;
        --закрытие файла
        Det_IO.Close(File => Det_File);
    end main;

  • Используя итоговую таблицу из задачи 1 вывести список деталей с циклом обработки больше 10 минут:

    Деталь Время обработки, мин

  • В результате должно получиться нечто подобное:

    +----------------------------------------------------------------------------+
    |            Деталь               |            Время обработки, мин          |
    +---------------------------------+------------------------------------------+
    |болт                             |                                     15.30|
    |шуруп                            |                                     19.70|
    |гайка                            |                                     17.60|
    |цилиндр                          |                                     44.90|
    |анкер                            |                                     10.80|
    |кольцо уплотнительное            |                                     10.50|
    +----------------------------------------------------------------------------+
    

  • with Ada.Text_IO; use Ada.Text_IO;
    with Ada.Float_Text_IO; use Ada.Float_Text_IO;
    with Ada.Sequential_IO;
     
    procedure main is
        Max_Name_Len : constant Integer := 100; --Ограничение названия детали - 100 символов
     
        type Detail is Record
            Name : String(1..Max_Name_Len); --Наименование детали
            Name_Len : Integer; --Реальная длина названия детали
            Whet : Float; --Точение
            Rub_Down : Float; --Шлифовка
            Drill : Float; --Сверление
        end Record;
     
        --Массив деталей
        type Vector is array(1..10) of Detail;
        det : Vector;
     
        package Det_IO is new Ada.Sequential_IO(Detail);
        Det_File : Det_IO.File_Type;
        Det_File_Name : String := "Details.dat";
     
        i : Integer := 1;
     
        procedure Print_Table(det : in Vector) is
        --Печатает таблицу на экране
        begin
            --Шапка таблицы
            Put_Line("+----------------------------------------------------------------------------+");
            Put_Line("|            Деталь               |            Время обработки, мин          |");
            Put_Line("+---------------------------------+------------------------------------------+");
            --Заполнение таблицы
            for i in det'Range loop
                if det(i).Whet + det(i).Drill + det(i).Rub_Down > 10.0 then
                    Put("|");
                    --Вывод названия детали посимвольно с проверкой выхода за границы таблицы
                    --Ширина первого поля таблицы - 33 символа
                    for j in 1..det(i).Name_Len loop
                        Put(det(i).Name(j));
                        --Если название детали длинное, то оно займет несколько строк
                        if (j < det(i).Name_Len) and then (j rem 33 = 0) then
                            Put("|             |              |             |");
                            New_Line;
                            Put("|");
                        end if;
                        --Если количество выведенных в строке символов меньше,
                        --чем отведено под столбец, то заполним остаток пробелами
                        if j = det(i).Name_Len then
                            for k in 1..(33 - (j rem 33)) loop
                                Put(' ');
                            end loop;
                        end if;
                    end loop;
                    Put("|");
                    --Ширина второго поля таблицы - 42 символf. Из них 39 до точки,
                    --1 символ - сама точка и 2 символа после точки
                    Put(Item => (det(i).Whet + det(i).Drill + det(i).Rub_Down), Fore => 39, Aft => 2, Exp => 0);
                    Put("|");
                    New_Line;
                end if;
            end loop;
            --завершение таблицы
            Put_Line("+----------------------------------------------------------------------------+");
        end Print_Table;
     
    begin
        Det_IO.Open(File => Det_File, Mode => Det_IO.In_File, Name => Det_File_Name);
        while not Det_IO.End_Of_File(Det_File) and then i < det'Last loop
            Det_IO.Read(File => Det_File, Item => det(i));
            i := i + 1;
        end loop;
        Det_IO.Close(File => Det_File);
        Print_Table(det);    
    end main;

  • Для окончательной поломки мозга смоделируем очередь (как человеческая очередь в магазине, только вместо людей будем использовать целые числа). Итак, очередь реализует принцип "первый пришёл - первый ушёл". Максимальный размер очереди - 20. Необходимо придумать соответствующий тип данных, а также предусмотреть возможности "ухода" из очереди первого элемента (со смещением остальных элементов), добавления элемента в очередь и вывода всей очереди на экран. Для работы с очередью нужно создать меню выбора одной из операций: добавление в очередь, смещение очереди, вывод очереди на экран, выход из программы.

  • Основной файл (главный).

    main.adb

    with Queue_Pack;
    with Ada.Text_IO; use Ada.Text_IO;
    with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
     
    procedure main is
    	n : Integer := 0;
    	mq : Queue_Pack.MyQueue;
     
    	procedure Show_Menu is
    	--Выводит меню на экран
    	begin
    		Put_Line("1. Добавить элемент в очередь");
    		Put_Line("2. Продвинуть очередь"); --"Вытолкнуть" первый элемент из очереди
    		Put_Line("3. Показать очередь");
    		Put_Line("4. Выйти"); --Выход из программы
    	end Show_Menu;
     
    	function Get_Choice return Integer is
    	--Считывает, какой пункт меню выбрал пользователь
    		n : Integer;
    	begin
    		Put("Ваш выбор: ");
    		Get(Item => n);
    		return n;
    	end Get_Choice;
     
    begin
    	loop
    		Show_Menu; --Показать меню
    		n := Get_Choice; --Получить выбор пользователя
    		exit when n = 4; --Если выбран пункт меню, соответствующий выходу из программы
    		case n is
    			when 1 => Queue_Pack.Push(mq); --"Втолкнуть" элемент в очередь
    			when 2 => Queue_Pack.Pop(mq, n); --"Вытолкнуть" элемент из очереди
    			when 3 => Queue_Pack.Show_Queue(mq); --Показать очередь
    			when 4 => exit; --Выход из цикла
    			when others => Put_Line("Попробуй ещё раз!");
    		end case;
    	end loop;
    end main;

    [свернуть]

    Пакет, реализующий очередь и операции над ней: Queue_Pack

    queue_pack.ads

    package Queue_Pack is
    	type myQueue is private; --Очередь будет иметь приватный тип
    	type Vector is private;
    	Max_Len : constant Integer;
     
    	procedure Push(Q : in out myQueue); --Добавить элемент в очередь
    	procedure Pop(Q : in out myQueue; n : in out Integer); --Вытолкнуть элемент
    	procedure Show_Queue(Q : in myQueue); --Показать очередь
     
    private
    	Max_Len : constant Integer := 20; --Максимальная длина очереди
    	--Тип для создания массива, содержащего элементы очереди
    	type Vector is array(1..Max_Len) of Integer;
     
    	--Тип, непосредственно реализующий очередь
    	type myQueue is Record
    		Queue : Vector; --массив, содержащий очередь
    		Tail : Integer range 0..Max_Len := 0; --индекс последнего элемента очереди - хвост
    	end Record;
    end Queue_Pack;

    [свернуть]

    queue_pack.adb

    with Ada.Text_IO; use Ada.Text_IO;
    with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
     
    package body Queue_Pack is
     
    	function Get_Item return Integer is
    	--Считывает элемент с клавиатуры
    		n : Integer;
    	begin
    		Put("Следующий элемент очереди: ");
    		Get(Item => n);
    		return n;
    	end;
     
    	procedure Push(Q : in out myQueue) is
    	--Добавляет элемент в очередь
    		n : Integer;
    	begin
    		if Q.Tail = Max_Len then
    			Put_Line("Очередь заполнена. Нет места для добавления нового элемента!");
    		else
    			n := Get_Item; --Получить элемент с клавиатуры
    			Q.Tail := Q.Tail + 1; --Очередь выросла => хвост сдвинулся на 1
    			Q.Queue(Q.Tail) := n; --Запомнить последний (крайний) элемент
    		end if;
    	end Push;
     
    	procedure Pop(Q : in out myQueue; n : in out Integer) is
    	--"Выталкивает" элемент из очереди
    	begin
    		if Q.Tail = 0 then --Если в очереди нет элементов
    			Put_Line("Очередь пуста!");
    		else
    			n := Q.Queue(1); --Запомнить "вытолкнутый" элемент.
    			--Смещение очереди на один элемент: второй становится первым,
    			--первый - вторым и т.д, т.е. сдвигаем массив на 1 позицию влево
    			declare
    				i, j : Integer;
    			begin
    				i := 1;
    				j := 2;
    				while j <= Q.Tail loop
    					Q.Queue(i) := Q.Queue(j);
    					i := i + 1;
    					j := j + 1;
    				end loop;
    			end;
    			Q.Tail := Q.Tail - 1;
    		end if;
    	end Pop;
     
    	procedure Show_Queue(Q : in myQueue) is --Показывает очередь
    	begin
    		if Q.Tail = 0 then
    			Put_Line("Очередь пуста!");
    		else
    			for i in Q.Queue'Range loop
    				Put(Item => Q.Queue(i), Width => 0);
    				Put(" -> ");
    				exit when i = Q.Tail;
    			end loop;
    		end if;
    		New_Line;
    	end;
     
    begin
    	NULL;
    end Queue_Pack;

    [свернуть]

  • Написать программу, имитирующую работу склада. У каждого товара на складе есть 3 свойства: наименование, цена, количество. Цена может варьироваться от 0.0 до 10 000 000.0. Всего на складе может быть не более 1000 наименований товаров. Необходимо реализовать возможности добавления товара на склад, его удаление, выдачу, вывод информации о всех товарах на экран, сохранение данных в файл, загрузку данных из файла и выход из программы. Доступ к операциям нужно реализовать с помощью меню.

  • 1. Добавить товар на склад
    2. Удалить товар со склада
    3. Показать все товары на складе
    4. Выдать товар со склада
    5. Сохранить данные в файл
    6. Загрузить данные из файла
    7. Выход
    1
    Наименование товара: Уголь
    Цена единицы товара: 100
    Количество товара: 1500
    1. Добавить товар на склад
    2. Удалить товар со склада
    3. Показать все товары на складе
    4. Выдать товар со склада
    5. Сохранить данные в файл
    6. Загрузить данные из файла
    7. Выход
    1
    Наименование товара: Дрова
    Цена единицы товара: 150
    Количество товара: 1120
    1. Добавить товар на склад
    2. Удалить товар со склада
    3. Показать все товары на складе
    4. Выдать товар со склада
    5. Сохранить данные в файл
    6. Загрузить данные из файла
    7. Выход
    3
    -----------------------------------------------
    Товар № 1
    Наименование: Уголь
    Цена товара: 100.00
    Количество товара: 1500
    -----------------------------------------------
    Товар № 2
    Наименование: Дрова
    Цена товара: 150.00
    Количество товара: 1120
    -----------------------------------------------
    Нажмите для продолжения любую клавишу.
    

  • Основной файл

    main.adb

    with Valt_Pack;
    with Menu_Pack;
    with Ada.Text_IO;
     
    procedure main is
        Goods : Valt_Pack.Valt;
        Choice : Integer;
    begin
        Valt_Pack.Set_Valt(Goods); --Начальная инициализация склада (обнуление);
        loop
            Menu_Pack.Show_Menu; --Показать меню
            Choice := Menu_Pack.Get_Choice; --Получить выбор пользователя
            --Обработка пользовательского выбора
            case Choice is
                when 1 => Valt_Pack.Add_Product(Goods); --Добавить товар на склад
                when 2 => Valt_Pack.Delete_Product(Goods); --Удалить товар со склада
                when 3 => Valt_Pack.Show_Goods(Goods); --Показать все товары на складе
                when 4 => Valt_Pack.Take_Product(Goods); --Получить товар со склада
                when 5 => Valt_Pack.Save_Valt(Goods); --Сохранить данные о товарах в файл
                when 6 => Valt_Pack.Load_Valt(Goods); --Загрузить данные о товарах из файла
                when 7 => exit;
                when others => Ada.Text_IO.Put_Line("Некорректный ввод! Попробуйте ещё!");
            end case;
        end loop;
        Ada.Text_IO.Put_Line("Наше Вам с кисточкой!");
    end main;

    [свернуть]

    Пакет, реализующий меню

    menu_pack.ads

    package menu_pack is
        Exit_Program : constant Integer := 7;
     
        procedure Show_Menu; --Показать меню
        function Get_Choice return Integer; --Выбор пользователя
    end menu_pack;

    [свернуть]

    menu_pack.adb

    with Ada.Text_IO;
    with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
    with Ada.Text_IO.Unbounded_IO;
     
    package body menu_pack is
        --Для обработки пользовательского выбора (см. функцию Get_Choice)
        type AnsVar is array(1..Exit_Program) of Ada.Strings.Unbounded.Unbounded_String;
        Answers : AnsVar := (Ada.Strings.Unbounded.To_Unbounded_String("1"),
                             Ada.Strings.Unbounded.To_Unbounded_String("2"),
                             Ada.Strings.Unbounded.To_Unbounded_String("3"),
                             Ada.Strings.Unbounded.To_Unbounded_String("4"),
                             Ada.Strings.Unbounded.To_Unbounded_String("5"),
                             Ada.Strings.Unbounded.To_Unbounded_String("6"),
                             Ada.Strings.Unbounded.To_Unbounded_String("7")
                            );
     
        procedure Show_Menu is
        --Вывод меню на экран
        begin
                Ada.Text_IO.Put_Line("1. Добавить товар на склад");
                Ada.Text_IO.Put_Line("2. Удалить товар со склада");
                Ada.Text_IO.Put_Line("3. Показать все товары на складе");
                Ada.Text_IO.Put_Line("4. Выдать товар со склада");
                Ada.Text_IO.Put_Line("5. Сохранить данные в файл");
                Ada.Text_IO.Put_Line("6. Загрузить данные из файла");
                Ada.Text_IO.Put_Line("7. Выход");
        end Show_Menu;
     
        function Get_Choice return Integer is
        --Считывает выбор пользователя
            --Если пользователь введёт не цифры, а буквы, то будет возбуждено
            --исключение. Чтобы этого не произошло, выбор пользователя
            --будет считываться в СТРОКУ
            ans : Ada.Strings.Unbounded.Unbounded_String;
            Accord : Boolean := False;
        begin
            ans := Ada.Text_IO.Unbounded_IO.Get_Line;
            for i in Answers'Range loop
                if ans = Answers(i) then
                    Accord := True;
                    exit;
                end if;
            end loop;
            if Accord = False then
                return 0;
            else
                return Integer'Value(Ada.Strings.Unbounded.To_String(ans));
            end if;
        end Get_Choice;
     
    begin
        NULL;
    end menu_pack;

    [свернуть]

    Пакет, реализующий работу со складом

    valt_pack.ads

    package valt_pack is
     
        Max_Place : constant Integer := 1_000; --Максимальное число позиций (наименований) на складе
        Max_Name_Len : constant Integer := 255; --Максимальная длина наименования товара
        type Price_Money is Delta 0.01 range 0.0..10_000_000.0; --Тип для цены
        Prod_Num : Integer range 0..Max_Place; --Реальное количество товаров на складе.
        File_Name : constant String := "valt.dat";
     
        type Product is private; --Товар
        type Valt is array(1..Max_Place) of Product; --Непосредственно склад
     
        procedure Set_Valt(vl : in out Valt); --Инициализация склада
        --Показать все товары
        procedure Show_Goods(Goods : in Valt);
        --Добавление товара на склад
        procedure Add_Product(Goods : in out Valt);
        procedure Delete_Product(Goods : in out Valt);
        procedure Take_Product(Goods : in out Valt);
        procedure Save_Valt(Goods : in Valt);
        procedure Load_Valt(Goods : in out Valt);
     
    private
     
        type Product is Record --Тип для описания товара
            Price : Price_Money;    --Цена товара
            Name : String(1..Max_Name_Len); --Наименование товара
            Name_Len : Integer range 0..Max_Name_Len; --Длина наименования товара
            Number : Integer; --Количество товара
        end Record;
     
    end valt_pack;

    [свернуть]

    valt_pack.adb

    with Ada.Text_IO;
    with Ada.Integer_Text_IO;
    with Ada.Sequential_IO;
     
    package body valt_pack is
        --Пакет для файловых операций со списком товаров
        package Valt_IO is new Ada.Sequential_IO(Product);
     
        --------------------------------------------------------------------
        procedure Set_Valt(vl : in out Valt) is
        --Начальная инициализация склада: Обнуляем всё и очищаем строку (название товара) от мусора
        begin
            vl := (others => (Price => 0.0, Name => (others => ' '), Name_Len => 0, Number => 0));
            Prod_Num := 0; --Изначально на складе нет товаров
        end Set_Valt;
     
        --------------------------------------------------------------------
        procedure Show_Goods(Goods : in Valt) is
        --Показывает все товары на складе
            cnt : Integer := 0; --Номер товара
            ch : Character;
            --Так как цена у нас имеет тип с фиксированной точкой,
            --создаем пакет для операций ввода-вывода с этим типом
            package Price_IO is new Ada.Text_IO.Fixed_IO(Price_Money);
        begin
            if Prod_Num = 0 then --Если товаров на складе нет
                Ada.Text_IO.Put_Line("Склад пуст!");
            else --Если товары на складе есть, то выводим информацию о них
                for i in Goods'Range loop
                    if Goods(i).Number /= 0 then
                        cnt := cnt + 1;
                        Ada.Text_IO.Put_Line("-----------------------------------------------");
                        Ada.Text_IO.Put_Line("Товар №" & Integer'Image(cnt));
                        Ada.Text_IO.Put_Line("Наименование: " & (Goods(i).Name(1..Goods(i).Name_Len)));
                        Ada.Text_IO.Put("Цена товара: ");
                        Price_IO.Put(Item => Goods(i).Price, Fore => 1, Aft => 2, Exp => 0);
                        Ada.Text_IO.New_Line;
                        Ada.Text_IO.Put_Line("Количество товара:" & Integer'Image(Goods(i).Number));
                    end if;
                    --Если показаны все товары, которые есть в наличии, то нет смысла
                    --пробегать до конца весь массив:
                    exit when cnt = Prod_Num;
                end loop;
                Ada.Text_IO.Put_Line("-----------------------------------------------");
            end if;
            Ada.Text_IO.Put_Line("Нажмите для продолжения любую клавишу.");
            Ada.Text_IO.Get_Immediate(ch);
        end Show_Goods;
     
        --------------------------------------------------------------------
     
        function Get_Product(Goods : Valt; str : String; str_Len : Integer) return Integer is
        --Ищет товар по названию и возвращает его индекс или 0, если товара на складе нет
        --Внимание: Функция доступна только внутри этого файла!
            index : Integer := 0;
        begin
            for i in Goods'Range loop
                if Goods(i).Name(1..Goods(i).Name_Len) = str(str'First..str_Len) and then Goods(i).Number /= 0 then
                    index := i;
                end if;
                exit when index /= 0;
            end loop;
            return index;
        end Get_Product;
        --------------------------------------------------------------------
     
        procedure Add_Product(Goods : in out Valt) is
        --Добавляет новый товар на склад
            index : Integer := 0;
            ch : Character;
            str : String(1..Max_Name_Len);
            str_Len : Integer;
            col : Integer;
            package Price_IO is new Ada.Text_IO.Fixed_IO(Price_Money);
        begin
            Ada.Text_IO.Put("Наименование товара: ");
            Ada.Text_IO.Get_Line(Item => str, Last => str_Len);
            if str_Len = Max_Name_Len then
                Ada.Text_IO.Skip_Line;
            end if;    
     
            --Если товаров на складе нет:
            if Prod_Num = 0 then
                index := 1;
            else
                index := Get_Product(Goods, str, str_Len);
                if index = 0 then --Если товара с указанным названием на складе нет:
                    --Так как массив товаров может быть заполнен не подряд (например, если
                    --какой-то товар убыл удалён, то на его месте образуется пустой
                    --элемент, т.е. количество товара в этой ячейке равно 0),
                    --то ищем первую пустую позицию для внесения товара в эту позицию:
                    for i in Goods'First..Goods'Last loop
                        if Goods(i).Number = 0 then
                            index := i;
                        end if;
                        --Если для товара найдено место, то можно прервать поиск
                        exit when index /= 0;
                    end loop;
                end if;
            end if;
     
            --Если на складе есть место для нового товара, то вводим информацию
            if index <= Goods'Last then
                Goods(index).Name := str; --Сохраняем название товара
                Goods(index).Name_Len := str_Len; --Длина названия товара
                --Проверку на корректность вводимых данных я не делаю! Оставляю это на Ваше усмотрение
                Ada.Text_IO.Put("Цена единицы товара: ");
                Price_IO.Get(Goods(index).Price);
                Ada.Text_IO.Put("Количество товара: ");
                Ada.Integer_Text_IO.Get(col);
                Goods(index).Number := Goods(index).Number + col;
                Ada.Text_IO.Skip_Line;
                Prod_Num := Prod_Num + 1; --Количество наименований товара на складе увеличилось
            --Если на складе нет места под новый товар:
            elsif index = 0 then
                Ada.Text_IO.Put_Line("Склад полностью заполнен! Для нового товара нет места!");
                Ada.Text_IO.Put_Line("Нажмите для продолжения любую клавишу.");
                Ada.Text_IO.Get_Immediate(ch);
            end if;
        end Add_Product;
     
        --------------------------------------------------------------------
        procedure Delete_Product(Goods : in out Valt) is
        --Удаляет товар со склада
            index : Integer;
            str : String(1..Max_Name_Len);
            str_Len : Integer range 1..Max_Name_Len;
            ch : Character;
        begin
            if Prod_Num = 0 then --Если товаров на складе нет
                Ada.Text_IO.Put_Line("Склад пуст!");
            else
                Ada.Text_IO.Put_Line("Какой товар нужно удалить со склада?");
                Ada.Text_IO.Put("Название: ");
                Ada.Text_IO.Get_Line(Item => str, Last => str_Len);
                index := Get_Product(Goods, str, str_Len);
                if index = 0 then --Если указанного товара нет на складе
                    Ada.Text_IO.Put_Line("Товар " & str(1..str_Len) & " на складе не обнаружен!");
                else --Если указанный товар на складе есть
                    --Выставляем количество товара равным 0 и цену = 0.0, помечая тем самым, что эта
                    --ячейка пуста и свободна для записи в неё другого товара.
                    Goods(index).Number := 0;
                    Goods(index).Price := 0.0;
                    Prod_Num := Prod_Num - 1; --Количество наименований товаров уменьшилось
                    Ada.Text_IO.Put_Line("Товар " & str(1..str_Len) & " удалён!");
                end if;
            end if;
            Ada.Text_IO.Put_Line("Нажмите для продолжения любую клавишу.");
            Ada.Text_IO.Get_Immediate(ch);
        end;
        --------------------------------------------------------------------
     
        procedure Take_Product(Goods : in out Valt) is
        --Получить товар со склада
            index : Integer := 0;
            str : String(1..Max_Name_Len);
            str_Len : Integer range 1..Max_Name_Len;
            col : Integer;
            ch : Character;
        begin
            if Prod_Num = 0 then --Если товаров на складе нет
                Ada.Text_IO.Put_Line("Склад пуст!");
            else --Если товары на складе есть
                Ada.Text_IO.Put_Line("Какой товар Вы желаете получить?");
                Ada.Text_IO.Put("Наименование: ");
                Ada.Text_IO.Get_Line(Item => str, Last => str_Len);
                index := Get_Product(Goods, str, str_Len);
                if index = 0 then
                    Ada.Text_IO.Put_Line("Товар " & str(str'First..str_Len) & " на складе не обнаружен!");
                else
                    loop
                        Ada.Text_IO.Put_Line("Сейчас в наличии" & Integer'Image(Goods(index).Number) & " единиц товара " & str(str'First..str_Len));
                        Ada.Text_IO.Put("Сколько Вы желаете получить? -> ");
                        Ada.Integer_Text_IO.Get(col);
                        Ada.Text_IO.Skip_Line;
                        --Пока не введена разумная цифра будет крутится цикл.
                        --Проверку на корректность ввода именно цифровой информации
                        --я не делаю
                        exit when col > 0  and then col <= Goods(index).Number;
                    end loop;
                    --Выдача товара со склада:
                    Goods(index).Number := Goods(index).Number - col;
                    Ada.Text_IO.Put_Line("Вам выдано " & Integer'Image(col) & " единиц товара!");
                    --Если получен весь товар, то уменьшаем количество наименований
                    --товаров на складе
                    if Goods(index).Number = 0 then
                        Goods(index).Price := 0.0;
                        Prod_Num := Prod_Num - 1;
                    end if;
                end if;
            end if;
            Ada.Text_IO.Put_Line("Нажмите для продолжения любую клавишу.");
            Ada.Text_IO.Get_Immediate(ch);
        end Take_Product;
     
        --------------------------------------------------------------------
        procedure Save_Valt(Goods : in Valt) is
        --Сохранить информацию в файл
            Valt_File : Valt_IO.File_Type;
            ch : Character;
        begin
            Valt_IO.Create(File => Valt_File, Mode => Valt_IO.Out_File, Name => File_Name);
     
            for i in Goods'Range loop
                Valt_IO.Write(File => Valt_File, Item => Goods(i));
                exit when i = Prod_Num;
            end loop;
     
            Valt_IO.Close(Valt_File);
            Ada.Text_IO.Put_Line("Данные сохранены!");
            Ada.Text_IO.Put_Line("Нажмите для продолжения любую клавишу.");
            Ada.Text_IO.Get_Immediate(ch);
        end Save_Valt;
     
        --------------------------------------------------------------------
        procedure Load_Valt(Goods : in out Valt) is
        --Загрузить информацию из файла
            Valt_File : Valt_IO.File_Type;
            ch : Character;
        begin
            Prod_Num := 0;
            Valt_IO.Open(File => Valt_File, Mode => Valt_IO.In_File, Name => File_Name);
            while not Valt_IO.End_Of_File(Valt_File) loop
                Prod_Num := Prod_Num + 1;
                Valt_IO.Read(File => Valt_File, Item => Goods(Prod_Num));
            end loop;
            Valt_IO.Close(Valt_File);
            Ada.Text_IO.Put_Line("Данные загружены!");
            Ada.Text_IO.Put_Line("Нажмите для продолжения любую клавишу.");
            Ada.Text_IO.Get_Immediate(ch);
        end Load_Valt;
        --------------------------------------------------------------------
     
    begin
        NULL;
    end valt_pack;

    [свернуть]

2 comments on “Записи. Работа с бинарными файлами. Решение тематических задач.

  1. Здравствуйте.
    Очень полезная и интересная статья!
    Спасибо Вам за эту информацию.

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *