Разработка системы управления базами данных

on sele bar 1 of pr do reduk

on sele bar 3 of pr do udalit

***************************************

defi popu rr1 from 1,38 shadow color gr+/w

defi bar 1 of rr1 prompt '\<Товары'

defi bar 2 of rr1 prompt '\-----------'

defi bar 3 of rr1 prompt '\<Поставщики'

defi bar 4 of rr1 prompt '\-----------'

defi bar 5 of rr1 prompt '\<Покупатели'

defi bar 6 of rr1 prompt '\-----------'

defi bar 7 of rr1 prompt '\<Тарифы'

defi bar 8 of rr1 prompt '\-----------'

defi bar 9 of rr1 prompt '\<Сделки'

on sele bar 1 of rr1 do prosm1

on sele bar 3 of rr1 do prosm2

on sele bar 5 of rr1 do prosm3

on sele bar 7 of rr1 do prosm4

on sele bar 9 of rr1 do prosm5

********************************************

defi popu dat from 1,30 to 5,45 shadow color gr+/w

defi bar 1 of dat prompt '\<О ПРОГРАММЕ'

defi bar 2 of dat prompt '\--------------'

defi bar 3 of dat prompt '\<ПОМОЩЬ'

on sele bar 1 of dat do spravka1

on sele bar 3 of dat do hlp

********************************************

defi popu uu1 from 3,38 shadow color gr+/w

defi bar 1 of uu1 prompt '\<Товары'

defi bar 2 of uu1 prompt '\-----------'

defi bar 3 of uu1 prompt '\<Поставщики'

defi bar 4 of uu1 prompt '\-----------'

defi bar 5 of uu1 prompt '\<Покупатели'

defi bar 6 of uu1 prompt '\-----------'

defi bar 7 of uu1 prompt '\<Тарифы'

defi bar 8 of uu1 prompt '\-----------'

defi bar 9 of uu1 prompt '\<Сделки'

on sele bar 1 of uu1 do udal1

on sele bar 3 of uu1 do udal2

on sele bar 5 of uu1 do udal3

on sele bar 7 of uu1 do udal4

on sele bar 9 of uu1 do udal5

***************************************************

defi popu vih from 9,16 to 13,34 shadow color gr+/w

defi bar 1 of vih prompt '\<Выход в DOS '

defi bar 2 of vih prompt '\------------------'

defi bar 3 of vih prompt '\<Выход в FOX PRO '

on sele bar 1 of vih do wihod1

on sele bar 3 of vih do wihod2

****************************************************

define window qqq from 2,5 to 20,75

DEFINE WINDOW entry FROM 3,6 TO 16,75 ;

DEFINE WINDOW tt FROM 15,6 TO 22,75 ;

****************************************************

defi popu pk1 from 1,23 shadow color gr+/w

defi bar 1 of pk1 prompt '\<По модели товара'

defi bar 2 of pk1 prompt '\-------------------'

defi bar 3 of pk1 prompt '\<По названию товара'

defi bar 4 of pk1 prompt '\-------------------'

defi bar 5 of pk1 prompt '\<По количеству '

defi bar 6 of pk1 prompt '\-------------------'

defi bar 7 of pk1 prompt '\<По цене '

on sele bar 1 of pk1 do a1

on sele bar 3 of pk1 do a2

on sele bar 5 of pk1 do a3

on sele bar 7 of pk1 do a4

***********************************************

defi popu pk2 from 3,23 shadow color gr+/w

defi bar 1 of pk2 prompt '\<По поставл. товару'

defi bar 2 of pk2 prompt '\-------------------'

defi bar 3 of pk2 prompt '\<По названию фирмы'

defi bar 4 of pk2 prompt '\-------------------'

defi bar 5 of pk2 prompt '\<По ФИО директора'

defi bar 6 of pk2 prompt '\-------------------'

defi bar 7 of pk2 prompt '\<По телефону '

on sele bar 1 of pk2 do b1

