Программа
DEF FNMenu$ 'Вывод меню и сканинг клавиатуры
CLS 'Очистка экрана
'Вывод меню:
PRINT " Главное меню: "
PRINT "[1] Создание файла"
PRINT "[2] Просмотр файла"
PRINT "[3] Печать файла "
PRINT "[4] Редактирование"
PRINT "[0] Выход "
DO
Buf$ = INPUT$(1) 'Чтение клавиатуры
LOOP WHILE Buf$ <> "1" AND Buf$ <> "2" AND Buf$ <> "3" AND Buf$ <> "4" AND Buf$ <> "0" AND Buf$ <> CHR$(27)
'Выход из цикла при получении корректного ответа
FNMenu$ = Buf$ 'Определение значения функции
END DEF
DEF FNQuestion$ (Question$) 'Функция получения ответа на вопрос
PRINT Question$ 'Вывод вопроса
DO
Buf$ = INPUT$(1) 'Чтение клавиатуры
LOOP WHILE Buf$ <> "Y" AND Buf$ <> "y" AND Buf$ <> "n" AND Buf$ <> "n"
'Выход из цикла при получении корректного ответа
IF Buf$ = "Y" OR Buf$ = "y" THEN 'Определение значения функции по ответу
FNQuestion$ = "YES"
ELSE
FNQuestion$ = "NO"
END IF
END DEF
SUB ClrLine 'Процедура очистки строки от текущей позиции до конца экрана
'Фиксирование текущей позиции курсора:
StartColumn% = POS(0)
StartLine% = CSRLIN
FOR Column% = StartColumn% TO 80
'Цикл забоя строки пробелами от текущей позиции до конца экрана
PRINT " "; 'Вывод пробела
NEXT Column%
LOCATE StartLine%, StartColumn% 'Возврат курсора
END SUB
SUB EditDD (D1%, D2!, D3!, D4!, D5!, D6!, D7!)
'Процедура редактирования полей записи
CLS 'Очистка экрана
'Вывод редактируемой записи:
PRINT " Цех "; D1%
PRINT " Статьи расходов:"
PRINT "[1] Материалы "; D2!
PRINT "[2] Заработная плата "; D3!
PRINT "[3] Отчисления на соцстрах "; D4!
PRINT "[4] Цеховые расходы "; D5!
PRINT "[5] Стоимость реализации брака "; D6!
PRINT "[6] Удержание за брак "; D7!
PRINT
PRINT "[0] Выход"
FlagExit$ = "" 'Сброс флага "Выход"
DO 'Цикл редактирования записи
SELECT CASE INPUT$(1) 'Выбор действия по ответу
CASE "1"
LOCATE 3, 32 'Установка курсора
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
INPUT , D2! 'Ввод нового значения поля записи
LOCATE 3, 32 'Установка курсора
PRINT D2!; 'Вывод нового значения поля записи
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
CASE "2"
LOCATE 4, 32 'Установка курсора
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
INPUT , D3! 'Ввод нового значения поля записи
LOCATE 4, 32 'Установка курсора
PRINT D3!; 'Вывод нового значения поля записи
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
CASE "3"
LOCATE 5, 32 'Установка курсора
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
INPUT , D4! 'Ввод нового значения поля записи
LOCATE 5, 32 'Установка курсора
PRINT D4!; 'Вывод нового значения поля записи
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
CASE "4"
LOCATE 6, 32 'Установка курсора
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
INPUT , D5! 'Ввод нового значения поля записи
LOCATE 6, 32 'Установка курсора
PRINT D5!; 'Вывод нового значения поля записи
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
CASE "5"
LOCATE 7, 32 'Установка курсора
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
INPUT , D6! 'Ввод нового значения поля записи
LOCATE 7, 32 'Установка курсора
PRINT D6!; 'Вывод нового значения поля записи
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
CASE "6"
LOCATE 8, 32 'Установка курсора
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
INPUT , D7! 'Ввод нового значения поля записи
LOCATE 8, 32 'Установка курсора
PRINT D7!; 'Вывод нового значения поля записи
CALL ClrLine 'Очистка строки от положения курсора до конца экрана
CASE "0", CHR$(27)
FlagExit$ = "EXIT" 'Установка флага "Выход"
END SELECT
LOOP WHILE FlagExit$ <> "EXIT"
END SUB
SUB RewriteFile (Number%, NewD1%, NewD2!, NewD3!, NewD4!, NewD5!, NewD6!, NewD7!)
'Процедура перезаписи файла
OPEN "DATA" FOR INPUT AS #1 'Открытие файла под под чтение
OPEN "DATA_2" FOR OUTPUT AS #2 'Открытие файла под под запись
MeterNumber% = 0 'Обнуление счетчика записей
WHILE NOT EOF(1) 'Цикл копирования файла
MeterNumber% = MeterNumber% + 1 'Подсчет номера записи
INPUT #1, D1%, D2!, D3!, D4!, D5!, D6!, D7! 'Чтение записи из файла
IF Number% <> MeterNumber% THEN
PRINT #2, D1%, D2!, D3!, D4!, D5!, D6!, D7!
ELSE
PRINT #2, NewD1%, NewD2!, NewD3!, NewD4!, NewD5!, NewD6!, NewD7!
'Запись информации в файл
END IF
WEND
CLOSE #1, #2 'Закрытие файлов
KILL "DATA" 'Уничтожение старого файла
NAME "DATA_2" AS "DATA" 'Переименовывание нового файла
END SUB
SUB EditRecord (Number%) 'Процедура редактирования записи
MeterNumber% = 0 'Обнуление счетчика номеров
OPEN "DATA" FOR INPUT AS #1 'Открытие файла под под чтение
'Поиск заданной записи:
WHILE NOT EOF(1) AND Number% <> MeterNumber% 'Цикл просмотра файла
MeterNumber% = MeterNumber% + 1 'Подсчет номера записи
INPUT #1, D1%, D2!, D3!, D4!, D5!, D6!, D7! 'Чтение записи из файла
WEND
CLOSE #1 'Закрытие файла
IF Number% = MeterNumber% THEN
CALL EditDD(D1%, D2!, D3!, D4!, D5!, D6!, D7!)
'Редактирование полей записи
CALL RewriteFile(Number%, D1%, D2!, D3!, D4!, D5!, D6!, D7!)
'Перезапись файла
ELSE
PRINT "Запись не найдена"; CHR$(7)
'Вывод сообщения при отсутствии записи в фалйе
PRINT "Нажмите клавишу" 'Вывод приглашения нажать клавишу
Buf$ = INPUT$(1) 'Чтение клавиатуры для остановки программы
END IF
END SUB
SUB EditFile 'Процедура редактирования файла
CLS 'Очистка экрана
WHILE FNQuestion$("Отредактировать запись? [Y/N]") = "YES"
'Цикл редактирования записей
INPUT "Введите номер редактируемой записи ", NumberRecord%
'Ввод номера редактируемой записи
CALL EditRecord(NumberRecord%) 'Редактирование записи
CLS 'Очистка экрана
WEND
END SUB
SUB Make 'Процедура создания файла
CLS 'Очистка экрана
OPEN "DATA" FOR OUTPUT AS #1 'Открытие файла под запись
WHILE FNQuestion$("Создать запись? [Y/N]") = "YES"
'Ввод данных по цеху:
INPUT "Введите номер цеха ", D1%
PRINT "Введите статьи расходов: "
INPUT "Материалы ", D2!
INPUT "Заработная плата ", D3!
INPUT "Отчисления на соцстрах ", D4!
INPUT "Цеховые расходы ", D5!
INPUT "Стоимость реализации брака ", D6!
INPUT "Удержание за брак ", D7!
PRINT #1, D1%, D2!, D3!, D4!, D5!, D6!, D7! 'Вывод данных по цеху в файл
WEND
CLOSE #1 'Закрытие файла
END SUB
SUB Viewer (OutFile$) 'Процедура просмотра файла
OPEN OutFile$ FOR OUTPUT AS #2 'Открытие файла под под запись
IF OutFile$ = "CON" THEN CLS 'Очистка экрана
'Вывод шапки таблицы:
PRINT #2, "╔════════╤═══════╤══════════╤═══════╤═══════╤═══════╤═══════╤═══════╤═══════╗"
PRINT #2, "║ Цех │Матери-│Заработная│ Соц/ │Цеховые│ ИТ1 │Реализ.│ Удерж.│ ИТ2 ║"
PRINT #2, "║ │ алы │ плата │ страх │расходы│ │ брака │за брак│ ║"
PRINT #2, "╟────────┼───────┼──────────┼───────┼───────┼───────┼───────┼───────┼───────╢"
Format$ = "║ ### │ ###.##│ ###.## │ ###.##│ ###.##│ ###.##│ ###.##│ ###.##│ ###.##║"
'Определение формата вывода
OPEN "DATA" FOR INPUT AS #1 'Открытие файла под чтение
'Обнуление итогов:
ItogD2! = 0
ItogD3! = 0
ItogD4! = 0
ItogD5! = 0
ItogIT1! = 0
ItogD6! = 0
ItogD7! = 0
ItogIT2! = 0
ShopMeter% = 0 'Обнуление счетчика цехов
WHILE NOT EOF(1) 'Цикл просмотра файла до конца
ShopMeter% = ShopMeter% + 1 'Подсчет цехов
INPUT #1, D1%, D2!, D3!, D4!, D5!, D6!, D7! 'Чтение информации из файла
'Подсчет итогов по цеху:
IT1! = D2! + D3! + D4! + D5!
IT2! = IT1! - D6! - D7!
PRINT #2, USING Format$; D1%; D2!; D3!; D4!; D5!; IT1!; D6!; D7!; IT2!
'Печать информации
IF ShopMeter% = 1 OR ShopMeter% = 6 THEN 'Если проходит первая
'или шестая запись, то обнуление промежуточных итогов:
ItogD2P! = 0
ItogD3P! = 0
ItogD4P! = 0
ItogD5P! = 0
ItogIT1P! = 0
ItogD6P! = 0
ItogD7P! = 0
ItogIT2P! = 0
END IF
IF ShopMeter% <= 10 THEN 'Подсчет промежуточных итогов:
ItogD2P! = ItogD2P! + D2!
ItogD3P! = ItogD3P! + D3!
ItogD4P! = ItogD4P! + D4!
ItogD5P! = ItogD5P! + D5!
ItogIT1P! = ItogIT1P! + IT1!
ItogD6P! = ItogD6P! + D6!
ItogD7P! = ItogD7P! + D7!
ItogIT2P! = ItogIT2P! + IT2!
END IF
IF ShopMeter% = 5 OR ShopMeter% = 10 THEN 'Вывод промежуточных итогов:
ItogPFormat$ = "║ Итог ##│ ###.##│ ###.## │ ###.##│ ###.##│ ###.##│ ###.##│ ###.##│ ###.##║"
'Определение формата вывода промежуточного итога
PRINT #2, USING ItogPFormat$; ShopMeter%; ItogD2P!; ItogD3P!; ItogD4P!; ItogD5P!; ItogIT1P!; ItogD6P!; ItogD7P!; ItogIT2P!
'Печать промежуточных итогов
END IF
IF ShopMeter% > 10 THEN 'Подсчет итогов по оставшимся цехам:
ItogD2! = ItogD2! + D2!
ItogD3! = ItogD3! + D3!
ItogD4! = ItogD4! + D4!
ItogD5! = ItogD5! + D5!
ItogIT1! = ItogIT1! + IT1!
ItogD6! = ItogD6! + D6!
ItogD7! = ItogD7! + D7!
ItogIT2! = ItogIT2! + IT2!
END IF
WEND
ItogFormat$ = "║ Итог │ ###.##│ ###.## │ ###.##│ ###.##│ ###.##│ ###.##│ ###.##│ ###.##║"
'Определение формата вывода итога
PRINT #2, "╟────────┼───────┼──────────┼───────┼───────┼───────┼───────┼───────┼───────╢"
PRINT #2, USING ItogFormat$; ItogD2!; ItogD3!; ItogD4!; ItogD5!; ItogIT1!; ItogD6!; ItogD7!; ItogIT2!
'Печать итогов по оставшимся цехам
PRINT #2, "╚════════╧═══════╧══════════╧═══════╧═══════╧═══════╧═══════╧═══════╧═══════╝"
'Закрытие таблицы
IF OutFile$ = "CON" THEN 'Если таблица выводится на монитор, то
PRINT "Нажмите клавишу";
'Вывод приглашения нажать клаваишу
Buf$ = INPUT$(1)
'Чтение клавиатуры для остановки программы
END IF
CLOSE #1, #2 'Закрытие файлов
END SUB
'-------------------------------------------------------------------------------
FlagExit$ = "" 'Сброс флага "Выход"
DO 'Главный цикл
SELECT CASE FNMenu$ 'Выбор действия по ответу на меню
CASE "1"
CALL Make 'Создание файла
CASE "2"
CALL Viewer("CON") 'Просмотр файла
CASE "3"
CALL Viewer("LPT1") 'Печать файла
CASE "4"
CALL EditFile 'Редактирование файла
CASE "0", CHR$(27)
FlagExit$ = "EXIT" 'Установка флага выход
END SELECT
LOOP WHILE FlagExit$ <> "EXIT"
END
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию