close

Вход

Забыли?

вход по аккаунту

?

Лабораторная работа №6

код для вставкиСкачать
Лабораторная работа №6.
Организация dbase-меню
Выполнил студент группы И-42
Журавлев Владимир.
Текст программы с комментариями
Set date to german
Set talk off
clear
close all
set default to d:\fp_26\laba4\
use zakaz in 0 order tag nom_zak
use zakazch in 0 order tag kod_zakazc
use detail in 0 order tag nom_zak
use nomenkl in 0 order tag kod_izdel
define menu main && Создание горизонтального меню
* Создаем элементы горизонтального меню
define pad zakazchiki of main prompt 'Заказчики'
define pad zakazi of main prompt 'Заказы'
define pad tovary of main prompt 'Товары'
define pad end of main prompt 'Конец работы'
* Назначение команд на PAD-пункты меню
on selection pad zakazchiki of main do zakazchikiClick
on selection pad zakazi of main do zakaziClick
on selection pad tovary of main do tovaryClick
on selection pad end of main deactivate menus
activate menu main && Активируем меню main
close databases && Закрываем все БД
clear window all && Удаление всех окон
*Работаем с таблицей заказчиков
function zakazchikiClick
select zakazch
define window client from 6,5 to 20,75;
double title "Заказчики";
color scheme 10 && Определяет окно client в память
&& с двойными рамками с заголовком
&& Заказчики
&& с цветовой схемой 10
activate window client && активируем окно client
@1,9 say "Код заказчика" get kod_zakazc size 1,1;
valid nomer1();
error 'Такой код уже существует!' && Форматированный вывод на экран
&& кода заказчика с проверкой его
&& на уникальность
@1,27 say "Название заказчика" get name_zakaz size 1,22
@6,45 say "Сумма заказа" get sum_zak size 1,10
@4,7 say "Почтовый индекс" get idx_zakazc picture '999999' && Вывод почтового индекса
&& с помощью шаблона, позволяющего
&& выводить только числа и + и -
@4,31 say "Улица заказчика" get str_zakazc size 1,21
@6,2 say "Дом заказчика" get dom_zakazc size 1,4
@6,22 say "Квартира заказчика" get flat_zakaz size 1,3
x=0
@8,2 get x function '*nh Предыдущая ;;
Следующая ; Добавить ; Поиск ;;
Выход' valid knopki() && Создаем нормальные кнопки,
&& расположенные горизонтально
read cycle && Ожидание ввода и фиксация
release windows client,poisk && Удаляем описанные окна из памяти
return
* Выбор кнопки
function knopki
do case
case x=1 && Если нажата кнопка 1,
skip-1 && то переходим на предыдущую запись
if bof() && Если начало таблицы,
go top && то переходим на первую запись с
wait 'Это первая запись' window && с появлением соотв. сообщения
endif
case x=2 && Если нажата кнопка 2,
skip && то переходим на следующую запись
if eof() && Если конец таблицы,
go bottom && то переходим на последнюю запись с
wait 'Это последняя запись' window && появлением соотв. сообщения
endif
case x=3 && Если нажата кнопка 3, то
*добавление новой записи
private m=0
calculate max(kod_zakazc) to m && заносим мах значение поля
&& код заказчика в переменную m
append blank && Добавляем новую запись
replace kod_zakazc with m+1 && Заменяем значения поля код заказчика
&& на m+1
case x=4 && Если нажата кнопка 4
*поиск заказчика
do poisk
case x=5 && Если нажата кнопка 5, то
clear read && выход из окна
endcase
show gets window client && Обновляем все поля GET
return
*Поиск нужной записи
function poisk
define window poisk from 11,19 to 15,61;
double title 'Поиск';
color scheme 10 && Определяем окно Поиск
activate window poisk && Активируем это окно
rec=recno() && Запоминаем значение текущей
&& записи
@1,1 say "Введите заказчика"
@2,1 get t default ' ' && По умолчанию t =
read && Ожидание ввода
if empty(t) && Если t = , то
wait 'Введите что-нибудь' window && вывод соотв. сообщения
else && в противном случае
locate for alltrim(name_zakaz)=alltrim(t) && поиск записи = t
if !found() && Если не найден, то
wait 'Заказчик не найден' window && вывод соотв. сообщения
go rec && переход на запись, запомненной ранее
else go recno() && в противном случае переход
&& на найденную запись
endif
endif
deactivate window poisk && деактивируем окно Поиск
show gets window client && Обновляем поля GET окна client
return
*Функция проверки номера на уникальность
function nomer1
r=recno() && Запоминаем текущую запись
kod = kod_zakazc
locate for (kod_zakazc=kod) and (r # recno()) && Ищем код заказчика
f = !found() && Если нашел
go r
return(f) && Возвращаем значение f
*Работаем с таблицей заказов
function zakaziClick
select zakaz
set relation to kod_zakazc into zakazch
define window zakazi from 1,15 to 10,66;
double title "Заказ";
color scheme 10 && Определяем окно заказов
activate window zakazi && Активируем окно заказов
@0,1 say "Номер заказа" get m.nom_zak;
default 0 size 1,2;
valid number();
error 'Такой номер уже существует!' && Форматированный вывод на
&& экран кода заказчика с
&& проверкой его на уникальность
select zakazch && Делаем текущей таблицу заказчиков
count to kolklient && Число записей в таблице
dimension client(kolklient) && Массив для кодов и названий
i=1 && Счетчик цикла
scan && Цикл по записям таблицы заказчиков
client(i)=zakazch.name_zakaz+str(zakazch.kod_zakazc,2)
i=i+1
m.date_zak=date() endscan
@0,34 say "Дата" get m.date_zak && Выводим текущую дату из временной
&& переменной
@1,15 say "Заказчик и его код"
t=0
@2,12 get t function '^' from client;
default t=' ' && Заполнение меню
x=1
@6,1 get x function '*nh Выбор товаров; Запись заказа;;
Счет; Выход';
valid knopki1() && Выбор кнопки
define window vibor_tovarov from 11,15 to 20,66;
color scheme 10 && Создание окна для выбора товаров
read cycle && Состояние ожидания ввода данных
release windows && Удаление из ОЗУ всех окон,
&& созданных данной программой
*Проверка номера заказа
function number
select detail
locate for nom_zak=m.nom_zak
e = !found()
return e
*Выбор кнопки
function knopki1
do case
case x=1
do tovar && Выбор товаров
case x=2
do zapis && Запись заказа
case x=3
do schet && Счет
case x=4
clear read && Выход
show gets
endcase
*Выбор товара
function tovar
select nomenkl
browse window vibor_tovarov title 'Выбор товара' fields;
nomenkl.name_izdel :h='Изделие',;
nomenkl.sumza1_izd :h='Цена изделия',;
nomenkl.kol_izdel :h='Кол-во',;
sum_zakaza=nomenkl.sumza1_izd * nomenkl.kol_izdel;
:h='Сумма' :p='9999999.99' noappend nodelete
return
*Запись заказа
function zapis
if (m.nom_zak # 0)
if (t # 0)
m.kod_zakazch = val(right(client(t),2))
m.sum_zak = 0
select nomenkl
scan for kol_izdel # 0
select detail
append blank
replace detail.nom_zak with m.nom_zak,;
kod_izdel with nomenkl.kod_izdel,;
dkol_v_zak with nomenkl.kol_izdel,;
sum_zak with nomenkl.kol_izdel*nomenkl.sumza1_izd
m.sum_zak = m.sum_zak+nomenkl.kol_izdel*nomenkl.sumza1_izd
select nomenkl
replace kol_izdel with 0
endscan
select zakaz
append blank
gather memvar
wait window "Заказ записан!"
else
wait window "Не выбран заказчик!"
endif
else
wait window "Не указан номер заказа!"
endif
return
*Меню заказов
function schet
select zakaz
on key label enter do save_schet
browse window vibor_tovarov title 'Выбор заказа - ENTER, Выход - Esc' fields;
zakaz.nom_zak :h='Номер заказа',;
zakaz.date_zak :h='Дата заказа',;
zakaz.sum_zak :h='Сумма заказа',;
zakazch.name_zakaz :h='Заказчик' noedit noappend nodelete
push key clear
*Запись файла счета
function save_schet
Nzakaz=zakaz.nom_zak
set textmerge on to 'Schet'+str(Nzakaz,2)+'.txt' noshow
\ Счет № <<zakaz.nom_zak>> от <<Dtoc(zakaz.date_zak)>>
\
\ Заказчик <<zakazch.name_zakaz>>
\ ╔═════════════════════════╦══════╦══════════╦══════════╗
\ ║ Изделие ║ Кол. ║ Цена ║ Сумма ║
\ ╠═════════════════════════╬══════╬══════════╬══════════╣
select detail
scan for nom_zak=Nzakaz
=seek(detail.kod_izdel,4)
\ ║<<nomenkl.name_izdel>>║ <<str(detail.dkol_v_zak,2)>>║
\\<<str(nomenkl.sumza1_izd,10)>>║<<str(detail.sum_zak,10)>>║
endscan
\ ╚═════════════════════════╩══════╩══════════╩══════════╝
\ Всего: <<str(zakaz.sum_zak,10)>>
set textmerge to
deactivate window vibor_tovarov
activate window zakazi
do prosmved with 'Schet'+str(Nzakaz,2)+'.txt'
return
*Просмотр файла счета
procedure prosmved
parameters filnam
define window prosmved from 1,1 to 23,79;
title 'Esc - Выход';
system;
color scheme 10
activate window prosmved
modify command (filnam);
noedit;
window prosmved
release windows prosmved
show windows zakazi top
return
*Работаем с таблицей товаров
function tovaryClick
define window edit_tovar from 1,15 to 15,58;
color scheme 10
select nomenkl
on key label ctrl+y do add_tovar
browse window edit_tovar title 'Ctrl+Y - Добавление товара Esc - Выход' fields;
nomenkl.kod_izdel :h="Код изделия":v=kod():e='Такой код уже существует',;
nomenkl.name_izdel :h="Название изделия",;
nomenkl.sumza1_izd :h="Цена изделия":p='9999999.99'
push key clear
return
*Добавление нового товара
function add_tovar
append blank
return
function kod
t=recno() && Запоминаем текущую запись
kod = kod_izdel
locate for (kod_izdel=kod) and (t # recno()) && Ищем код изделия
q = !found() && Если нашел
go t
return(q) && Возвращаем значение q
Документ
Категория
Рефераты
Просмотров
12
Размер файла
56 Кб
Теги
работа, лабораторная
1/--страниц
Пожаловаться на содержимое документа