on sele bar 3 of pk2 do b2

on sele bar 5 of pk2 do b3

on sele bar 7 of pk2 do b4

**********************************************

defi popu p from 1,11 to 7,22 shadow color gr+/w

defi bar 1 of p prompt '\<Товары'

defi bar 2 of p prompt '\--------'

defi bar 3 of p prompt '\<Поставщики'

defi bar 4 of p prompt '\---------'

defi bar 5 of p prompt '\<Покупатели'

on sele bar 1 of p do poisk1

on sele bar 3 of p do poisk2

ON SELE BAR 5 OF P DO poisk3

*************************************************

defi popu pk3 from 5,23 shadow color gr+/w

defi bar 1 of pk3 prompt '\<По названию фирмы'

defi bar 2 of pk3 prompt '\-------------------'

defi bar 3 of pk3 prompt '\<По ФИО директора'

defi bar 4 of pk3 prompt '\-------------------'

defi bar 5 of pk3 prompt '\<По телефону '

on sele bar 1 of pk3 do c2

on sele bar 3 of pk3 do c3

on sele bar 5 of pk3 do c4

**********************************

activ wind mess

activ wind gm

activ menu greatmenu

set clock on

if lastkey()=27

set cursor on

deactiv wind mess

deactiv wind gm

deactiv menu greatmenu

endif

cancel

*************************************************************

proc wwod

activ popu wwod

deact popu wwod

return

*************************************************************

procedure wwod1

activ popu ww1

deact popu ww1

return

*************************************************************

proc vivod

activ popu vi

deact popu vi

return

*******************************************************

proc prosm

activ popu d1

deact popu d1

return

*************************************************************

proc prosm1

sele a

browse fields naim_t:H='Наименование изделия',mod:h='Модель',kol:H='Количество ед.',cena:H='Цена',har:H='Характеристики'

return to master

*************************************************************

proced prosm2

sele b

browse fields firm_ps:H='Фирма',naim_t:H='Наименование изделия',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

return to master

**********************************************************

proced prosm3

sele c

browse fields firm_pk:H='Фирма',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

return to master

************************************************************

proced prosm4

sele e

browse fields dost:H='Город',stoim:h='Стоимость'

return to master

************************************************************

proced prosm5

sele f

browse fields firm_ps:H='Поставщик',firm_pk:h='Покупатель',dost:h='Место доставки',naim_t:h='Наим.тов.',mod:h='Модель',har:h='Хар-ка',kol:h='Количество',sum_sd:h='Сумма сделки',itogo:h='Итого',dat:h='Дата'

return to master

*************************************************************

proc poisk

activ popu p

deact popu p

return

************************************************

proc poisk1

activ popu pk1

deact popu pk1

return

*************************************************************

proc poisk2

activ popu pk2

deact popu pk2

return

**********************************************

proc poisk3

activ popu pk3

deact popu pk3

return

*************************************

proc pravka

activ popu pr

deact popu pr

return

************************************************************

proc reduk

activ popu rr1

deact popu rr1

return

*************************************************************

proc udalit

activ popu uu1

deact popu uu1

return

*************************************************************

proc udal1

sele a

delete all

pack

WAIT WINDOW 'Все записи удалены' NOWAIT

return to gm

*********************************************************

proc udal2

sele b

delete all

pack

WAIT WINDOW 'Все записи удалены' NOWAIT

return to gm

********************************************************

proc udal3

sele c

delete all

pack

WAIT WINDOW 'Все записи удалены' NOWAIT

return to gm

***************************************************

proc udal4

sele e

delete all

pack

WAIT WINDOW 'Все записи удалены' NOWAIT

return to gm

********************************************************

proc udal5

sele f

delete all

pack

WAIT WINDOW 'Все записи удалены' NOWAIT

return to gm

*******************************************************

proc spravka

activ popu dat

deact popu dat

return

*********************************************************

proc spravka1

hide popu all

