Uггirele wind SFEDIT
enddo
Местами поменяй.
А так вроде все как надо.Поменял... Не помогло... :-((
А по поводу того, что вы мне тут наговорили, я хочу опубликовать все тексты программ (их 5) из курсовой своего одногрупника, которую препод очень похвалил.
Итак, текст 1-ой программы - MMM.PRG (главная программа): 1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
parameters progr
clea
clea all
set prin off
set cons on
set talk off
set conf on
set safe off
set esca off
SET CENTURY ON
set date to german
set bell to 300 , 1
set clock off && выключение часов
close all && зыкрытие всех баз данных
set cursor off && выключение курсора
set talk off && отмена выдачи протокола
set deleted on
clear && очистка экрана
define window p1 from 10 , 39 to 12 , 41
define window m from 16 , 14 to 18 , 67 doubl float color scheme 7
activate window p1
store 12 to i,i1
store 40 to j,j1
&& цикл разворачивания окна
do while i# 0 .or.j# 0 .or.i1# 24 .or.j1# 79
f= 0
i=iif(i> 0 ,i- 1 , 0 )
j=iif(j> 0 ,j- 2 , 0 )
i1=iif(i1< 24 ,i1+ 1 , 24 )
j1=iif(j1< 79 ,j1+ 2 , 79 )
zoom window p1 norm at i,j to i1,j1
enddo
text && вывод на экран заставки, начало text
ЯЯЯ ЯЯЯ
ЯЯ ЯЯ
ЯЯ ЯЯ
ЯЯ ЯЯ ЯЯЯ ЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯ ЯЯ
ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ
ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ
ЯЯ ЯЯ ЯЯ ЯЯЯ ЯЯ ЯЯЯ ЯЯ ЯЯЯЯЯ ЯЯ ЯЯ ЯЯ
ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ
ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ
ЯЯЯ ЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯ
Приятно Вам поработать!
endtext && завершение вывода, endtext
save screen to jonny && сохраняем экран в переменную jonny
activate wind m
@ 0 , 5 say'Для пpодолжения pаботы нажмите любую клавишу.'
read
clear windows && убирает из памяти все окна
set cursor on && включение курсора
SET COLOR TO gr
*set defa to c:\
do menugl
proc menugl
*--- помощь, если есть файл помощи ---*
if file('HELPM.PRG').or.file('HELPM.FXP')
on key labe F1 do HELPM.PRG
endi
*set defa to KR
set cloc on
*set color to w,w/b, r/w && установка цвета - белый на синем,
*set color to 1 / 2 ,b/g+,gr+/rb+
&& а для часов красный на белом
SET CLOCK TO 3 , 70
defi wind EWIND from 0 , 0 to 4 , 79 colo gr+/r,gr+/r,gr+/r
set hours to 24 && установка 24 часового исчисления
k=td1( 20 ,date())
@ 10 , 1 say' ЯЯЯ ЯЯЯ '
@ 11 , 1 say' ЯЯ ЯЯ '
@ 12 , 1 say' ЯЯ ЯЯ '
@ 13 , 1 say' ЯЯ ЯЯ ЯЯЯ ЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯ ЯЯ'
@ 14 , 1 say' ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ'
@ 15 , 1 say' ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ'
@ 16 , 1 say' ЯЯ ЯЯ ЯЯ ЯЯЯ ЯЯ ЯЯЯ ЯЯ ЯЯЯЯЯ ЯЯ ЯЯ ЯЯ'
@ 17 , 1 say' ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ'
@ 18 , 1 say' ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ ЯЯ'
@ 19 , 1 say' ЯЯЯ ЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯЯ ЯЯЯ'
define menu mainmenu in screen color gr/bg,r/bg,gr/bg,gr/bg,gr+/w,rb/w,gr+/bg
set defa to c:\KR1
define pad new of mainmenu prompt'\<Склад продуктов' at 5 , 7 ;
message 'Ввод,просмотр и редакторование данных по количеству продуктов на складе'
define pad kask of mainmenu prompt'\<БД Блюд' at 5 , 25 ;
message 'Просмотр и ввод новых блюд в базу данных'
define pad spr of mainmenu prompt'\<Формирование меню' at 5 , 35 ;
message 'Печать меню и накладной на израсходованные продукты'
define pad pom of mainmenu prompt'\<Помощь' at 5 , 55 ;
message 'Помощь в работе с программой'
define pad vih of mainmenu prompt'\<Выход' at 5 , 64 ;
message 'Выход из программы'
on selection pad new of mainmenu do skladpro.prg
on selection pad kask of mainmenu do bluda.prg
on selection pad spr of mainmenu activate popup sprpop
on selection pad pom of mainmenu do helpm.prg
on selection pad vih of mainmenu do end
define popup sprpop from 6 , 35 color ,r/bg,r/bg,,gr+/w,rb/w,gr+/bg
define bar 1 of sprpop prompt' Меню на ужин ' message 'Формирование меню и накладной на определенное кол.людей '
define bar 2 of sprpop prompt' Меню на день '
on selection bar 1 of sprpop do formenu
on selection bar 2 of sprpop do menuden
acti wind EWIND
@ 0 , 15 say 'Курсовая работа студента 1 курса гр.9ПИЭ-51'
@ 2 , 27 say'Сегодня: '+k
acti menu mainmenu
**** Процедура выхода ****
proc end
hide menu mainmenu && скрытие меню
set cursor off
define window en from 9 , 16 to 11 , 60 shadow color r/w
activate window en
@ 0 , 1 say'Подтверждение выхода из программы - Enter'
read
if lastkey()<> 13
deactivate window en
return
else
quit
endif
************************************************
function td1
para m,k
dn=alltrim(STR(day(k)))
g=alltrim(STR(year(k)))
ms=month(k)
dime s( 12 )
s( 1 )='ЯHВАРЯ'
s( 2 )='ФЕВРАЛЯ'
s( 3 )='МАРТА'
s( 4 )='АПРЕЛЯ'
s( 5 )='МАЯ'
s( 6 )='ИЮHЯ'
s( 7 )='ИЮЛЯ'
s( 8 )='АВГУСТА'
s( 9 )='СЕHТЯБРЯ'
s( 10 )='ОКТЯБРЯ'
s( 11 )='HОЯБРЯ'
s( 12 )='ДЕКАБРЯ'
sd=padr((dn+s(ms)+' '+g),m)
return sd
Текст 2-ой программы - SKLADPRO.PRG (склад продуктов): 1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
********************************************************************************
****************** Работа с БД продуктов ***************
close data
*SET DEFAULT TO C:\kr
sele a
use product.dbf
push key clea
defi wind SFEDIT from 5 , 8 to 20 , 65 ;
titl '<<< БД продуктов >>>' foot ' F8_удаление F7_редактирование F5_добавить F10_ВЫХОД 'color w,r/br,gr+/rb+,gr+/br
acti wind SFEDIT
on key labe f7 do red_v
on key labe f5 do dob
on key labe F10 keyboard '{Ctrl+END}'
on key labe F8 do del
on key labe HOME go top
on key labe END go bott
pack
brow ;
fiel naim:h='Hаименование': 25 ,;
kol:h='Количество': 15 ,;
sum:h='Цена': 12 ;
noed noap in wind SFEDIT
rele wind SFEDIT
set deleted on
on key labe f5
on key labe f7
on key labe f10
on key labe F8
on key labe HOME
on key labe END
clos data
on key labe F1 do HELPM.PRG
retu
********************************************************************************
****************** Процедура ввода записей БД продуктов ***************
proc dob
push key clear
defi wind dobav from 7 , 8 to 16 , 70 ;
titl '<<< Ввод продукта на склад >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B
acti wind dobav
dime s( 4 )
store 0 to s( 1 ),s( 3 )
store 0 . 0 to s( 4 )
store space( 15 ) to s( 2 )
if eof()
s( 1 )= 1
else
INDEX ON id TAG id
go BOTTOM
s( 1 )=id+ 1
endif
@ 1 , 5 say'Hаименование'
@ 3 , 2 say'Количество (кг/шт)'
@ 3 , 40 say'Цена'
@ 1 , 20 get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxxxxxxxxxx'
@ 3 , 20 get s( 3 ) pict'###.###'
@ 3 , 47 get s( 4 ) pict'9999.99'
i= 0
@ 6 , 40 get i function '*h\! ОК;Отмена' size 1 , 8 , 2
read cycle
if i= 1
append blank
gather from s
ENDIF
rele wind dobav
pop key
return
********************************************************************************
****************** Процедура редактирования записей БД продуктов ***************
proc red_v
if !eof()
push key clear
defi wind red from 7 , 8 to 16 , 70 ;
titl '<<< Редактирование продукта на складе >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B
acti wind red
dime s( 4 )
s( 1 )=id
s( 2 )=naim
s( 3 )=kol
s( 4 )=sum
@ 1 , 5 say'Hаименование'
@ 3 , 2 say'Количество (кг/шт)'
@ 3 , 40 say'Цена'
@ 1 , 20 get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxxxxxxxxxx'
@ 3 , 20 get s( 3 ) pict'###.###'
@ 3 , 47 get s( 4 ) pict'9999.99'
i= 0
@ 6 , 40 get i function '*h\! ОК;Отмена' size 1 , 8 , 2
read cycle
if i= 1
gather from s
ENDIF
rele wind red
pop key
endif
return
********************************************************************************
****************** Процедура удаления записей БД ***************
proc del
if !eof()
push key clear
define window vnc from 7 , 15 to 12 , 56 title '"ВHИМАHИЕ"';
shad doub color r+/b,n/n,rb/bg+
ACTI WIND vnc
store 0 to i
@ 0 , 12 SAY ' УДАЛИТЬ ЗАПИСЬ'
@ 2 , 7 get i function '*h\! ОК;Отмена' size 3 , 13 , 3
READ
IF i= 1
delete
endif
rele wind vnc
pop key
endif
return
Текст 3-ей программы - BLUDA.PRG (БД блюд): 1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
********************************************************************************
****************** Работа с БД блюд ***************
close data
*SET DEFAULT TO C:\kr
sele c
use rasklad
sele b
use nazblud.dbf
push key clea
defi wind SFEDIT from 5 , 8 to 20 , 65 ;
titl '<<< Список блюд >>>' foot ' F8_удаление F7_редактирование F5_добавить F10_ВЫХОД 'COLOR SCHEME 5
*color w,r/br,gr+/rb+,gr+/br
acti wind SFEDIT
on key labe f7 do red_v
on key labe f5 do dob
on key labe F10 keyboard '{Ctrl+END}'
on key labe F8 do del1
pack
brow ;
fiel naimblud:h='Hаименование': 55 ;
noed noap in wind SFEDIT
rele wind SFEDIT
set deleted on
on key labe f5
on key labe f7
on key labe f10
on key labe F8
clos data
on key labe F1 do HELPM.PRG
retu
********************************************************************************
****************** Процедура ввода записей БД блюд ***************
proc dob
push key clear
defi wind dobav from 7 , 8 to 16 , 70 ;
titl '<<< БЛЮДО >>>'foot 'Выход - Esc' color w,r/w+
*color , , W+/B,W+/B,W
acti wind dobav
dime s( 3 )
store 0 to s( 1 )
store space( 20 ) to s( 2 )
store space( 138 ) to s( 3 )
if eof()
s( 1 )= 1
else
INDEX ON id TAG id
go BOTTOM
s( 1 )=id+ 1
endif
@ 1 , 2 say'Hаименование'
@ 3 , 2 say'Рецепт'
@ 1 , 15 get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxxxxxxxxxx'
@ 3 , 15 get s( 3 )
i= 0
@ 7 , 40 get i function '*h\! ОК;Отмена' size 1 , 8 , 2
read cycle
if i= 1
append blank
gather from s
push key clear
sele c
set filter to idblud=s( 1 )
dime k( 4 )
store 0 to k( 1 ),k( 2 ),k( 3 )
k( 4 )= 0 . 0
rele wind dobav
defi wind raskl from 9 , 15 to 14 , 50 ;
titl '<<< '+s( 2 )+' >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B
defi wind raskl1 from 15 , 15 to 18 , 50
acti wind raskl1
acti wind raskl
on key labe f5 do dobraskl
on key labe F8 do del
on key labe F10 keyboard '{Ctrl+END}'
brow;
fiel kolpr:h='Количество продукта (кг/шт/л)':w=tov();
noed in wind raskl
endif
rele wind r1
rele wind raskl1
rele wind raskl
rele wind dobav
set filter to
pop key
on key labe f7 do red_v
on key labe f5 do dob
on key labe F10 keyboard '{Ctrl+END}'
on key labe F8 do del1
return
proc dobraskl
push key clear
define window w1 from 10 , 15 to 17 , 63 title '"Выбор продукт"' double shadow color 0 / 3 , 7 / 1 , 0 / 2
activate window w1
w= 0
@ 1 , 2 get w pict '@*hN Выберите продукт'VALID tovar() color r/bg
@ 3 , 2 say 'Введите количество' get k( 4 ) PICT '###.###'
i= 0
@ 5 , 28 get i function '*h\! ОК;Отмена' size 1 , 8 , 2
read cycle
if i= 1
k( 2 )=s( 1 )
append blank
gather from k
endif
rele wind w1
pop key
return
proc tovar
sele a
use product.dbf
go top
if eof()
wait 'Словаpь пуст-добавил запись. Введите пожалуйста данные. ' window nowait
else
defi popup p prompt FIELD naim from 1 , 5 to 10 , 40 ;
titl 'Список продуктов на складе' SHAD COLOR 0 / 3
on sele popup p do vib
acti popup p
ENDIF
SELE c
retu
proc vib
k( 3 )=id
@ 1 , 23 say naim color r/bg
deac popup p
retu
********************************************************************************
****************** Процедура редактирования записей БД блюд ***************
proc red_v
if !eof()
push key clear
defi wind red from 7 , 8 to 16 , 70 ;
titl '<<< БЛЮДО >>>'foot 'Выход - Esc'color w,r/w+
* color , , W+/B,W+/B,W+/B
acti wind red
dime s( 3 )
s( 1 )=id
s( 2 )=naimblud
s( 3 )=recept
@ 1 , 2 say'Hаименование'
@ 3 , 2 say'Рецепт'
@ 1 , 15 get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxxxxxxxxxx'
@ 3 , 15 get s( 3 )
i= 0
@ 7 , 40 get i function '*h\! ОК;Отмена' size 1 , 8 , 2
read cycle
if i= 1
gather from s
push key clear
sele c
set filter to idblud=s( 1 )
dime k( 4 )
store 0 to k( 1 ),k( 2 ),k( 3 )
k( 4 )= 0 . 0
rele wind red
defi wind raskl from 9 , 15 to 14 , 50 titl padc(s( 2 ), 30 ,"=")
defi wind raskl1 from 15 , 15 to 17 , 50
acti wind raskl1
acti wind raskl
on key labe f5 do dobraskl
on key labe F8 do del
on key labe F10 keyboard '{Ctrl+END}'
brow fiel kolpr:h='Количество продукта (кг/шт/л)':w=tov();
noed in wind raskl
deactiv wind r1
rele wind raskl
rele wind raskl1
rele wind dobav
set filter to
endif
on key labe f7 do red_v
on key labe f5 do dob
on key labe F10 keyboard '{Ctrl+END}'
on key labe F8 do del1
rele wind red
endif
return
********************************************************************************
****************** Процедура удаления записей БД ***************
proc del
if !eof()
push key clear
define window vnc from 7 , 15 to 12 , 56 title '"ВHИМАHИЕ"';
shad doub color r+/b,n/n,rb/bg+
ACTI WIND vnc
store 0 to i
@ 0 , 12 SAY ' УДАЛИТЬ ЗАПИСЬ'
@ 2 , 7 get i function '*h\! ОК;Отмена' size 3 , 13 , 3
READ
IF i= 1
delete
endif
rele wind vnc
pop key
endif
return
********************************************************************
****************** Процедура удаления записей БД блюд ***************
proc del1
if !eof()
push key clear
define window vnc from 7 , 15 to 12 , 56 title '"ВHИМАHИЕ"';
shad doub color r+/b,n/n,rb/bg+
ACTI WIND vnc
store 0 to i
@ 0 , 12 SAY ' УДАЛИТЬ ЗАПИСЬ'
@ 2 , 7 get i function '*h\! ОК;Отмена' size 3 , 13 , 3
READ
IF i= 1
sele c
set filter to idblud=b.id
go top
do while !eof()
delete
skip
enddo
sele b
delete
endif
rele wind vnc
pop key
endif
return
********************************************************************
procedure tov
idproduc1=idproduc
sele a
use product.dbf
push key clea
acti wind raskl1
locate for id=idproduc1
clear
@ 0 , 0 say naim
CONTINUE
sele c
show gets
acti wind raskl
pop key
return .T.
deac wind raskl
deac wind raskl1
Текст 4-ой программы - MENUDEN.PRG (меню блюд): 1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.
235.
236.
237.
238.
239.
240.
241.
242.
243.
244.
245.
246.
247.
248.
249.
250.
251.
252.
253.
254.
255.
256.
257.
258.
259.
260.
261.
262.
263.
264.
265.
266.
267.
268.
269.
270.
271.
272.
273.
274.
275.
276.
277.
278.
279.
280.
281.
282.
283.
284.
285.
286.
287.
288.
289.
290.
291.
292.
293.
294.
295.
296.
297.
298.
299.
300.
301.
302.
303.
304.
305.
306.
307.
308.
309.
310.
311.
312.
313.
314.
315.
316.
317.
318.
319.
320.
321.
322.
323.
324.
325.
326.
327.
328.
329.
330.
331.
332.
333.
334.
335.
336.
337.
*SET DEFAULT TO C:\kr
set alte to menuden.txt
set alte on
close data
sele a
use nazblud.dbf
sele c
use rasklad
sele b
use product
define window w1 from 10 , 15 to 15 , 63 title '"Данные о количестве персон"' double shadow color 0 / 3 , 7 / 1 , 0 / 2
activate window w1
per= 1
store ' ' to god
@ 1 , 2 say 'Введите количество персон 'get per
i= 0
@ 3 , 28 get i function '*h\! ОК;Отмена' size 1 , 8 , 2
read cycle
if i= 1
if per> 0
sele a
go top
do while !eof()
replace vibor with 0
skip
enddo
go top
push key clea
defi wind SFEDIT from 5 , 8 to 15 , 65 ;
titl '<<< Список блюд >>>' foot ' F4_УБРАТЬ F5_ДОБАВИТЬ F12_СФОРМИРОВАТЬ F10_ВЫХОД 'COLOR SCHEME 5
*COLO w,gr+/br
defi wind EDIT from 16 , 8 to 22 , 65 ;
titl '<<< Рецепт >>>' COLOR SCHEME 5
*COLO w,gr+/br
acti wind EDIT
acti wind SFEDIT
on key labe F10 keyboard '{Ctrl+END}'
on key labe F12 do MD
on key labe F5 do dd
on key labe F4 do uu
brow ;
fiel naimblud:h='Hазвания блюд': 40 :w=tov1(),;
vibor:h='Использовать';
noed noap in wind SFEDIT
rele wind SFEDIT
rele wind EDIT
set deleted on
on key labe f12
on key labe f5
on key labe f4
on key labe f10
clos data
else
wAIT 'Количество людей не может быть 0' WINDOW
endif
endif
deac wind w1
on key labe F1 do HELPM.PRG
retu
proc dd
dime pro1( 1000 )
sele b
go top
do while !eof()
pro1(id)= 0
skip
enddo
sele a
id11=id
go top
do while !eof()
if vibor<> 0
sele c
go top
do while !eof()
if ((idblud=a.id).and.(a.id<>id11))
pro1(idproduc)=pro1(idproduc)+kolpr*per
endif
skip
enddo
endif
sele a
skip
enddo
sele a
LOCATE FOR id=id11
sele c
go top
k1= 0
do while !eof()
if idblud=a.id
sele b
go top
LOCATE FOR id=c.idproduc
if (c.kolpr*per>kol-pro1(id))
k1=k1+ 1
endif
endif
sele c
skip
enddo
if k1= 0
sele a
replace vibor with 1
else
define window w1 from 10 , 5 to 17 , 74 title '"ВHИМАHИЕ"' double shadow color 0 / 3 , 7 / 1 , 0 / 2
acti wind w1
@ 1 , 2 say 'Количество товара на складе необходимого для приготовления блюда'
@ 2 , 2 say PADC(rtrim(a.naimblud), 65 ,"*")
@ 3 , 2 say ' недостаточно!!! '
@ 4 , 2 say ' Пополните запасы и можете включить это блюдо в список'
read cycle
deac wind w1
endif
return
proc uu
push key clea
if !eof()
replace vibor with 0
endif
pop key
return
proc tov1
push key clea
acti wind EDIT
clear
@ 0 , 0 say recept
show gets
acti wind sfEDIT
pop key
return
deac wind sfedit
deac wind edit
***********************************************************
**Процедура формирования меню на ужин(накладная на расходы)**
***********************************************************
proc md
*SET DEFAULT TO C:\kr
set alte to menuden.txt
set alte on
close data
sele a
use nazblud.dbf
sele c
use rasklad
sele b
use product
push key clea
koli= 0
sele a
go top
do while !eof()
if vibor= 1
koli=koli+ 1
endif
skip
enddo
dime blude( 1000 ),r( 1000 )
sele a
go top
do while !eof()
if vibor= 1
blude(id)= 0
endif
skip
enddo
sele b
go top
do while !eof()
R(id)=kol
skip
enddo
sele a
go top
do while !eof()
if vibor= 1
sele c
go top
k1= 0
do while !eof()
if idblud=a.id
sele b
go top
LOCATE FOR id=c.idproduc
R(id)=kol-c.kolpr*per
REPLACE KOL WITH R(id)
*endif
endif
sele c
skip
enddo
sele a
endif
skip
enddo
?padc('МЕHЮ HА УЖИH', 77 ,"*")
?
?
?
SELE A
GO TOP
i= 0
DO WHILE !EOF()
if vibor= 1
i=i+ 1
?padc(I, 1 )+'. '+PADR(RTRIM(NAIMBLUD), 70 )
ENDIF
SKIP
ENDDO
?
?
?
?'Hакладная расходов меню на день в количестве '+padr(per, 5 )+'персон'
?'Ъ--------------------В----------В-----------В-----------В--------------ї'
?'і Hаименование іК-во(кг/л)і Цена(руб.)іСумма(руб.)і Итого(руб.) і'
?'Г--------------------Б----------Б-----------Б-----------Б--------------ґ'
SELE A
GO TOP
DO WHILE !EOF()
store 0 . 0 to sumb,sumvs
if vibor= 1
*IF BLUDE(ID)<> 0
?'і'+PADC(NAIMBLUD, 70 )+'і'
?'ЖННННННННННННННННННННСННННННННННСНННННННННННСНННННННННННСННННННННННННННµ'
sele c
go top
k1= 0
do while !eof()
if idblud=a.id
sele b
go top
LOCATE FOR id=c.idproduc
?'і'+padc(naim, 20 )+'і'+padc(c.kolpr, 10 )+'і'+padc(sum, 11 )+'і'+padc(sum*c.kolpr, 11 )+'і'+padc(per*c.kolpr*sum, 14 )+'і'
sumb=sumb+sum*c.kolpr
sumvs=sumvs+sum*c.kolpr*per
sele c
endif
skip
if eof()
?'ЖННННННННННННННННННННПННННННННННПНННННННННННШНННННННННННШННННННННННННННµ'
?'іИтого по блюду і'+padc(sumb, 11 )+'і'+padc(sumvs, 14 )+'і'
?'Г-------------------------------------------Б-----------Б--------------ґ'
endif
enddo
sele a
ENDIF
*endif
skip
ENDDO
?'А----------------------------------------------------------------------Щ'
?
?
?
?'Hакладная на расходы'
?'Ъ--------------------В----------В-----------В--------------ї'
?'і Товар іК-во(кг/л)і Цена(руб.)і Итого(руб.) і'
?'Г--------------------Е----------Е-----------Е--------------ґ'
sele b
go top
do while !eof()
sele c
go top
koli= 0
do while !eof()
*LOCATE FOR b.id=idproduc
*DO WHILE FOUND()
if b.id=idproduc
sele a
go top
do while !eof()
if ((c.idblud=id).and.(a.vibor<> 0 ))
koli=koli+(c.kolpr*per)
endif
skip
enddo
* CONTINUE
endif
sele c
skip
ENDDO
sele b
if koli<> 0 . 0
?'і'+padc(naim, 20 )+'і'+padc(koli, 10 )+'і'+padc(sum, 11 )+'і'+padc(sum*koli, 14 )+'і'
endif
skip
enddo
?'А--------------------Б----------Б-----------Б--------------Щ'
CLOSE alte TO
*SET DEFAULT TO C:\kr
do ModiDisp with 'menuden.txt'
return
****************************************************************************************
*--- пpосмотp печатной фоpмы ---*
proc ModiDisp
para FFIL
defi wind KORR from 0 , 0 to 24 , 79 titl 'ESC_выйти F9_печать l' ;
foot FFIL COLOR w,r/br
acti wind KORR
on key labe F9 do ModiPrin with FFIL
modi comm (FFIL) wind KORR noedit
on key labe F9
rele wind KORR
retu
*****************************************************************************************
*--- печать из modi comm ---*
proc ModiPrin
para FFIL
on key labe ESC
for YY= 1 to 3
if !prin()
wait 'принтер не готов !' wind
else
exit
endi
endf
if !prin()
retu
endi
rele wind l
set cons off
type (FFIL) to print
set cons on
retu
**************************************************************************
И наконец, текст 5-ой программы - HELPM.PRG (файл помощи работы с курсовой): 1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
set proc to menuden.prg
if file('help.txt')
close alte to
do ModiDisp with 'help.TXT'
else
set alte to help.txt
set alte on
?'Файл помощи удален!!! Разбирайся сам.'
close alte to
do ModiDisp with 'help.TXT'
endif
set proc to
return
Вот. Здесь всё работает. Кто не верит, может опубликовать своё мыло и тот получит по лбу... Шутка! Получит все файлы курсовой (т.к. без остальных файлов многие пункты работать не будут.), проверит и выскажет своё мнение. Надеюсь я ответил на все ваши вопросы. Если нет спрашивайте, что вас интересует. |
