Файл с текстом программы (kurs. pas) имеет размер, равный 12,5 Kb; Исполняемый файл (kurs. exe) имеет размер 33,3 Kb;

В программе используются следующие переменные:

Bas – запись.

type bas=record n : integer; e1, e2, e3 : integer; e4 : real; end; Где: n - номер продукции; e1 - переходящий остаток продукции на начало года ; e2 - приход продукции; e3 – расход; e4 - цена за 1 шт.

menu2 – метка, используется для работы с главным меню программы;

C : char, используется для работы оператора readkay (читает символ с клавиатуры без эхоповтора на экране) ;

O : real используется для редактирования записей.

ww, l, nn, q, i, gd, gm : integer; ww-используется для вывода шапки таблицы (координата по Y) .

l-используется для работы с меню и для удаления записи nn, q- используется в программе для создание новых записей i-счетчик gd, gm - для графики: gd – определяет тип графического драйвера, gm – переменная, задающая режим работы графического адаптера;

pp, qq, n, mm : integer; - переменные для добавления новой записи;

f, f2 : file of bas; - файлы a, b : bas; a, b - переменные, содержащие записи типа Bas.

Переменная b используется для удаления записей.

st : real; st – для вычисления суммы в таблице

procedure view (w: integer) ; - процедура вывода таблицы, где w–координата по Х; var

itog: real; -для вычисления итогового значения сумма в таблице; Procedure menu ; - процедура вывода меню; Procedure zast ; - процедура вывода графической заставки var xm, ym : integer; xm, ym-координаты для вывода граф. объектов

size : integer; saucer : pointer;

k, kk : integer; size, saucer, k, kk-для движения Procedure error ; - процедура вывода сообщения об ошибке Procedure exitt ; - процедура выхода из программы

При запуски программы идет подключение дополнительных модулей Crt и Graph: uses crt, graph; Описание переменных (см. пункт 5.4) Описание процедур:

Процедура вывода таблицы на экран - view : Установка текстового окна на экране для вывода шапки с координатами левого верхнего угла -1,1 и правого нижнего – 80,6 window(1,1,80,6) ; Установка цвета фона и символов textbackground(5) ;textcolor(15) ; Печать названия таблицы gotoxy(w, 1) ;write('Реализация продукции за год') ; textcolor(9) ;gotoxy(w-16,2) ;textbackground(0) ; write('--------------------------------------------------------------') ; Установка цвета символов и печать шапки таблицы textcolor(15) ; gotoxy(w-15,4) ;write('N') ; gotoxy(w-13,3) ;write('Переходящий остаток') ; gotoxy(w-10,4) ;write('продукции на ') ; gotoxy(w-10,5) ;write('начало года') ; gotoxy(w+9,3) ;write('Приход') ; gotoxy(w+8,4) ;write('продукции') ; gotoxy(w+11,5) ;write('шт') ; gotoxy(w+18,4) ;write('Расход') ; gotoxy(W+20,5) ;write('шт') ; gotoxy(w+26,4) ;write('Цена за') ; gotoxy(w+27,5) ;write('1 шт') ; gotoxy(w+35,4) ;write('Остаток на') ; gotoxy(w+35,5) ;writeln('конец года') ; textcolor(9) ; gotoxy(w-16,6) ; write('--------------------------------------------------------------') ; Установка цвета символов и текстового экрана для вывода данных таблицы textcolor(15) ; window(1,7,80,25) ; Подготовка файла к чтению reset(f) ; Установка координаты y, необходимой для вывода данных таблицы и обнуление итогового значения таблицы.

ww: =1; itog: =0; Вывод основных данных таблицы repeat writeln; read(f, a) ; st: =((a. e1+a. e2) -a. e3) *a. e4; itog: =itog+st; textcolor(13) ; gotoxy(w-15, ww) ;write(a. n) ; textcolor(15) ; gotoxy(w-5, ww) ;write(a. e1) ; gotoxy(w+11, ww) ;write(a. e2) ; gotoxy(w+20, ww) ;write(a. e3) ; gotoxy(w+29, ww) ;write(a. e4: 4: 2) ; gotoxy(w+37, ww) ;write(st: 4: 2) ; ww: =ww+1; Проверка для вывода очередной строки на экран. Необходимо в том случае, когда число записей превышает число строк на мониторе.

if ww>=19 then begin if (ww=19) then begin writeln; write('Для просмотра используйте клавишу <space>') ; write(' Для продолжения -<any key>') ; c: =readkey; delline; if c=#32 then ww: =ww-1 else break; end; end; Вывод данных в таблицу пока не конец файла until eof(f) ; Установка цвета символа и вывод линии на экран textcolor(9) ; gotoxy(w-16, ww) ; write('--------------------------------------------------------------') ; Вывод итогового значения textcolor(9) ;gotoxy(w+7, ww) ; write('¦') ; textbackground(5) ; textcolor(10) ;write('Итого: ', itog: 4: 2) ; textbackground(0) ; textcolor(9) ; write('+') ; writeln; Завершение процедуры вывода таблицы end;