defi wind sprav from 5,20 to 17,70 titl 'СПРАВКА'foot 'ESC-ОТМЕА' SHAD COLOR 5+

acti wind sprav

set cursor off

@ 1,6 SAY' ПРОГРАММА '

@ 2,6 SAY' Движение товара на базе '

@ 3,6 SAY' с учетом транспортных издержек '

@ 5,6 SAY' Разработал студент III курса '

@ 6,6 SAY' ФИС гр.3162 '

@ 7,6 SAY' Курышев М.А. '

@ 8,6 SAY' ver 1.9 '

read

if lastkey()=27

set cursor on

deact wind sprav

endif

retu

*************************************************************

proc vi1

sele d

set print on

set print to printer

? '_______________________________________________________'

? '|Покупатель:'+' |'+evaluate ('firm_pk')+' |'

? '|Наименование товара:|'+evaluate ('naim_t')+' |'

? '|Модель:'+' |'+evaluate ('mod')+' |'

? '|Характеристика:'+' |'+evaluate ('har')+' |'

? '|Количество'+' |'+str(kol,6)+' |'

? '|Место доставки:'+' |'+evaluate ('dost')+' |'

? '|Сумма сделки:'+' |'+str(sum_sd)+' |'

? '|Итого (с доставкой) |'+str(itogo)+' |'

? '|Дата сделки'+' |'+str(d1,2)+' '+d21+' '+str(d3,4)+'г.'+' |'

? '_______________________________________________________'

set print off

********************************************

proc vi2

sele d

set print on

set print to file 111.txt

? '_______________________________________________________'

? '|Наименование товара:|'+evaluate ('naim_t')+' |'

? '|Модель:'+' |'+evaluate ('mod')+' |'

? '|Характеристика:'+' |'+evaluate ('har')+' |'

? '|Количество'+' |'+str(kol,6)+' |'

? '|Цена:'+' |'+str(cena)+' |'

? '_______________________________________________________'

set print off

WAIT WINDOW 'Информация добавлена в файл 111.txt' NOWAIT

*****************************************************

proc vi3

activate window qqq

set print on

SET DEVICE TO SCREEN

sele d

browse fields naim_t:H='Наименование изделия',mod:h='Модель',kol:H='Количество ед.',cena:H='Цена',har:H='Характеристики'

deactivate window qqq

*****************************************************

proc otchet

sele d

delete all

pack

set century on

set date german

set talk off

d=date()

d1=day(d)

d2=month(d)

d3=year(d)

do case

case d2=1

d21='января'

case d2=2

d21='февраля'

case d2=3

d21='марта'

case d2=4

d21='апреля'

case d2=5

d21='мая'

case d2=6

d21='июня'

case d2=7

d21='июля'

case d2=8

d21='августа'

case d2=9

d21='сентября'

case d2=10

d21='октября'

case d2=11

d21='ноября'

case d2=12

d21='декабря'

endcase

st=str(d1,2)+' '+d21+' '+str(d3,4)+'г.'

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

kl=0

dt=space(12)

md=space(8)

hr=space(8)

n_t=space(12)

f_pk=space(12)

@ 2,2 say 'Введите:'

@ 4,2 say 'Наименование товара'

@ 4,30 get n_t

@ 6,2 say 'Модель (марка)'

@ 6,30 get md

@ 8,2 say 'Характеристики'

@ 8,30get hr

@ 10,2 say 'Количество ед. товара'

@ 10,30 get kl

@ 12,2 say 'Покупатель'

@ 12,30 get f_pk

@ 14,2 say 'Место доставки город:'

@ 14,30 get dt

@ 16,14 GET button FUNCTION '*HN \?\<Добавить;\?\<Вывод;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ CYCLE

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Добавить'

sele d

append blank

replace firm_pk with f_pk,;

naim_t with n_t,;

mod with md,;

har with hr,;

kol with kl,;

dost with dt,;

sum_sd with a.cena*d.kol

sele e

locate for dost=dt

if found()

sele d

replace itogo with sum_sd+e.stoim,;

dat with st

endif

sele f

append blank

replace firm_pk with f_pk,;

naim_t with n_t,;

mod with md,;

har with hr,;

kol with kl,;

dost with dt,;

sum_sd with d.sum_sd,;

itogo with d.itogo,;

dat with st

sele b

locate for naim_t=n_t

if found()

sele f

replace firm_ps with b.firm_ps

endif

WAIT WINDOW 'Запись добавлена в отчет' NOWAIT

CASE button = 'Очистить'

kl=0

dt=space(12)

md=space(8)

hr=space(8)

n_t=space(12)

f_pk=space(12)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

CASE button = 'Вывод'

do www

CASE button = 'Выход'

deACTIVATE WINDOW entry

deACTIVATE WINDOW tt

CLEAR READ

WAIT WINDOW 'Ввод завершен' NOWAIT

endcase

**************************************

proc www

TITLE 'Выберите форму вывода отчета' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW tt

@ 3,6 GET button FUNCTION '*HN \?\<На принтер;\?\<На экран;\?\<В файл;\?\<Отмена' ;

SIZE 1,9,2 DEFAULT '' VALID xxx()

READ CYCLE

RELEASE WINDOW tt

FUNCTION xxx

DO CASE

CASE button = 'На принтер'

do prn

CASE button = 'На экран'

define window qqq from 2,5 to 20,75

activate window qqq

set print on

SET DEVICE TO SCREEN

sele d

browse fields firm_pk:h='Покупатель',naim_t:h='Наим.тов.',mod:h='Модель',har:h='Хар-ка',dost:h='Место доставки',sum_sd:h='Сумма сделки',itogo:h='Итого',dat:h='Дата'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

CASE button = 'В файл'

sele d

set print on

set print to file 111.txt

? '_______________________________________________________'

? '|Покупатель:'+' |'+evaluate ('firm_pk')+' |'

? '|Наименование товара:|'+evaluate ('naim_t')+' |'

? '|Модель:'+' |'+evaluate ('mod')+' |'

? '|Характеристика:'+' |'+evaluate ('har')+' |'

? '|Количество'+' |'+str(kol,6)+' |'

? '|Место доставки:'+' |'+evaluate ('dost')+' |'

? '|Сумма сделки:'+' |'+str(sum_sd)+' |'

? '|Итого (с доставкой) |'+str(itogo)+' |'

? '|Дата сделки'+' |'+str(d1,2)+' '+d21+' '+str(d3,4)+'г.'+' |'

? '_______________________________________________________'

set print off

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

WAIT WINDOW 'Информация добавлена в файл 111.txt' NOWAIT

CASE button = 'Отмена'

CLEAR READ

deACTIVATE WINDOW entry

WAIT WINDOW 'Отмена' NOWAIT

endcase

*****************************************

proc schet

sele d

append blank

replace firm_pk with f_pk,;

naim_t with n_t,;

mod with md,;

har with hr,;

kol with kl,;

dost with dt,;

sum_sd with a.cena*d.kol

sele e

locate for dost=dt

if found()

replace

itogo with sum_sd+e.stoim,;

dat with st

sele f

append blank

replace firm_pk with f_pk,;

naim_t with n_t,;

mod with md,;

har with hr,;

kol with kl,;

dost with dt,;

sum_sd with a.cena*kol,;

itogo with sum_sd+e.stoim,;

dat with st

WAIT WINDOW 'Запись добавлена в отчет' NOWAIT

*****************************************************

proc hlp

help

return to gm

*************************************************************

proc wihod

activ popu vih

deact popu vih

return

**********************************************

proc wihod1

deactiv wind mess

deactiv wind gm

deactiv menu greatmenu

deact wind sprav

deACTIVATE WINDOW entry

deACTIVATE WINDOW tt

deACTIVATE WINDOW qq

set relation to