Процедура вывода основного меню – menu : Очистка экрана и установка стандартного текстового режима clrscr; textmode(Co80) ; Установка текстового окна на экране с координатами левого верхнего угла -13,3 и правого нижнего – 70,15 window(13,3,70,15) ; Установка цвета фона и символов textbackground(14) ;textcolor(15) ; Перемещение указателя и печать сообщения gotoxy(1,3) ; write('Для дальнейшей работы с программой выберите номерок: ') ; Установка цвета фона textbackground(0) ; Печать пунктов меню, устанавливая цвет для цифр меню и свой цвет для названия пункта меню gotoxy(16,5) ; textcolor(10) ; write('1') ; textcolor(7) ; write(' - Просмотр') ; gotoxy(16,6) ; textcolor(10) ; write('2') ; textcolor(7) ; write(' - Cоздать') ; gotoxy(16,7) ; textcolor(10) ; write('3') ; textcolor(7) ; write(' - Добавить') ; gotoxy(16,8) ; textcolor(10) ; write('4') ; textcolor(7) ; write(' - Удалить') ; gotoxy(16,9) ; textcolor(10) ; write('5') ; textcolor(7) ; write(' -Редактировать') ; gotoxy(16,10) ;textcolor(10) ; write('6') ; textcolor(7) ; write(' - Заставка') ; gotoxy(16,11) ;textcolor(10) ; write('7') ; textcolor(7) ; write(' - Выход') ; gotoxy(16,13) ; write('Введите номер: ') ; Установка цвета символа и его мерцание textcolor(10+128) ; Ввод переменной l, необходимой для дальнейшей работы программы и установка стандартного текстового режима readln(l) ; textmode(Co80) ; Конец процедура вывода главного меню end;

Процедура вывода заставки – zast : Очистка экрана clrscr; Установка белого цвета символов textcolor(white) ; Вывод сообщения: “Показать заставку?” Write(‘Показать заставку? (y/n) ’) ; Считывание нажатия клавиши.

c: =readkey При нажатие клавиши <y> - выполняется дальнейший ход процедуры: Инициализация графики initgraph(gd, gm, 'bgi') Установка координат xm, ym для вывода графических объектов xm: =getmaxx div 4; ym: =getmaxy div 4; Установка текущего шрифта, стиля и размера текста settextstyle(2,0,5) Вывод текста на экран, используя координаты x=xm+100, y=10 outtextxy(xm+100,10, '## Sergei Kovbasyuk ##') ; Вычесление числа байт, необходимого для сохранения прямоугольной области экрана size: =imagesize (xm+100,10, xm+275,10+20) ; Создание динамической переменной getmem(saucer, size) ; Сохранение в переменной битовый образ указанной части экрана.

getimage(xm+100,10, xm+275,10+20, saucer^) ; Вывод битового образа на экран putimage(xm+100,10, saucer^, xorput) ; Обнуление переменных, требуемых для вывода на экран битового изображения, используя при этом оператор цикла REPEAT…UNTIL и цикл FOR.

k: =0; kk: =0; i: =0; n: =0; Цикла REPEAT…UNTIL repeat Установка текущего шрифта, стиля и размера текста settextstyle(10,0,5) ; Установка текущего цвета шрифта setcolor(i+1) ; Вывод текста на экран outtextxy((getmaxx div 5) , (getmaxy div 4) , '"Sorge pro"') ; Установка текущего шрифта, стиля, размера текста.

settextstyle(5,0,5) ; setcolor(15) ; Вывод текста на экран outtextxy((getmaxx-200) , (getmaxy-250) , 'present') ; Установка текущего шрифта, стиля, размера текста.

settextstyle(3,0,1) ; Вывод текста на экран outtextxy(40, (getmaxy-50) , 'http: //sorgepro. agava. ru') ; outtextxy(290, (getmaxy-50) , 'e-mail: office@sorgepro. agava. ru') ; Установка текущего шрифта, стиля, размера текста.

settextstyle(2,0,5) ; Вывод текста на экран outtextxy(getmaxx-150, getmaxy-20, 'Press <ESC>') ; outtextxy(20, getmaxy-20, '(c) 2000. All rights don''t reserved. ') ; Наращивание переменных для вывода на экран битового изображения и для смены текущего цвета k: =k+5;i: =i+1; Вывод битового образа на экран putimage(k, 10, saucer^, xorput) ; Задержка программы delay(50) ; Наращивание переменной для вывода на экран битового изображения kk: =kk+5; Вывод битового образа на экран putimage(kk, 10, saucer^, xorput) ; Если битовое изображение достигло заданных границ экрана, то идет обнуление координат вывода этого изображения на экран if k>getmaxx-100 then begin k: =0; kk: =0 end; Выполнение этого цикла, пока не нажата какая-нибудь клавиша until keypressed; Вывод на экран трех окружностей, меняющих свой размер с помощью наращивания переменной <i>.