close all

push key clear

cancel

**********************************************

proc wihod2

deactiv wind mess

deactiv wind gm

deactiv menu greatmenu

deact wind sprav

deACTIVATE WINDOW entry

deACTIVATE WINDOW tt

deACTIVATE WINDOW qq

set relation to

close all

push key clear

quit

*************************************************

Proc a1

use tovar in a

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=space(8)

@ 2,2 say 'Введите:'

@ 4,2 say 'Модель товара'get md

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele a

locate for mod=alltrim(md)

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace naim_t with a.naim_t

replace har with a.har

replace mod with a.mod

replace cena with a.cena

replace kol with a.kol

sele a

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=space(8)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

activate window qqq

set print on

SET DEVICE TO SCREEN

sele d

browse fields naim_t:h='Наим.тов.',mod:h='Модель',har:h='Хар-ка',cena:h='Цена',kol:h='Количество'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc a2

use tovar in a

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=space(12)

@ 2,2 say 'Введите:'

@ 4,2 say 'Наименование товара'get md

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele a

locate for naim_t=alltrim(md)

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace naim_t with a.naim_t

replace har with a.har

replace mod with a.mod

replace cena with a.cena

replace kol with a.kol

sele a

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=space(12)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

activate window qqq

set print on

SET DEVICE TO SCREEN

sele d

browse fields naim_t:h='Наим.тов.',mod:h='Модель',har:h='Хар-ка',cena:h='Цена',kol:h='Количество'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc a3

use tovar in a

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=0

@ 2,2 say 'Введите:'

@ 4,2 say 'Количество товара'get md size 1,6

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele a

locate for kol=md

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace naim_t with a.naim_t

replace har with a.har

replace mod with a.mod

replace cena with a.cena

replace kol with a.kol

sele a

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=0

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

activate window qqq

set print on

SET DEVICE TO SCREEN

sele d

browse fields naim_t:h='Наим.тов.',mod:h='Модель',har:h='Хар-ка',cena:h='Цена',kol:h='Количество'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc a4

use tovar in a

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=0

@ 2,2 say 'Введите:'

@ 4,2 say 'Цену товара'get md size 1,6

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele a

locate for cena<=md

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace naim_t with a.naim_t

replace har with a.har

replace mod with a.mod

replace cena with a.cena

replace kol with a.kol

sele a

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=0

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

activate window qqq

set print on

SET DEVICE TO SCREEN

sele d

browse fields naim_t:h='Наим.тов.',mod:h='Модель',har:h='Хар-ка',cena:h='Цена',kol:h='Количество'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc b1

sele b

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=space(12)

@ 2,2 say 'Введите:'

@ 4,2 say 'Постовляемый товар'get md

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele b

locate for naim_t=alltrim(md)

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace naim_t with a.naim_t,;

firm_ps with b.firm_ps,;

fio_d with b.fio_d,;

gor with b.gor,;

adr with b.adr,;

tel with b.tel

sele b

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=space(12)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

define window qqq from 2,5 to 20,75

activate window qqq

sele d

browse fields firm_ps:H='Фирма',naim_t:H='Наименование изделия',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc b2sele b

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=space(12)

@ 2,2 say 'Введите:'

@ 4,2 say 'Название фирмы поставщика'get md

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele b

locate for firm_ps=alltrim(md)

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace naim_t with a.naim_t,;

firm_ps with b.firm_ps,;

fio_d with b.fio_d,;

gor with b.gor,;

adr with b.adr,;

tel with b.tel

sele b

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=space(12)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

activate window qqq

sele d

browse fields firm_ps:H='Фирма',naim_t:H='Наименование изделия',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc b3

sele b

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=space(15)

@ 2,2 say 'Введите:'

@ 4,2 say 'ФИО директора'get md

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele b

locate for fio_d=alltrim(md)

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace naim_t with a.naim_t,;

firm_ps with b.firm_ps,;

fio_d with b.fio_d,;

gor with b.gor,;

adr with b.adr,;

tel with b.tel

sele b

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=space(15)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

activate window qqq

sele d

browse fields firm_ps:H='Фирма',naim_t:H='Наименование изделия',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc b4

sele b

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=space(6)

@ 2,2 say 'Введите:'

@ 4,2 say 'Телефон поставщика'get md

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele b

locate for tel=alltrim(md)

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace naim_t with a.naim_t,;

firm_ps with b.firm_ps,;

fio_d with b.fio_d,;

gor with b.gor,;

adr with b.adr,;

tel with b.tel

sele b

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=space(6)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

activate window qqq

sele d

browse fields firm_ps:H='Фирма',naim_t:H='Наименование изделия',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc c2

sele c

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=space(12)

@ 2,2 say 'Введите:'

@ 4,2 say 'Название фирмы покупателя'get md

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele c

locate for firm_pk=alltrim(md)

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace firm_pk with c.firm_pk,;

fio_d with c.fio_d,;

gor with c.gor,;

adr with c.adr,;

tel with c.tel

sele c

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=space(12)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

define window qqq from 2,5 to 20,75

activate window qqq

sele d

browse fields firm_ps:H='Фирма',naim_t:H='Наименование изделия',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc c3

sele c

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=space(15)

@ 2,2 say 'Введите:'

@ 4,2 say 'ФИО директора'get md

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele c

locate for fio_d=alltrim(md)

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace firm_pk with c.firm_pk,;

fio_d with c.fio_d,;

gor with c.gor,;

adr with c.adr,;

tel with c.tel

sele c

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=space(15)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

define window qqq from 2,5 to 20,75

activate window qqq

sele d

browse fields firm_ps:H='Фирма',naim_t:H='Наименование изделия',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc c4

sele c

use otchet in d

sele d

delete all

pack

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

md=space(6)

@ 2,2 say 'Введите:'

@ 4,2 say 'Телефон'get md

@ 7,14 GET button FUNCTION '*HN \?\<Поиск;\?\<Просмотр;\?\<Очистить;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Поиск'

sele c

locate for tel=alltrim(md)

if found()

WAIT WINDOW 'Записи добавлены в ОТЧЕТ' NOWAIT

else

sele d

delete all

pack

WAIT WINDOW 'Записей не найдено' NOWAIT

endif

do while found()

sele d

APPEND BLANK

replace firm_pk with c.firm_pk,;

fio_d with c.fio_d,;

gor with c.gor,;

adr with c.adr,;

tel with c.tel

sele c

continue

enddo

CASE button = 'Просмотр'

do qqqq

CASE button = 'Выход'

clear read

WAIT WINDOW 'Поиск завершен' NOWAIT

return

CASE button = 'Очистить'

sele d

delete all

pack

md=space(6)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

ENDCASE

****************************

proc qqqq

activate window qqq

sele d

browse fields firm_ps:H='Фирма',naim_t:H='Наименование изделия',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

deactivate window qqq

deACTIVATE WINDOW tt

ACTIVATE WINDOW entry

***********************************

proc vv_t

sele a

set century on

set date german

set talk off

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

naim=space(10)

md=space(10)

kl=0

cn=0

hr=space(8)

@ 2,2 say 'Введите:'

@ 4,2 say 'Наименование товара' get naim

@ 4,35 say 'Модель (марка)'get md

@ 6,2 say 'Характеристики товара'get hr

@ 8,2 say 'Количество ед. товара'get kl

@ 10,2 say 'Цена ед. товара'get cn

@ 14,14 GET button FUNCTION '*HN \?\<Ввод;\?\<Очистить;\?\<Просмотр;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ CYCLE

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Очистить'

kd=space(3)

naim=space(10)

md=space(10)

kl=0

cn=0

hr=space(8)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

CASE button = 'Выход'

CLEAR READ