{-----------krugi------------} for i: =0 to 399 do begin setcolor(red) ; circle(200,100, i) ; setcolor(green) ; circle(400,100, i) ; setcolor(yellow) ; circle(300,300, i) ; delay(10) ; end; Вывод на экран окружности, уменьшающей свой радиус.

for i: =399 downto 0 do begin setcolor(i) ; сircle(322,250, i) ; delay(10) ; end; {----------end_krugi---------} Закрытие граф. режима closegraph; Завершение составного оператора begin…end end; Завершение процедуры вывода заставки end;

Процедура вывода сообщения об ошибке – error : begin Обнуление счетчика i: =0; Цикл вывода сообщения об ошибке, пока i не равно 5 repeat textmode(Co80) ; clrscr; gotoxy(24,8) ;textcolor(15) ; write('ВЫ ВВЕЛИ НЕПРАВИЛЬНЫЙ НОМЕР') ; звук, при выводе сообщения sound(185) ;delay(100) ;nosound; clrscr; gotoxy(24,8) ;textcolor(7) ; write('ВЫ ВВЕЛИ НЕПРАВИЛЬНЫЙ НОМЕР') ; sound(174) ;delay(100) ;nosound; наращивание счетчика i: =i+1; until i=5; Отключение звука nosound; Возврат в главное меню menu; Завершение процедуры вывода сообщения об ошибке end; Процедура выхода из программы – exitt : Очитстка экрана clrscr; Инициализация графики initgraph(gd, gm, 'bgi') ; Вывод текста на экран пока не нажата какая-нибудь клавиша repeat settextstyle(7,0,4) ;setcolor(15) ; outtextxy(90, getmaxy div 4, 'Technical support by e-mail: ') ; settextstyle(1,0,4) ;setcolor(10) ; outtextxy(120, (getmaxy div 4) +50, 'support@sorgepro. agava. ru') ; settextstyle(7,0,4) ;setcolor(15) ; outtextxy(140, (getmaxy div 4) +100, 'or visited our web site: ') ; settextstyle(1,0,4) ;setcolor(10) ; outtextxy(120, (getmaxy div 4) +150, 'http: //sorgepro. agava. ru') ; settextstyle(2,0,5) ;setcolor(15) ; outtextxy(getmaxx div 4, getmaxy-30, '(c) 2000. "Sorge pro". All rights don''t reserved. ') ; until keypressed; Закрытие граф. режима closegraph; Выход из программы exit; Завершение процедуры end; {==========================Proga===========================} Идет выполнение процедуры Zast: при нажатие какой-либо другой клавиши – устанавливается связь с файлом assign (f, ’'путь к файлу <k>’) Установка стандартного текстового режима textmode(Co80) ; Печать главного меню, используя процедуру menu Установка метки menu2: Если l=1, то выполняется печать таблицы if l=1 then begin Печать таблицы с помощью процедуры view, где w=27; Вывод сообщения для пользователя после вывода таблицы textcolor(15) ; gotoxy(7, ww+1) ; writeln('Для выхода нажмите <any key> или <Esc>-возврат в главное меню. ') ; Считывание нажатия клавиши с клавиатуры c: =readkey; Установка стандартного текстового режима textmode(Co80) ; Если нажата клавиша <Esc> происходит возврат в главное меню: выполнение процедуры menu и переход к метки menu2 if c=#27 then begin menu; goto menu2 end Иначе выполняется процедура выхода – exitt else begin exitt; Завершение составного оператора begin…end end Если l не равно 1, а равно 2 то выполняется алгоритм создания записей заново else if l=2 then begin Очистка экрана clrscr; Установка цвета фона и символов и вывод на экран сообщения textbackground(14) ;textcolor(15) ; writeln('Вы действительно хотите создать новые записи? ') ; writeln('!!! ПРЕДЫДУЩИЕ ЗАПИСИ БУДУТ УТЕРЯНЫ!!! ') ; Установка цвета фона и символов и вывод на экран сообщения textbackground(0) ; gotoxy(1,4) ; writeln('Для продолжения нажмите <any key> или <Esc>-возврат в главное меню. ') ; Считывание клавиши с клавиатуры c: =readkey; Если нажата клавиша <Esc>, то выполняется возврат к главному меню и переход к метки menu2 if c=#27 then begin menu; goto menu2 end Иначе идет ввод переменной q – количество создаваемых записей else begin writeln('Введите количество записей: ') ; read(q) ; Очистка экрана clrscr; Подготовка файла к записи rewrite(f) ; Цикл ввода новых записей. Выход из цикла осуществиться в том случае, когда a. n будет равно q repeat writeln('введи текущий номер продукции... ') ; readln(a. n) ; writeln('введи переходящий остаток продукции на начало года... ') ; readln(a. e1) ; writeln('введи приход продукции... ') ; readln(a. e2) ; writeln('введи расход... ') ;readln(a. e3) ; writeln('введи цену за 1 шт... ') ;readln(a. e4) ; write(f, a) ; until (a. n=q) ; Очистка экрана и вывод сообщения clrscr; writeln('ВСЁ OK. ') ; Задержка программы. Возврат в главное меню и переход к метки menu2 delay(1000) ; menu; goto menu2; Завершение составного оператора begin…end end; Завершение составного оператора begin…end end Если переменная l не равна 1 и 2, а равна 3, то выполняется алгоритм добавления записи else if l=3 then begin Очистка экрана, установка цвета фона и символов и вывод сообщения clrscr; textbackground(0) ; textcolor(15) ; writeln('Продолжить? (y/n) ') ; Считывание клавиши с клавиатуры c: =readkey; Если нажата любая клавиша, кроме <y>, то выполняется возврат к главному меню и переход к метки menu2 if c<>#121 then begin menu;goto menu2; end Иначе выполняется алгоритм добавления новой записи else begin очистка экрана clrscr; Ввод количества добавляемых записей -mm writeln('Введите количество добовляемых записей: ') ; read(mm) ; очистка экрана clrscr; Подготовка файла к чтению, определения конца файла и установка указателя в конец файла reset(f) ; n: =filesize(f) ; seek(f, n) ; установка номера добавляемой записи pp: =n+1; Цикл добавления записи. Завершится тогда, когда номер последней добавляемой записи qq будет равен mm repeat writeln('введи текущий номер продукции... ') ;readln(qq) ; a. n: =pp; writeln('введи переходящий остаток продукции на начало года... ') ; readln(a. e1) ; writeln('введи приход продукции... ') ; readln(a. e2) ; writeln('введи расход... ') ;readln(a. e3) ; writeln('введи цену за 1 шт... ') ;readln(a. e4) ; write(f, a) ; pp: =pp+1; until (qq=mm) ; Очистка экрана и вывод сообщения clrscr; writeln('ВСЁ OK. ') ; Задержка программы delay(1000) ; Возврат в главное меню и переход к метки menu2 menu; goto menu2; Завершение составного оператора begin…end end; Завершение составного оператора begin…end end else Если l не равно 1, не 2 и не 3, а равно 4, то выполняется алгоритм удаления записей if l=4 then begin Очистка экрана clrscr; Установка текстового экрана для вывода таблицы с помощью процедуры view window(1,1,68,22) ; view(17) ; Установка текстового экрана для управления удаления записей window(64,1,80,22) ; Установка цвета символов и вывод сообщения textcolor(15) ; writeln('Продолжить? (y/n) ') ; Считывание клавиши с клавиатуры c: =readkey; Если нажата любая клавиша, кроме <y>, то выполняется возврат к стандартному текстовому режиму, к главному меню и переход к метки menu2 if c<>#121 then begin textmode(Co80) ; menu; goto menu2; end Иначе происходит ввод удаляемой записи - nn else begin write('Введи номер: ') ; readln(nn) ; Если вводимого номера записи не существует – выполняется процедура вывода сообщения об ошибке – error, и переход к метки menu2 if nn>filesize(f) then begin error; goto menu2; end; Удаление записи: запись в новый файл: Подготовка файла к чтению reset(f) ; Установка связь с новым файлом assign (f2, 'k2') ; Подготовка нового файла к записи rewrite(f2) ; Обнуление переменных, необходимых для удаления записи l: =0;q: =0; Определение количества записей в первоначальном файле n: =filesize(f) ; Цикл перезаписи записей из первого файла в новый, при этом удаляемая запись игнорируется. Цикл завершается, когда все записи будут переписаны repeat l: =l+1; if l<>nn then begin q: =q+1; seek(f, l-1) ; read(f, a) ; b. n: =q; b. e1: =a. e1; b. e2: =a. e2; b. e3: =a. e3; b. e4: =a. e4; write(f2, b) ; end; until l=n; Подготовка только что созданного файла к чтению.

reset(f2) ; Подготовка первоначального файла к перезаписи rewrite(f) ; Цикл перезаписи из только что созданного файла записей в первоначальный, но уже без требуемой записи. Перезапись будет производиться, пока не конец второго файла repeat read(f2, b) ; a. n: =b. n; a. e1: =b. e1; a. e2: =b. e2; a. e3: =b. e3; a. e4: =b. e4; write(f, a) ; until eof(f2) ; Вывод сообщения и задержка программы writeln; writeln('Всё Ok! ') ; delay(1000) ; Вывод сообщения о возможности продолжения удаления новых записей или возврата к главному меню writeln('Reload-<any>') ; write('Exit-<Esc>') ; Считывание клавиши с клавиатуры c: =readkey; Если нажата клавиши <Esc>, то происходит возврат к главному меню и переход к метки menu2 if c=#27 then begin menu; goto menu2; end иначе устанавливается стандартный текстовой режим, l присваивается 4 и осуществляется переход к метке menu2, т.е. происходит опять алгоритм удаления записи else begin textmode(Co80) ; l: =4; goto menu2; end; Завершение составных операторов begin…end end; end   Если l не равно 1, не 2 и не 3, и не 4, а равно 5, то выполняется алгоритм редактирования записей else if l=5 then begin Выполняется процедура вывода таблицы view(27) ; Установка цвета символов и вывод сообщения textcolor(15) ; writeln('Продолжить? (y/n) ') ; Считывание клавиши с клавиатуры c: =readkey; Если нажата любая клавиша, кроме <y>, то выполняется возврат к стандартному текстовому режиму, к главному меню и переход к метки menu2 if c<>#121 then begin textmode(Co80) ; menu;goto menu2; end Иначе происходит ввод номера записи для редактирования - nn else begin write('Введите номер для редактирования: ') ; read(nn) ; Если вводимого номера записи не существует – выполняется процедура вывода сообщения об ошибке – error, и переход к метки menu2 if nn>filesize(f) then begin error; goto menu2; end; Очистка экрана и установка переменной i, для предварительного просмотра записи clrscr; i: =27; Подготовка файла к чтению и записи и установка указателя на нужной редактируемой записи reset(f) ; seek(f, nn-1) ; Считывание и вывод на экран редактируемой записи для предварительного просмотра read(f, a) ; st: =((a. e1+a. e2) -a. e3) *a. e4; gotoXY(i-15,1) ;write(a. n) ; gotoXY(i-5,1) ;write(a. e1) ; gotoxy(i+11,1) ;write(a. e2) ; gotoxy(i+20,1) ;write(a. e3) ; gotoxy(i+29,1) ;write(a. e4: 4: 2) ; gotoxy(i+37,1) ;write(st: 4: 2) ; gotoxy(7,2) ; Установка указателя на необходимой записи, т.к. после вывода на экран указатель сдвинулся seek(f, nn-1) ; Вывод сообщений о подтверждении редактирования каждого компонента редактируемой записи.

Если при этом будет нажата <y>, то выполняется перезапись компонента записи, путем ввода новой (nn) и присваивание ее –старой (a. e1…a. e4) .

Если при выводе сообщения будет нажата любая клавиши, кроме <y>, то выполняется переход к редактированию следующего компонента данной записи.

writeln('Изменить переходящий остаток продукции на начало года?

(y/n) ') ; c: =readkey; if c=#121 then begin write('Вводим новое: ') ;read(nn) ; a. e1: =nn; end; writeln; writeln('Изменить приход продукции? (y/n) ') ;c: =readkey; if c=#121 then begin write('Вводим новое: ') ; read(nn) ;a. e2: =nn; end; writeln; writeln('Изменить расход? (y/n) ') ;c: =readkey; if c=#121 then begin write('Вводим новое: ') ; read(nn) ;a. e3: =nn; end; writeln; writeln('Изменить цену за 1 шт? (y/n) ') ;c: =readkey; if c=#121 then begin write('Вводим новое: ') ; read(o) ;a. e4: =o; end; write(f, a) ; Вывод сообщение и задержка программы writeln; write('Все Ok') ; delay(1000) ; Очистка экрана, возврат к главному меню и переход к метке menu2 clrscr; menu; goto menu2; Завершение составных операторов begin…end end; end else Если l не равно 1, не 2 и не 3, и не 4, и не 5, а равно 6, то выполняется процедура вывода заставки - zast, после завершения которой происходит переход к главному меню и метке menu2 if l=6 then begin zast; menu; goto menu2; end; Если l не равно 1, не 2 и не 3, и не 4, не 5, и даже не 6, а - 7, то выполняется процедура выхода из программы –exitt if l=7 then exitt Если l не равно 1, не 2 и не 3, и не 4, не 5, и даже не 6, и уж точно не 7, то выполняется процедура вывода сообщения об ошибке. После завершения этой процедуры происходит переход к метке menu2 else begin error; goto menu2; end; {========================END_Proga========================} ЗАВЕРШЕНИЕ ПРОГРАММЫ END.

1. Фаронов В. В. Турбо Паскаль 7.0. Начальный курс. Учебное пособие. -М.: “Нолидж” , 1998. -616 с.

2. Вычислительная техника и программирование. Под редакцией А. В. Петрова М, Высшая школа, 1990

3. Марченко А. И., Марченко Л. И. Программирование в среде Turbo-Pascal 7.0-М., Бином Универсал, К.: Юниор, 1997

4. http: //www. rusdoc. ru

5. http: //www. borland. ru 6. http: //www. infocity. kiev. ua

uses crt, graph; type bas=record n: integer; e1, e2, e3: integer; e4: real; end; label menu2; {метка} var c: char; {с - для ридкея} o: real; ww, l, nn, q, i: integer; {w, ww-для шапки, l-для меню и для удал nn, o-редактирование q-для обнавления i-счетчик} gd, gm: integer; {для графики} pp, qq, n, mm: integer; {для добавки} f, f2: file of bas; {файлы} a, b: bas; st: real; {сумма в таблице} {-----------------------------------------вывод таблицы -------------------------------------} procedure view(w: integer) ; var itog: real; {cумма в таблице, всего} begin window(1,1,80,6) ; textbackground(5) ;textcolor(15) ; gotoxy(w, 1) ;write('Реализация продукции за год') ; textcolor(9) ;gotoxy(w-16,2) ;textbackground(0) ; write('--------------------------------------------------------------') ; textcolor(15) ; gotoxy(w-15,4) ;write('N') ; gotoxy(w-13,3) ;write('Переходящий остаток') ; gotoxy(w-10,4) ;write('продукции на ') ; gotoxy(w-10,5) ;write('начало года') ; gotoxy(w+9,3) ;write('Приход') ; gotoxy(w+8,4) ;write('продукции') ; gotoxy(w+11,5) ;write('шт') ; gotoxy(w+18,4) ;write('Расход') ; gotoxy(W+20,5) ;write('шт') ; gotoxy(w+26,4) ;write('Цена за') ; gotoxy(w+27,5) ;write('1 шт') ; gotoxy(w+35,4) ;write('Остаток на') ; gotoxy(w+35,5) ;writeln('конец года') ; textcolor(9) ; gotoxy(w-16,6) ; write('--------------------------------------------------------------') ; textcolor(15) ; window(1,7,80,25) ; reset(f) ; ww: =1; itog: =0; repeat writeln; read(f, a) ; st: =((a. e1+a. e2) -a. e3) *a. e4; itog: =itog+st; textcolor(13) ; gotoxy(w-15, ww) ;write(a. n) ; textcolor(15) ; gotoxy(w-5, ww) ;write(a. e1) ; gotoxy(w+11, ww) ;write(a. e2) ; gotoxy(w+20, ww) ;write(a. e3) ; gotoxy(w+29, ww) ;write(a. e4: 4: 2) ; gotoxy(w+37, ww) ;write(st: 4: 2) ; ww: =ww+1; if ww>=19 then {типа скролинга} begin if (ww=19) then begin writeln; write('Для просмотра используйте клавишу <space>') ; write(' Для продолжения -<any key>') ; c: =readkey; delline; if c=#32 then ww: =ww-1 else break; end; end; until eof(f) ; textcolor(9) ; gotoxy(w-16, ww) ; write('--------------------------------------------------------------') ; textcolor(9) ;gotoxy(w+7, ww) ; write('¦') ; textbackground(5) ; textcolor(10) ;write('Итого: ', itog: 4: 2) ; textbackground(0) ; textcolor(9) ; write('+') ; writeln; end; {----------------------------------------основное меню--------------------------------------} procedure menu; begin textmode(Co80) ; clrscr; window(13,3,70,15) ; textbackground(14) ;textcolor(15) ; gotoxy(1,3) ; write('Для дальнейшей работы с программой выберите номерок: ') ; textbackground(0) ; gotoxy(16,5) ; textcolor(10) ; write('1') ; textcolor(7) ; write(' - Просмотр') ; gotoxy(16,6) ; textcolor(10) ; write('2') ; textcolor(7) ; write(' - Cоздать') ; gotoxy(16,7) ; textcolor(10) ; write('3') ; textcolor(7) ; write(' - Добавить') ; gotoxy(16,8) ; textcolor(10) ; write('4') ; textcolor(7) ; write(' - Удалить') ; gotoxy(16,9) ; textcolor(10) ; write('5') ; textcolor(7) ; write(' - Редактировать') ; gotoxy(16,10) ;textcolor(10) ; write('6') ; textcolor(7) ; write(' - Заставка') ; gotoxy(16,11) ;textcolor(10) ; write('7') ; textcolor(7) ; write(' - Выход') ; gotoxy(16,13) ; write('Введите номер: ') ; textcolor(10+128) ;readln(l) ; textmode(Co80) ; end; {----------------------------------------------заставка-----------------------------------------} procedure zast; var xm, ym: integer; {xm, ym, x, y-координаты } size: integer; saucer: pointer; {size, saucer, k, kk-для движения} k, kk: integer; begin clrscr; textmode(Co80) ; textcolor(white) ; write('Показать заставку? (y/n) ') ; c: =readkey; if c=#121 then begin initgraph(gd, gm, 'bgi') ; xm: =getmaxx div 4; ym: =getmaxy div 4; settextstyle(2,0,5) ; outtextxy(xm+100,10, '## Sergei Kovbasyuk ##') ; size: =imagesize (xm+100,10, xm+275,10+20) ; getmem(saucer, size) ; getimage(xm+100,10, xm+275,10+20, saucer^) ; putimage(xm+100,10, saucer^, xorput) ; k: =0;kk: =0;i: =0;n: =0; repeat settextstyle(10,0,5) ; setcolor(i+1) ; outtextxy((getmaxx div 5) , (getmaxy div 4) , '"Sorge pro"') ; settextstyle(5,0,5) ; setcolor(15) ; outtextxy((getmaxx-200) , (getmaxy-250) , 'present') ; settextstyle(3,0,1) ; outtextxy(40, (getmaxy-50) , 'http: //sorgepro. agava. ru') ; outtextxy(290, (getmaxy-50) , 'e-mail: office@sorgepro. agava. ru') ; settextstyle(2,0,5) ; outtextxy(getmaxx-150, getmaxy-20, 'Press <ESC>') ; outtextxy(20, getmaxy-20, '(c) 2000. All rights don''t reserved. ') ; k: =k+5;i: =i+1; putimage(k, 10, saucer^, xorput) ; delay(50) ; kk: =kk+5; putimage(kk, 10, saucer^, xorput) ; if k>getmaxx-100 then begin k: =0; kk: =0 end; until keypressed; {-----------krugi------------} for i: =0 to 399 do begin setcolor(red) ; circle(200,100, i) ; setcolor(green) ; circle(400,100, i) ; setcolor(yellow) ; circle(300,300, i) ; delay(10) ; end; for i: =399 downto 0 do begin setcolor(i) ; circle(322,250, i) ; delay(10) ; end; {----------end_krugi---------} closegraph; end; end; {------------------------------------Вывод об ошибке---------------------------------------} Procedure error; begin i: =0; repeat textmode(Co80) ; clrscr; gotoxy(24,8) ;textcolor(15) ; write('ВЫ ВВЕЛИ НЕПРАВИЛЬНЫЙ НОМЕР') ;sound(185) ;delay(100) ;nosound; clrscr; gotoxy(24,8) ;textcolor(7) ; write('ВЫ ВВЕЛИ НЕПРАВИЛЬНЫЙ НОМЕР') ;sound(174) ;delay(100) ;nosound; i: =i+1; until i=5; nosound; menu; end; {-----------------------------------------------Bыход-----------------------------------------} procedure exitt; begin clrscr; initgraph(gd, gm, 'bgi') ; repeat settextstyle(7,0,4) ;setcolor(15) ; outtextxy(90, getmaxy div 4, 'Technical support by e-mail: ') ; settextstyle(1,0,4) ;setcolor(10) ; outtextxy(120, (getmaxy div 4) +50, 'support@sorgepro. agava. ru') ; settextstyle(7,0,4) ;setcolor(15) ; outtextxy(140, (getmaxy div 4) +100, 'or visited our web site: ') ; settextstyle(1,0,4) ;setcolor(10) ; outtextxy(120, (getmaxy div 4) +150, 'http: //sorgepro. agava. ru') ; settextstyle(2,0,5) ;setcolor(15) ; outtextxy(getmaxx div 4, getmaxy-30, '(c) 2000. "Sorge pro". All rights don''t reserved. ') ; until keypressed; closegraph; exit; end; {==========================Proga===========================} BEGIN zast; assign (f, 'k') ; textmode(Co80) ; {печать первого меню} menu; menu2: {-------------------------------------------печать тaблицы-----------------------------------} if l=1 then begin view(27) ; textcolor(15) ; gotoxy(7, ww+1) ; writeln('Для выхода нажмите <any key> или <Esc>-возврат в главное меню. ') ; c: =readkey; textmode(Co80) ; if c=#27 then begin menu; goto menu2 end else exitt; end else {-----------------------------------------Заново------------------------------------------------} if l=2 then begin clrscr; textbackground(14) ;textcolor(15) ; writeln('Вы действительно хотите создать новые записи? ') ; writeln('!!! ПРЕДЫДУЩИЕ ЗАПИСИ БУДУТ УТЕРЯНЫ!!! ') ; textbackground(0) ; gotoxy(1,4) ; writeln('Для продолжения нажмите <any key> или <Esc>-возврат в главное меню. ') ; c: =readkey; if c=#27 then begin menu; goto menu2 end else begin writeln('Введите количество записей: ') ; read(q) ; clrscr; rewrite(f) ; repeat writeln('введи текущий номер продукции... ') ; readln(a. n) ; writeln('введи переходящий остаток продукции на начало года... ') ; readln(a. e1) ; writeln('введи приход продукции... ') ; readln(a. e2) ; writeln('введи расход... ') ;readln(a. e3) ; writeln('введи цену за 1 шт... ') ;readln(a. e4) ; write(f, a) ; until (a. n=q) ; clrscr; writeln('ВСЁ OK. ') ; delay(1000) ; menu; goto menu2; end; end else {----------------------------------Добавление записи---------------------------------------} if l=3 then begin clrscr; textbackground(0) ; textcolor(15) ; writeln('Продолжить? (y/n) ') ; c: =readkey; if c<>#121 then begin textmode(Co80) ; menu;goto menu2; end else begin clrscr; writeln('Введите количество добовляемых записей: ') ; read(mm) ; clrscr; reset(f) ; n: =filesize(f) ; seek(f, n) ; pp: =n+1; repeat writeln('введи текущий номер продукции... ') ;readln(qq) ; a. n: =pp; writeln('введи переходящий остаток продукции на начало года... ') ; readln(a. e1) ; writeln('введи приход продукции... ') ; readln(a. e2) ; writeln('введи расход... ') ;readln(a. e3) ; writeln('введи цену за 1 шт... ') ;readln(a. e4) ; write(f, a) ; pp: =pp+1; until (qq=mm) ; clrscr; writeln('ВСЁ OK. ') ; delay(1000) ; menu; goto menu2; end; end else {-----------------------------------------удаление записи------------------------------------} if l=4 then begin clrscr; window(1,1,68,22) ; view(17) ; window(64,1,80,22) ; textcolor(15) ; writeln('Продолжить? (y/n) ') ; c: =readkey; if c<>#121 then begin textmode(Co80) ; menu;goto menu2; end else begin write('Введи номер: ') ; readln(nn) ; if nn>filesize(f) then begin error; goto menu2; end; {удаление записи: запись в новый файл} reset(f) ; assign (f2, 'k2') ; rewrite(f2) ; l: =0;q: =0;n: =filesize(f) ; repeat l: =l+1; if l<>nn then begin q: =q+1; seek(f, l-1) ; read(f, a) ; b. n: =q; b. e1: =a. e1; b. e2: =a. e2; b. e3: =a. e3; b. e4: =a. e4; write(f2, b) ; end; until l=n; {удаление записи: перезапись} reset(f2) ; rewrite(f) ; repeat read(f2, b) ; a. n: =b. n; a. e1: =b. e1; a. e2: =b. e2; a. e3: =b. e3; a. e4: =b. e4; write(f, a) ; until eof(f2) ; writeln; writeln('Всё Ok! ') ; delay(1000) ; writeln('Reload-<any>') ; write('Exit-<Esc>') ; c: =readkey; if c=#27 then begin menu; goto menu2; end else begin textmode(Co80) ; l: =4; goto menu2; end; end; end else {---------------------------------------редактирование--------------------------------------} if l=5 then begin view(27) ; textcolor(15) ; writeln('Продолжить? (y/n) ') ; c: =readkey; if c<>#121 then begin textmode(Co80) ; menu;goto menu2; end else begin write('Введите номер для редактирования: ') ; read(nn) ; if nn>filesize(f) then begin error; goto menu2; end; clrscr; i: =27; reset(f) ; seek(f, nn-1) ; read(f, a) ; st: =((a. e1+a. e2) -a. e3) *a. e4; gotoXY(i-15,1) ;write(a. n) ; gotoXY(i-5,1) ;write(a. e1) ; gotoxy(i+11,1) ;write(a. e2) ; gotoxy(i+20,1) ;write(a. e3) ; gotoxy(i+29,1) ;write(a. e4: 4: 2) ; gotoxy(i+37,1) ;write(st: 4: 2) ; gotoxy(7,2) ; seek(f, nn-1) ; writeln('Изменить переходящий остаток продукции на начало года? (y/n) ') ; c: =readkey; if c=#121 then begin write('Вводим новое: ') ;read(nn) ; a. e1: =nn; end; writeln; writeln('Изменить приход продукции? (y/n) ') ;c: =readkey; if c=#121 then begin write('Вводим новое: ') ; read(nn) ;a. e2: =nn; end; writeln; writeln('Изменить расход? (y/n) ') ;c: =readkey; if c=#121 then begin write('Вводим новое: ') ; read(nn) ;a. e3: =nn; end; writeln; writeln('Изменить цену за 1 шт? (y/n) ') ;c: =readkey; if c=#121 then begin write('Вводим новое: ') ; read(o) ;a. e4: =o; end; write(f, a) ; writeln; write('Все Ok') ; delay(1000) ; clrscr; menu; goto menu2; end; end else {--------------------------------------вывод заставки------------------------------------} if l=6 then begin zast; menu; goto menu2; end; {---------------------------------------выход----------------------------------------------} if l=7 then exitt else begin error; goto menu2; end; {========================END_Proga========================} END.

Поделитесь этой записью или добавьте в закладки