WAIT WINDOW 'Ввод завершен' NOWAIT

CASE button = 'Ввод'

append blank

replace naim_t with naim,;

mod with md,;

kol with kl,;

cena with cn,;

har with hr

WAIT WINDOW 'Ввод записи произведен' NOWAIT

CASE button = 'Просмотр'

browse noedit

ENDCASE

************************************************************

proc vv_pk

sele c

set century on

set date german

set talk off

if lastkey()=27

set cursor on

deACTIVATE WINDOW entry

endif

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

fir=space(12)

gr=space(12)

ad=space(20)

tl=space(6)

f_d=space(15)

@ 2,2 say 'Введите:'

@ 4,2 say 'Название фирмы покупателя '

@ 4,30 get fir

@ 6,2 say 'ФИО директора'

@ 6,30 get f_d

@ 8,2 say 'Город'

@ 8,30 get gr

@ 10,2 say 'Адрес(ул/дом) '

@ 10,30get ad

@ 12,2 say 'Телефон'

@ 12,30get tl

@ 16,14 GET button FUNCTION '*HN \?\<Ввод;\?\<Очистить;\?\<Просмотр;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ CYCLE

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Очистить'

fir=space(12)

gr=space(12)

ad=space(20)

tl=space(6)

f_d=space(15)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

CASE button = 'Выход'

deACTIVATE WINDOW entry

CLEAR READ

WAIT WINDOW 'Ввод завершен' NOWAIT

CASE button = 'Ввод'

append blank

replace firm_pk with fir,;

gor with gr,;

adr with ad,;

tel with tl,;

fio_d with f_d

WAIT WINDOW 'Ввод записи произведен' NOWAIT

CASE button = 'Просмотр'

browse fields firm_pk:H='Фирма',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

ENDCASE

************************************************************

proc vv_ps

sele b

set century on

set date german

set talk off

TITLE 'Введите данные' FLOAT SHADOW SYSTEM COLOR SCHEME 10

ACTIVATE WINDOW entry

n_t=space(12)

fir=space(12)

gr=space(12)

ad=space(20)

tl=space(6)

f_d=space(15)

@ 2,2 say 'Введите:'

@ 4,2 say 'Название фирмы поставщика '

@ 4,30 get fir

@ 6,2 say 'Постовляемый товар'

@ 6,30 get n_t

@ 8,2 say 'ФИО директора'

@ 8,30 get f_d

@ 10,2 say 'Город'

@ 10,30 get gr

@ 12,2 say 'Адрес(ул/дом) '

@ 12,30get ad

@ 14,2 say 'Телефон'

@ 14,30get tl

@ 16,14 GET button FUNCTION '*HN \?\<Ввод;\?\<Очистить;\?\<Просмотр;\?\<Выход' ;

SIZE 1,9,2 DEFAULT '' VALID clearexit()

READ CYCLE

if lastkey()=27

set cursor on

deACTIVATE WINDOW entry

endif

RELEASE WINDOW entry

FUNCTION clearexit

DO CASE

CASE button = 'Очистить'

n_t=space(12)

fir=space(12)

gr=space(12)

ad=space(20)

tl=space(6)

f_d=space(15)

SHOW GETS

WAIT WINDOW 'Повторите ввод' NOWAIT

CASE button = 'Выход'

deACTIVATE WINDOW entry

CLEAR READ

WAIT WINDOW 'Ввод завершен' NOWAIT

CASE button = 'Ввод'

append blank

replace firm_ps with fir,;

naim_t with n_t,;

gor with gr,;

adr with ad,;

tel with tl,;

fio_d with f_d

WAIT WINDOW 'Ввод записи произведен' NOWAIT

CASE button = 'Просмотр'

browse fields firm_ps:H='Фирма',naim_t:h='Наименование товара',gor:H='Город',adr:H='Адрес',tel:H='Телефон',fio_d:H='ФИО директора'

ENDCASE

************************************************************

Размещено на Allbest.ru