ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / FoxPro, Visual FoxPro [игнор отключен] [закрыт для гостей] / Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
25 сообщений из 68, страница 2 из 3
  2  все
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33848620
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Время для написание длинных объяснений у тебя есть, а на то, чтобы мне помочь исправить очевидные для тебя ошибки - нет, да? Ну чтож, видно придётся мне искать другой форум, на котором у людей есть время не только на работу и поиск новых тем тех, кому много раз отказывали в помощи и написании в них оскорбительных писем, но и на помощь людям, нуждающимся в помощи. Последняя просьба. Может быть у кого-нибудь есть программы, в которых используются подобные функции, которые необходимы для моего задания:
Задание

Администратор гостиницы. Список номеров: класс, число мест. Список гостей: паспортные данные, даты приезда и отъезда, номер. Поселение гостей: выбор подходящего номера (при наличии свободных мест), регистрация, оформление квитанции. Отъезд: выбор всех постояльцев, отъезжающих сегодня, освобождение места или оформление задержки с выпиской дополнительной квитанции. Возможность досрочного отъезда с перерасчетом. Поиск гостя по произвольному признаку.

М-да... Прочитав ещё раз задание, я понял, что занимаюсь полной фигнёй! Поэтому, если мне никто помогать не хочет, то выложите, пожалуйста, некоторые программы, в которых используется то, что мне надо для того, чтобы полностью выполнить задание курсовой.
...
Рейтинг: 0 / 0
12.07.2006, 15:54
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33849038
Фотография Redrik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Redrik
Участник
На совет внимательно почитать Попова:
parenyokДаже уже говорить ничего не хочу по этому поводу! Задолбал уже!
И после вот такое:
parenyokоскорбительных писем
Ну и ну... :-(
...
Рейтинг: 0 / 0
12.07.2006, 17:36
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33852813
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
RedrikНа совет внимательно почитать Попова:
parenyokДаже уже говорить ничего не хочу по этому поводу! Задолбал уже!
И после вот такое:
parenyokоскорбительных писем
Ну и ну... :-(Просто я по поводу книги уже неоднократно говорил, а если человек продолжает издиваться, то не остаётся другого выхода, как писать ему подобные сообщения.

М-да... Я вот тут подумал насчёт книги и решил, что надо было всё-таки сказать Стасу свой почтовый адрес. Стас, ты отправил уже книгу или у меня ещё есть шанс?

И всё-таки по поводу примеров программ. Есть у кого-нибудь что-нибудь, нет?
...
Рейтинг: 0 / 0
14.07.2006, 09:07
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33856110
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Скажите, пожалуйста, какая команда осуществляет поиск в БД по определённому признаку? Например, по фамилии, паспорту и т.д.
...
Рейтинг: 0 / 0
16.07.2006, 11:00
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33856123
Penner
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Penner
Участник
Если есть подходящий индекс - SEEK
если нет - LOCATE
...
Рейтинг: 0 / 0
16.07.2006, 11:19
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33856302
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Спасибо! А как ей пользоваться? Например, я в этой программе:
Код: plaintext
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.
********************************************************************************
****************** Работа с БД гостей ***************
close data
*SET DEFAULT TO C:\kr
sele a
use guests.dbf
push key clea
defi wind SFEDIT from  1 , 00  to  18 , 95 ; 
titl '<<< Список гостей >>>' foot 'F3-поиск F5-добавить F8-удалить  F7-редактировать Esc-выход 'color w,r/br,gr+/rb+,gr+/br 
acti wind SFEDIT
on key labe f3 do poisk
on key labe f7 do red_v
on key labe f5 do dob
*on key labe F10 do keyboard '{Ctrl+END}' do_vih 
on key labe F8 do del
on key labe HOME go top
on key labe END go bott
pack 
browse;
      fiel mes:h='Место': 5 ,;
           fam:h='ФИО': 15 ,;
           pol:h='Пол': 3 ,;
           pas:h='ь паспорта': 10 ,;
           pri:h='Дата прибытия': 13 ,;
           otb:h='Дата отбытия': 12 ,;
           opl:h='Оплачено до': 11 ,;
           num:h='ь гостя': 7 ;
           noed noap in wind SFEDIT

rele wind SFEDIT
set deleted on
on key labe f3
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 HELP.PRG
retu
********************************************************************************
****************** Процедура ввода записей БД гостей ***************
proc dob
push key clear
defi wind dobav from  4 , 8  to  17 , 70 ; 
titl '<<< Характеристики нового гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B 
acti wind dobav
dime s( 8 )
store space( 5 ) to s( 1 )
store space( 20 ) to s( 2 )
store space( 1 ) to s( 3 )
store space( 10 ) to s( 4 )
store space( 10 ) to s( 5 )
store space( 10 ) to s( 6 )
store space( 10 ) to s( 7 )
store space( 2 ) to s( 8 )
if eof()
s( 1 )= 1 
else
go BOTTOM
endif
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

*i= 0 
a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
*@  2 , 7  get i function '*h\! ОК;Отмена' size  3 , 13 , 3 
read cycle 
if a= 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  4 , 8  to  17 , 50 ; 
titl '<<< Редактирование гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B
acti wind red
dime s( 8 )
s( 1 )=mes
s( 2 )=fam
s( 3 )=pol
s( 4 )=pas
s( 5 )=pri
s( 6 )=otb
s( 7 )=opl
s( 8 )=num
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
read cycle 
if a= 1 
gather from s
ENDIF
rele wind red
pop key
endif
return
********************************************************************************
****************** Процедура удаления записей БД  ***************
proc del
if !eof()
push key clear
define window vnc from  10 , 23  to  15 , 50   title '"ВHИМАHИЕ"';
shad doub color r+/b,n/n,rb/bg+ 
ACTI WIND vnc
store  0  to i
A= 0 
B= 0 
@  0 , 05  SAY ' УДАЛИТЬ ЗАПИСЬ' 
@  2 , 03  GET A FUNC '*   OK' 
@  2 , 13  GET B FUNC '*  Отмена' 
*@  2 , 7  get i function '*h\! ОК;Отмена' size  3 , 13 , 3 
READ
IF a= 1 
delete
endif
rele wind vnc
pop key
endif
return
******************************************************************
          **** Процедура поиска ****
procedure poisk
define window find from  1 , 1  to  23 , 60  title 'Поиск гостей' double 
acti wind find
store SPACE( 15 ) to U
@  17 , 10  say'ESC-Выход'
@  1 , 9  say'Искать по:'
* get U  picture  ('xxxxxxxxxxxxxxx')
@  4 , 12  say'      Где искать?'
read
k= 0 
@  3 , 5   prompt 'Месту в гостинице'
@  5 , 5   prompt 'Фамилии'
@  7 , 5   prompt 'Полу'
@  9 , 5   prompt 'Паспорту'
@  11 , 5   prompt 'Дате прибытия'
@  13 , 5  prompt 'Дате отбытия '
@  15 , 5  prompt 'Дате оплаты'
@  17 , 5  prompt 'ь гостя'
menu to k
do case
case k= 1 
use guests.dbf
brow title 'БД гостя';
       mes :h='Место': 5 , ;
       fam :h='ФИО': 20 , ;
       pol :h='Пол': 3 , ;
           :w=(pol='М' or pol='Ж') and pl(left(mes, 3 ),pol), ;
           :e='Только М или Ж', ;
       pas :h='ь паспорта': 10 , ;
       pri :h='Дата прибытия': 13 , ;
       otb :h='Дата отбытия': 12 , ;
       opl :h='Оплачено до': 11 , ;
       num :h='ь гостя': 7  ;
       
case k= 2 
deacti wind find
endcase
do wixod 
retu
proc wixod
define window w1 from  7 ,  25  to  12 ,  55  ;
double color scheme  9 
acti wind w1
k= 0 
@  1 , 2  say'     Продолжить поиск? '
@  3 , 2   prompt'  Нет   '
@  3 , 20  prompt'  Да    '
menu to k
do case
case k= 1 
hide wind w1
deacti wind w1
do poisk
case k= 2 
deacti wind w1
deacti wind find
close data
endcase
retu
решил сделать процедуру поиска. Скопировал её из другой программы и переделываю под свою. Только я не пойму как написать процедуру поиска так, чтобы при выборе признака, например, "по фамилии", выводилось окно, в котором пользователь бы вводил ФИО гостя и производился бы поиск. Объясните, пожалуйста. На всякий случай вот архив с курсовой.
...
Рейтинг: 0 / 0
16.07.2006, 14:13
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33856681
Ужас, летящий на крыльях ночи
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ужас, летящий на крыльях ночи
Гость
parenyok Только я не пойму как написать процедуру поиска так, чтобы при выборе признака, например, "по фамилии", выводилось окно, в котором пользователь бы вводил ФИО гостя и производился бы поиск. Объясните, пожалуйста.
Все очень просто:
1. Делаешь окно (зто ты умеешь уже )
2. в символьную переменную считывашь значение, которое надо найти
3. делаешь поиск:
- если есть индекс по полю, то делаешь
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
r=recno()
go top
&&cString должна быть дополнена пробелами до длины индексного выражения
if seek(cString)
 r=recno()
 show window F10 refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif
-если нет индекса по полю, то :
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
 r=recno()
go top
locate for <fieldname>==cString 
if found()
 r=recno()
 show window F10 refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif
...
Рейтинг: 0 / 0
16.07.2006, 21:19
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33861735
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Большое тебе спасибо! Уфф! Ну и умаялся я с этой процедурой! Короче, вот что получилось:
Код: plaintext
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.
338.
339.
340.
341.
342.
343.
344.
345.
346.
347.
348.
349.
350.
351.
352.
353.
354.
355.
356.
357.
358.
359.
360.
361.
362.
363.
364.
365.
366.
367.
368.
369.
370.
371.
372.
373.
374.
375.
376.
********************************************************************************
****************** Работа с БД гостей ***************
close data
*SET DEFAULT TO C:\kr
sele a
use guests.dbf
push key clea
defi wind SFEDIT from  1 , 00  to  18 , 95 ; 
titl '<<< Список гостей >>>' foot 'F3-поиск F5-добавить F8-удалить  F7-редактировать Esc-выход 'color w,r/br,gr+/rb+,gr+/br 
acti wind SFEDIT
on key labe f3 do poisk
on key labe f7 do red_v
on key labe f5 do dob
*on key labe F10 do keyboard '{Ctrl+END}' do_vih 
on key labe F8 do del
on key labe HOME go top
on key labe END go bott
pack 
browse;
      fiel mes:h='Место': 5 ,;
           fam:h='ФИО': 15 ,;
           pol:h='Пол': 3 ,;
           pas:h='ь паспорта': 10 ,;
           pri:h='Дата прибытия': 13 ,;
           otb:h='Дата отбытия': 12 ,;
           opl:h='Оплачено до': 11 ,;
           num:h='ь гостя': 7 ;
           noed noap in wind SFEDIT

rele wind SFEDIT
set deleted on
on key labe f3
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 HELP.PRG
retu
********************************************************************************
****************** Процедура ввода записей БД гостей ***************
proc dob
push key clear
defi wind dobav from  4 , 8  to  17 , 70 ; 
titl '<<< Характеристики нового гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B 
acti wind dobav
dime s( 8 )
store space( 5 ) to s( 1 )
store space( 20 ) to s( 2 )
store space( 1 ) to s( 3 )
store space( 10 ) to s( 4 )
store space( 10 ) to s( 5 )
store space( 10 ) to s( 6 )
store space( 10 ) to s( 7 )
store space( 2 ) to s( 8 )
if eof()
s( 1 )= 1 
else
go BOTTOM
endif
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

*i= 0 
a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
*@  2 , 7  get i function '*h\! ОК;Отмена' size  3 , 13 , 3 
read cycle 
if a= 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  4 , 8  to  17 , 50 ; 
titl '<<< Редактирование гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B
acti wind red
dime s( 8 )
s( 1 )=mes
s( 2 )=fam
s( 3 )=pol
s( 4 )=pas
s( 5 )=pri
s( 6 )=otb
s( 7 )=opl
s( 8 )=num
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
read cycle 
if a= 1 
gather from s
ENDIF
rele wind red
pop key
endif
return
********************************************************************************
****************** Процедура удаления записей БД  ***************
proc del
if !eof()
push key clear
define window vnc from  10 , 23  to  15 , 50   title '"ВHИМАHИЕ"';
shad doub color r+/b,n/n,rb/bg+ 
ACTI WIND vnc
store  0  to i
A= 0 
B= 0 
@  0 , 05  SAY ' УДАЛИТЬ ЗАПИСЬ' 
@  2 , 03  GET A FUNC '*   OK' 
@  2 , 13  GET B FUNC '*  Отмена' 
*@  2 , 7  get i function '*h\! ОК;Отмена' size  3 , 13 , 3 
READ
IF a= 1 
delete
endif
rele wind vnc
pop key
endif
return
******************************************************************
          **** Процедура поиска ****
procedure poisk
define window find from  1 , 1  to  23 , 60 ;
title 'Поиск гостей' foot 'Esc - Выход' 
acti wind find
store SPACE( 20 ) to U
@  1 , 9  say'Искать по:'
* get U  picture  ('xxxxxxxxxxxxxxx')
*@  4 , 12  say'      Где искать?'
*read

k= 0 
@  3 , 5   prompt 'Месту в гостинице'
@  5 , 5   prompt 'Фамилии'
@  7 , 5   prompt 'Полу'
@  9 , 5   prompt 'Паспорту'
@  11 , 5   prompt 'Дате прибытия'
@  13 , 5  prompt 'Дате отбытия '
@  15 , 5  prompt 'Дате оплаты'
@  17 , 5  prompt 'ь гостя'
menu to k

do case
case k= 1 
use guests.dbf
defi wind mes from  5 , 20  to  15 , 70 ;
title 'Поиск по месту в гостинице' foot 'Esc - Выход'
acti wind mes
store SPACE( 5 ) to U
@  1 , 1  say'Введите место гостя:' get U  picture  ('xxxxx')
read

r=recno()
go top
locate for <mes>==cString 
if found()
 r=recno()
 show window SFEDIT refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif

case k= 2 
use guests.dbf
defi wind fam from  5 , 10  to  15 , 90 ;
title 'Поиск по фамилии' foot 'Esc - Выход'
acti wind fam
store SPACE( 20 ) to U
@  1 , 1  say'Введите фамилию или ФИО гостя целеком:';
get U  picture  ('xxxxxxxxxxxxxxxxxxxx')
read

r=recno()
go top
locate for <fam>==cString 
if found()
 r=recno()
 show window SFEDIT refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif

case k= 3 
use guests.dbf
defi wind pol from  5 , 20  to  15 , 70 ;
title 'Поиск по полу' foot 'Esc - Выход'
acti wind pol
r=recno()
store SPACE( 1 ) to U
@  1 , 1  say'Введите пол гостя:' get U  picture  ('x')
read

if U<>'М'.or.U<>'Ж'
   wait window nowait "Ошибка!!! Введите "М" или "Ж"!"
   go r
endif

r=recno()
go top
locate for <pol>==cString 
if found()
 r=recno()
 show window SFEDIT refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif

case k= 4 
use guests.dbf
defi wind pas from  5 , 10  to  15 , 90 ;
title 'Поиск по номеру паспорта' foot 'Esc - Выход'
acti wind pas
store SPACE( 10 ) to U
@  1 , 1  say'Введите ь паспорта гостя:';
get U  picture  ('9999999999')
read

r=recno()
go top
locate for <pas>==cString 
if found()
 r=recno()
 show window SFEDIT refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif

case k= 5 
use guests.dbf
defi wind pri from  5 , 10  to  15 , 90 ;
title 'Поиск по дате прибытия' foot 'Esc - Выход'
acti wind pri
store SPACE( 10 ) to U
@  1 , 1  say'Введите дату прибытия гостя:';
get U  picture  ('99.99.9999')
read

r=recno()
go top
locate for <pri>==cString 
if found()
 r=recno()
 show window SFEDIT refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif

case k= 6 
use guests.dbf
defi wind otb from  5 , 10  to  15 , 90 ;
title 'Поиск по дате отбытия' foot 'Esc - Выход'
acti wind otb
store SPACE( 10 ) to U
@  1 , 1  say'Введите дату отбытия гостя:';
get U  picture  ('99.99.9999')
read

r=recno()
go top
locate for <otb>==cString 
if found()
 r=recno()
 show window SFEDIT refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif

case k= 7 
use guests.dbf
defi wind opl from  5 , 10  to  15 , 90 ;
title 'Поиск по фамилии' foot 'Esc - Выход'
acti wind opl
store SPACE( 10 ) to U
@  1 , 1  say'Введите дату оплаты гостя:';
get U  picture  ('99.99.9999')
read

r=recno()
go top
locate for <opl>==cString 
if found()
 r=recno()
 show window SFEDIT refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif


brow title 'БД гостя';
       mes :h='Место': 5 , ;
       fam :h='ФИО': 20 , ;
       pol :h='Пол': 3 , ;
           :w=(pol='М' or pol='Ж') and pl(left(mes, 3 ),pol), ;
           :e='Только М или Ж', ;
       pas :h='ь паспорта': 10 , ;
       pri :h='Дата прибытия': 13 , ;
       otb :h='Дата отбытия': 12 , ;
       opl :h='Оплачено до': 11 , ;
       num :h='ь гостя': 7  ;
       
case k= 8 
deacti wind find
endcase
do wixod 
retu
proc wixod
define window w1 from  7 ,  25  to  12 ,  55  ;
double color scheme  9 
acti wind w1
k= 0 
@  1 , 2  say'     Продолжить поиск? '
@  3 , 2   prompt'  Нет   '
@  3 , 20  prompt'  Да    '
menu to k
do case
case k= 1 
hide wind w1
deacti wind w1
do poisk
case k= 2 
deacti wind w1
deacti wind find
close data
endcase
retu
Но теперь почему-то выдаётся ошибка в строке
Код: plaintext
locate for <fam>==cString
(и других подобных ей) "Потеря выражения". Почему? Не могу понять.

P.S. Как ты заметишь, я маленько изменил твою функцию поиска
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
 r=recno()
go top
locate for <fieldname>==cString 
if found()
 r=recno()
 show window F10 refresh
else
  wait window nowait "Error: Desired item is not found!!!"
  go r
endif
, т.к. я решил, что в строке:
Код: plaintext
locate for <fieldname>==cString
запись fieldname означает имя области в БД (fam, pol, pas и т.д.). Также изменил строку
Код: plaintext
show window F10 refresh
, т.к. в этой программе у меня окно browse-окно не F10, а SFEDIT. Скажи, пожалуйста, правильно ли я сделал. И ещё. Правильно ли я написал предупреждение о том, если пользователь неправильно заполнит поисковый запрос на пол гостя:
Код: plaintext
1.
2.
3.
if U<>'М'.or.U<>'Ж'
   wait window nowait "Ошибка!!! Введите "М" или "Ж"!"
   go r
endif
Если не правильно, скажи, пожалуйста как будет правильно.
...
Рейтинг: 0 / 0
18.07.2006, 17:21
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33862174
Черный плащ (бывш. Ужас, летящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Черный плащ (бывш. Ужас, летящий
Гость
parenyokЕсли не правильно, скажи, пожалуйста как будет правильно.
У меня просто нет слов

1.Объясняю для тех, кто "в танке":
<fieldname> - это имя поля (которое должно писаться БЕЗ УГЛОВЫХ СКОБОК!!! )
cString - выражение для поиска. (Конкретно в твоем случае это будет переменная U )

таким образом, выражение для поиска должно быть преобразовано к виду:
Код: plaintext
locate for mes==u

2. Зачем ты открываешь файл каждый раз при поиске. Хватит того, что он уже у тебя открыт. Вместо use guests в процедуре поиска надо сделать select guests

3. Если я правильно понял, то
Код: plaintext
1.
2.
3.
4.
if U<>'М'.or.U<>'Ж'
   wait window nowait "Ошибка!!! Введите "М" или "Ж"!"
   go r
endif
должно быть:
Код: plaintext
1.
2.
3.
4.
if not U$'МЖ'
   wait window nowait "Ошибка!!! Введите "М" или "Ж"!"
   go r
endif
...
Рейтинг: 0 / 0
18.07.2006, 19:42
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33862752
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Спасибо тебе большое!!! Спасибо!!! Осталось только маленько доработать и всё будет зашибись! Но мои "причуды" тоже можно понять. Так. Теперь я хотел бы сделать так, чтобы результаты поиска выводились в отдельном окне. Ну, окно-то я сделаю! А результаты поиска как? Прости, пожалуйста, за глупый вопрос, а в процедуре поиска, строка:
Код: plaintext
 show window SFEDIT refresh
и означает показать окно SPEDIT после поиска? А если я, например, напишу:
Код: plaintext
1.
2.
defi wind result from  5 , 00  to  20 , 80 ;
title 'Результаты поиска' foot 'Esc-Выход'
acti wind result
А в процедуре поиска:
Код: plaintext
 show window result refresh
, то получится то, что я хочу? Сейчас попробую...
...
Рейтинг: 0 / 0
19.07.2006, 09:05
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33862790
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
М-да... Сделал как я думал - не получается. Выводится пустое окно "Результаты поиска".
...
Рейтинг: 0 / 0
19.07.2006, 09:23
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33867663
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Ура! Удалось-таки разобраться как работает процедура поиска. Но есть маленькая неточность. Если задать параметр поиска, например, в "Место в гостиннице", то результат поиска покажется только после того, как отменить выполнение программы. Объясню практически. После запуска этой программы:
Код: plaintext
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.
********************************************************************************
****************** Работа с БД гостей ***************
close data
*SET DEFAULT TO C:\kr
set talk on
sele a
use guests.dbf
push key clea
defi wind gosti from  1 , 00  to  18 , 95 ; 
titl '<<< Список гостей >>>' foot 'F3-поиск F5-добавить F8-удалить  F7-редактировать Esc-выход 'color w,r/br,gr+/rb+,gr+/br 
acti wind gosti
on key labe f3 do poisk
on key labe f7 do red_v
on key labe f5 do dob
*on key labe F10 do keyboard '{Ctrl+END}' do_vih 
on key labe F8 do del
on key labe HOME go top
on key labe END go bott
pack 
browse;
      fiel mes:h='Место': 5 ,;
           fam:h='ФИО': 15 ,;
           pol:h='Пол': 3 ,;
           pas:h='ь паспорта': 10 ,;
           pri:h='Дата прибытия': 13 ,;
           otb:h='Дата отбытия': 12 ,;
           opl:h='Оплачено до': 11 ,;
           num:h='ь гостя': 7 ;
           noed noap in wind gosti

rele wind gosti
set deleted on
on key labe f3
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 HELP.PRG
retu
********************************************************************************
****************** Процедура ввода записей БД гостей ***************
proc dob
push key clear
defi wind dobav from  4 , 8  to  17 , 70 ; 
titl '<<< Характеристики нового гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B 
acti wind dobav
dime s( 8 )
store space( 5 ) to s( 1 )
store space( 20 ) to s( 2 )
store space( 1 ) to s( 3 )
store space( 10 ) to s( 4 )
store space( 10 ) to s( 5 )
store space( 10 ) to s( 6 )
store space( 10 ) to s( 7 )
store space( 2 ) to s( 8 )
if eof()
s( 1 )= 1 
else
go BOTTOM
endif
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

*i= 0 
a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
*@  2 , 7  get i function '*h\! ОК;Отмена' size  3 , 13 , 3 
read cycle 
if a= 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  4 , 8  to  17 , 50 ; 
titl '<<< Редактирование гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B
acti wind red
dime s( 8 )
s( 1 )=mes
s( 2 )=fam
s( 3 )=pol
s( 4 )=pas
s( 5 )=pri
s( 6 )=otb
s( 7 )=opl
s( 8 )=num
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
read cycle 
if a= 1 
gather from s
ENDIF
rele wind red
pop key
endif
return
********************************************************************************
****************** Процедура удаления записей БД  ***************
proc del
if !eof()
push key clear
define window vnc from  10 , 23  to  15 , 50   title '"ВHИМАHИЕ"';
shad doub color r+/b,n/n,rb/bg+ 
ACTI WIND vnc
store  0  to i
A= 0 
B= 0 
@  0 , 05  SAY ' УДАЛИТЬ ЗАПИСЬ' 
@  2 , 03  GET A FUNC '*   OK' 
@  2 , 13  GET B FUNC '*  Отмена' 
*@  2 , 7  get i function '*h\! ОК;Отмена' size  3 , 13 , 3 
READ
IF a= 1 
delete
endif
rele wind vnc
pop key
endif
return
******************************************************************
          **** Процедура поиска ****
procedure poisk
define window find from  1 , 1  to  23 , 60 ;
title 'Поиск гостей' foot 'Esc - Выход' 
acti wind find
store SPACE( 20 ) to U
@  1 , 9  say'Искать по:'
* get U  picture  ('xxxxxxxxxxxxxxx')
*@  4 , 12  say'      Где искать?'
*read

k= 0 
@  3 , 5   prompt 'Месту в гостинице'
@  5 , 5   prompt 'Фамилии'
@  7 , 5  prompt 'Дате прибытия'
@  11 , 5  prompt 'Дате отбытия'
@  13 , 5  prompt 'Дате оплаты'
menu to k

do case
case k= 1 
select guests

defi wind mes from  5 , 20  to  15 , 70 ;
title 'Поиск по месту в гостинице' foot 'Esc - Выход'
acti wind mes
store SPACE( 5 ) to U
@  1 , 1  say'Введите место гостя:' get U  picture  ('xxxxx')
read

r=recno()
go top
locate for mes==U 
if found()
 r=recno()
 show window gosti refresh
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 2 
select guests
defi wind fam from  5 , 10  to  15 , 90 ;
title 'Поиск по фамилии' foot 'Esc - Выход'
acti wind fam
store SPACE( 20 ) to U
@  1 , 1  say'Введите фамилию или ФИО гостя целеком:';
get U  picture  ('xxxxxxxxxxxxxxxxxxxx')
read

r=recno()
go top
locate for fam==U 
if found()
 r=recno()
 show window gosti refresh
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif


case k= 5 
select guests
defi wind pri from  5 , 10  to  15 , 90 ;
title 'Поиск по дате прибытия' foot 'Esc - Выход'
acti wind pri
store SPACE( 10 ) to U
@  1 , 1  say'Введите дату прибытия гостя:';
get U  picture  ('99.99.9999')
read

r=recno()
go top
locate for pri==U 
if found()
 r=recno()
 show window gosti refresh
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 6 
select guests
defi wind otb from  5 , 10  to  15 , 90 ;
title 'Поиск по дате отбытия' foot 'Esc - Выход'
acti wind otb
store SPACE( 10 ) to U
@  1 , 1  say'Введите дату отбытия гостя:';
get U  picture  ('99.99.9999')
read

r=recno()
go top
locate for otb==U 
if found()
 r=recno()
 show window gosti refresh
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 7 
select guests
defi wind opl from  5 , 10  to  15 , 90 ;
title 'Поиск по фамилии' foot 'Esc - Выход'
acti wind opl
store SPACE( 10 ) to U
@  1 , 1  say'Введите дату оплаты гостя:';
get U  picture  ('99.99.9999')
read

r=recno()
go top
locate for opl==U 
if found()
 r=recno()
 show window gosti refresh
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif
       
case k= 8 
deacti wind find
endcase
do wixod 
retu

proc wixod
define window w1 from  7 ,  25  to  12 ,  55 
*double color scheme  9 
acti wind w1
k= 0 
@  1 , 2  say'     Продолжить поиск? '
@  3 , 2   prompt'  Да   '
@  3 , 20  prompt'  Нет  '
menu to k
do case
case k= 1 
hide wind w1
deacti wind w1
do poisk
case k= 2 
deacti wind w1
deacti wind find
close data
endcase
retu
, я вызываю окно поиска. Там выбираю "По месту в гостинице", ввожу 11031, нажимаю Enter. Далее появляется окно списка гостей, но строка с введённым местом не выделена. Снова жму Enter, появляется окно с вопросом "Продолжить поиск". И если нажать Esc, то выделится строка с введённым местом. Скажите, пожалуйста, как сделать так, чтобы после введения поиска у меня появлялось окно "Список гостей" с выделенной строкой. На всякий случай, присоединю архив.

P.S. Кстати, можете меня поздравить! Это моё 100-е сообщение в этом форуме!
...
Рейтинг: 0 / 0
20.07.2006, 16:24
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33872009
Черный плащ (бывш. Ужас, летящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Черный плащ (бывш. Ужас, летящий
Гость
parenyok... я вызываю окно поиска. Там выбираю "По месту в гостинице", ввожу 11031, нажимаю Enter. Далее появляется окно списка гостей, но строка с введённым местом не выделена. Снова жму Enter, появляется окно с вопросом "Продолжить поиск". И если нажать Esc, то выделится строка с введённым местом. Скажите, пожалуйста, как сделать так, чтобы после введения поиска у меня появлялось окно "Список гостей" с выделенной строкой.
Точно также, как при отображении поэтажного плана: ввести "вычисляемое поле" (т.е. выражение t=iif(r=recno(),'>',' ') ) в browse окно. Тогда у тебя всегда текущая запись будет "выделена" знаком ">"

parenyok
P.S. Кстати, можете меня поздравить! Это моё 100-е сообщение в этом форуме!
Сомнительный повод для поздравлений... Вот если бы ты в этих сообщениях давал кому-нибудь ценные советы, тогда да...
...
Рейтинг: 0 / 0
22.07.2006, 20:57
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33872209
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Черный плащ (бывш. Ужас, летящийТочно также, как при отображении поэтажного плана: ввести "вычисляемое поле" (т.е. выражение t=iif(r=recno(),'>',' ') ) в browse окно. Тогда у тебя всегда текущая запись будет "выделена" знаком ">"Спасибо, большое! Но почему-то не помогло... Посмотри, пожалуйста, может что не так:
Код: plaintext
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.
********************************************************************************
****************** Работа с БД гостей ***************
close data
*SET DEFAULT TO C:\kr
set talk on
sele a
use guests.dbf
push key clea
defi wind gosti from  1 , 00  to  18 , 95 ; 
titl '<<< Список гостей >>>' foot 'F3-поиск F5-добавить F8-удалить  F7-редактировать Esc-выход 'color w,r/br,gr+/rb+,gr+/br 
acti wind gosti
on key labe f3 do poisk
on key labe f7 do red_v
on key labe f5 do dob
*on key labe F10 do keyboard '{Ctrl+END}' do_vih 
on key labe F8 do del
on key labe HOME go top
on key labe END go bott
pack 
r=recno()
browse;
    fiel   t=iif(r=recno(),'>',' '):h=' ',;
           mes:h='Место': 5 ,;
           fam:h='ФИО': 15 ,;
           pol:h='Пол': 3 ,;
           pas:h='ь паспорта': 10 ,;
           pri:h='Дата прибытия': 13 ,;
           otb:h='Дата отбытия': 12 ,;
           opl:h='Оплачено до': 11 ,;
           num:h='ь гостя': 7 ;
           noed noap in wind gosti

rele wind gosti
set deleted on
on key labe f3
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 HELP.PRG
retu
********************************************************************************
****************** Процедура ввода записей БД гостей ***************
proc dob
push key clear
defi wind dobav from  4 , 8  to  17 , 70 ; 
titl '<<< Характеристики нового гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B 
acti wind dobav
dime s( 8 )
store space( 5 ) to s( 1 )
store space( 20 ) to s( 2 )
store space( 1 ) to s( 3 )
store space( 10 ) to s( 4 )
store space( 10 ) to s( 5 )
store space( 10 ) to s( 6 )
store space( 10 ) to s( 7 )
store space( 2 ) to s( 8 )
if eof()
s( 1 )= 1 
else
go BOTTOM
endif
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

*i= 0 
a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
*@  2 , 7  get i function '*h\! ОК;Отмена' size  3 , 13 , 3 
read cycle 
if a= 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  4 , 8  to  17 , 50 ; 
titl '<<< Редактирование гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B
acti wind red
dime s( 8 )
s( 1 )=mes
s( 2 )=fam
s( 3 )=pol
s( 4 )=pas
s( 5 )=pri
s( 6 )=otb
s( 7 )=opl
s( 8 )=num
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
read cycle 
if a= 1 
gather from s
ENDIF
rele wind red
pop key
endif
return
********************************************************************************
****************** Процедура удаления записей БД  ***************
proc del
if !eof()
push key clear
define window vnc from  10 , 23  to  15 , 50   title '"ВHИМАHИЕ"';
shad doub color r+/b,n/n,rb/bg+ 
ACTI WIND vnc
store  0  to i
A= 0 
B= 0 
@  0 , 05  SAY ' УДАЛИТЬ ЗАПИСЬ' 
@  2 , 03  GET A FUNC '*   OK' 
@  2 , 13  GET B FUNC '*  Отмена' 
*@  2 , 7  get i function '*h\! ОК;Отмена' size  3 , 13 , 3 
READ
IF a= 1 
delete
endif
rele wind vnc
pop key
endif
return
******************************************************************
          **** Процедура поиска ****
procedure poisk
define window find from  1 , 1  to  23 , 60 ;
title 'Поиск гостей' foot 'Esc - Выход' 
acti wind find
store SPACE( 20 ) to U
@  1 , 9  say'Искать по:'
* get U  picture  ('xxxxxxxxxxxxxxx')
*@  4 , 12  say'      Где искать?'
*read

k= 0 
@  3 , 5   prompt 'Месту в гостинице'
@  5 , 5   prompt 'Фамилии'
@  7 , 5   prompt 'Дате прибытия'
@  11 , 5  prompt 'Дате отбытия'
@  13 , 5  prompt 'Дате оплаты'
@  15 , 5  prompt 'Отмена'
menu to k

do case
case k= 1 
select guests

defi wind mes from  5 , 20  to  15 , 70 ;
title 'Поиск по месту в гостинице' foot 'Esc - Выход'
acti wind mes
store SPACE( 5 ) to U
@  1 , 1  say'Введите место гостя:' get U  picture  ('99999')
read

r=recno()
go top
locate for mes==U 
if found()
 r=recno()
 show window gosti refresh
rele wind find
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 2 
select guests
defi wind fam from  5 , 10  to  15 , 90 ;
title 'Поиск по фамилии' foot 'Esc - Выход'
acti wind fam
store SPACE( 20 ) to U
@  1 , 1  say'Введите фамилию или ФИО гостя целеком:';
get U  picture  ('xxxxxxxxxxxxxxxxxxxx')
read

r=recno()
go top
locate for fam==U 
if found()
 r=recno()
 show window gosti refresh
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif


case k= 3 
select guests
defi wind pri from  5 , 10  to  15 , 90 ;
title 'Поиск по дате прибытия' foot 'Esc - Выход'
acti wind pri
store SPACE( 10 ) to U
@  1 , 1  say'Введите дату прибытия гостя:';
get U  picture  ('99.99.9999')
read

r=recno()
go top
locate for pri==U 
if found()
 r=recno()
 show window gosti refresh
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 4 
select guests
defi wind otb from  5 , 10  to  15 , 90 ;
title 'Поиск по дате отбытия' foot 'Esc - Выход'
acti wind otb
store SPACE( 10 ) to U
@  1 , 1  say'Введите дату отбытия гостя:';
get U  picture  ('99.99.9999')
read

r=recno()
go top
locate for otb==U 
if found()
 r=recno()
 show window gosti refresh
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 5 
select guests
defi wind opl from  5 , 10  to  15 , 90 ;
title 'Поиск по фамилии' foot 'Esc - Выход'
acti wind opl
store SPACE( 10 ) to U
@  1 , 1  say'Введите дату оплаты гостя:';
get U  picture  ('99.99.9999')
read

r=recno()
go top
locate for opl==U 
if found()
 r=recno()
 show window gosti refresh
read
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif
       
case k= 6 
deacti wind find
endcase
do wixod 
retu

proc wixod
define window w1 from  7 ,  25  to  12 ,  55 
*double color scheme  9 
acti wind w1
k= 0 
@  1 , 2  say'     Продолжить поиск? '
@  3 , 2   prompt'  Да   '
@  3 , 20  prompt'  Нет  '
menu to k
do case
case k= 1 
hide wind w1
deacti wind w1
do poisk
case k= 2 
deacti wind w1
deacti wind find
close data
endcase
retu

parenyok
P.S. Кстати, можете меня поздравить! Это моё 100-е сообщение в этом форуме!
Сомнительный повод для поздравлений... Вот если бы ты в этих сообщениях давал кому-нибудь ценные советы, тогда да...[/quot]Просто... захотелось... маленько уважения... внимания...
...
Рейтинг: 0 / 0
23.07.2006, 07:25
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33872578
Черный плащ (бывш. Ужас, летящий
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Черный плащ (бывш. Ужас, летящий
Гость
parenyok Черный плащ (бывш. Ужас, летящийТочно также, как при отображении поэтажного плана: ввести "вычисляемое поле" (т.е. выражение t=iif(r=recno(),'>',' ') ) в browse окно. Тогда у тебя всегда текущая запись будет "выделена" знаком ">"Спасибо, большое! Но почему-то не помогло... Посмотри, пожалуйста, может что не так:
Примерно так (выделены только интересующие тебя фрагменты:
Код: plaintext
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.
...
r=recno()
browse;
    field  t=iif(r=recno(),'>',' '):h=' ',;
           mes:h='Место': 5 ,;
           fam:h='ФИО': 15 ,;
           pol:h='Пол': 3 ,;
           pas:h='ь паспорта': 10 ,;
           pri:h='Дата прибытия': 13 ,;
           otb:h='Дата отбытия': 12 ,;
           opl:h='Оплачено до': 11 ,;
           num:h='ь гостя': 7 ;
           noed noap nodel in wind gosti when ttt() 

rele wind gosti
...
**** Процедура поиска ****
procedure poisk
define window find from  1 , 1  to  13 , 30 ;
title ' Поиск гостей ' foot 'Esc - Выход' 

defi wind mes from  5 , 20  to  10 , 70  ;
title " Пaрaмeтpы поискa " ;
foot 'Esc - Выход'

acti wind find
@  1 , 9  say'Искать по:'
@  3 , 5  get k function"*RVT ;
Месту в гостинице;Фамилии;Дате прибытия;Дате отбытия;Дате оплаты;Отмена";
DEFAULT  1 
read
deactivate window find
acti wind mes
do case
case k= 1 
select guests
store SPACE( 5 ) to U
@  1 , 1  say'Введите место гостя:' get U  picture  ('99999')
read
deactivate wind mes
r=recno()
go top
locate for mes==U 
if found()
 r=recno()
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 2 
select guests
store SPACE( 20 ) to U
@  1 , 1  say 'Введите фамилию'
@  2 , 1  say 'или ФИО гостя целиком:';
get U  picture  ('xxxxxxxxxxxxxxxxxxxx')
read
deactivate wind mes
r=recno()
go top
locate for fam==U 
if found()
 r=recno()
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 3 
select guests
store Ctod("") to U
@  1 , 1  say'Введите дату прибытия гостя:';
get U  picture  ('99.99.9999')
read
deactivate wind mes
r=recno()
go top
locate for pri==U 
if found()
 r=recno()
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 4 
select guests
store ctod("") to U
@  1 , 1  say'Введите дату отбытия гостя:';
get U  picture  ('99.99.9999')
read
deactivate wind mes
r=recno()
go top
locate for otb==U 
if found()
 r=recno()
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif

case k= 5 
select guests
store ctod("") to U
@  1 , 1  say'Введите дату оплаты гостя:';
get U  picture  ('99.99.9999')
read
deactivate wind mes
r=recno()
go top
locate for opl==U 
if found()
 r=recno()
else
  wait window nowait "Поиск не дал результатов!!!"
  go r
endif
       
case k= 6 
deacti wind find,mes
endcase
release windows find,mes
retu

FUNCTION ttt &&-----------ФУНКЦИЯ обновления курсора 
r=RECNO() 
SHOW WINDOW gosti REFRESH 
RETURN
...
Рейтинг: 0 / 0
23.07.2006, 22:15
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33872695
Черный плащ (бывш. Ужас...)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Черный плащ (бывш. Ужас...)
Гость
parenyokСпасибо, большое! Но почему-то не помогло... Посмотри, пожалуйста, может что не так:

Я тебе скажу. :)
Во всякой более или менее сложной программе существует (явно или неявно) бесконечный цикл, ожидающий ввода пользователя.
В программе про поэтажный план гостиницы роль этого цикла играла команда READ CYCLE . В твоей текущей программе эту роль играет BROWSE-окно .
Поэтому, все твои функции должны возвращать управление именно ему (а оно уже само будет рефрешиться).
Если тебе нужен поиск с продолжением, то используется следующая технология:
1. вводится глобальная переменная-флаг, которая будет отслеживать выбрал ли пользователь продолжение поиска
2. в командах locate используется ключевое слово REST (остаток).

Т.е. должно быть примерно так (требуется отладка):
Код: plaintext
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.
public Continue_search && глобальная переменная для продолжения поиска
Continue_search=.f. && поиск пока не продолжаем
Public last_search  && глобальная переменная для сохранения последнего поиска
last_search= 0       && пока поиска не було / новый поиск
......
on key label F3 do wixod
.....
r=recno()
browse;
    field  t=iif(r=recno(),'>',' '):h=' ',;
           mes:h='Место': 5 ,;
           fam:h='ФИО': 15 ,;
           pol:h='Пол': 3 ,;
           pas:h='ь паспорта': 10 ,;
           pri:h='Дата прибытия': 13 ,;
           otb:h='Дата отбытия': 12 ,;
           opl:h='Оплачено до': 11 ,;
           num:h='ь гостя': 7 ;
           noed noap nodel in wind gosti when ttt() 

rele wind gosti
...
**** Процедура поиска ****
procedure poisk
define window find from  1 , 1  to  13 , 30 ;
title ' Поиск гостей ' foot 'Esc - Выход' 

defi wind mes from  5 , 20  to  10 , 70  ;
title " Пaрaмeтpы поискa " ;
foot 'Esc - Выход'
if Last_search= 0 
  acti wind find
  @  1 , 9  say'Искать по:'
  @  3 , 5  get k function"*RVT ;
  Месту в гостинице;Фамилии;Дате прибытия;Дате отбытия;Дате оплаты;Отмена";
  DEFAULT  1 
  read
  Last_search=k
  select guests
  r=recno()
  go top
  deactivate window find
else
  k=last_search
  select guests
endif

acti wind mes
do case
   case k= 1 
       store SPACE( 5 ) to U
       @  1 , 1  say'Введите место гостя:' get U  picture  ('99999')
       read
       deactivate wind mes
       locate rest for mes==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 2 
       store SPACE( 20 ) to U
       @  1 , 1  say 'Введите фамилию'
       @  2 , 1  say 'или ФИО гостя целиком:';
             get U  picture  ('xxxxxxxxxxxxxxxxxxxx')
       read
       deactivate wind mes
       locate rest for fam==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 3 
       store Ctod("") to U
       @  1 , 1  say'Введите дату прибытия гостя:';
             get U  picture  ('99.99.9999')
       read
       deactivate wind mes
       locate rest for pri==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 4 
       store ctod("") to U
       @  1 , 1  say'Введите дату отбытия гостя:';
             get U  picture  ('99.99.9999')
       read
       deactivate wind mes
       locate rest for otb==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 5 
       store ctod("") to U
       @  1 , 1  say'Введите дату оплаты гостя:';
             get U  picture  ('99.99.9999')
       read
       deactivate wind mes
       locate rest for opl==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 6 
       deacti wind find,mes
       Last_search= 0 
endcase
release windows find,mes
retu

procedure Wixod
define window vopros from  1 , 1  to  10 , 30 
activate window vopros
@  2 , 1  say "Продолжить поиск?"
@  3 , 1  get v function "*RHT Продолжить; Новый поиск; Завершить" default  1 
read
deactivate window vopros
do case
   case v= 1  
     if !Continue_search
       Continue_search=.t.
       Last_search= 0 
     endif
       do poisk
   case v= 2     
      Continue_search=.t.
      Last_search= 0 
      do poisk
   case v= 3 
      Continue_search=.t.
      Last_search= 0 
endcase
release window vopros
return

FUNCTION ttt &&-----------ФУНКЦИЯ обновления курсора 
r=RECNO() 
SHOW WINDOW gosti REFRESH 
RETURN

parenyok
Просто... захотелось... маленько уважения... внимания...

По этому поводу есть пословица:
"Взялся за гуж - не говори, что не дюж"
(т.е. если начал программировать, то никто тебя в этой области жалеть не будет - будут спрашивать по "полной программе")
...
Рейтинг: 0 / 0
24.07.2006, 07:24
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33873842
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Большое человеческое тебе СПАСИБО!!! Теперь работает всё как я и хотел. Я там, правда, кое-что потправил. Если интересно - посмотри:
Код: plaintext
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.
********************************************************************************
****************** Работа с БД гостей ***************
close data
*SET DEFAULT TO C:\kr
set talk on
sele a
use guests.dbf
push key clea
defi wind gosti from  1 , 00  to  18 , 95 ; 
titl '<<< Список гостей >>>' foot 'F3-поиск F5-добавить F8-удалить  F7-редактировать Esc-выход 'color w,r/br,gr+/rb+,gr+/br 
acti wind gosti

public Continue_search && глобальная переменная для продолжения поиска
Continue_search=.f. && поиск пока не продолжаем
Public last_search  && глобальная переменная для сохранения последнего поиска
last_search= 0       && пока поиска не було / новый поиск

on key labe f3 do poisk
on key labe f7 do red_v
on key labe f5 do dob
*on key labe F10 do keyboard '{Ctrl+END}' do_vih 
on key labe F8 do del
on key labe HOME go top
on key labe END go bott
pack 
r=recno()
browse;
    field  t=iif(r=recno(),'>',' '):h=' ',;
           mes:h='Место': 5 ,;
           fam:h='ФИО': 15 ,;
           pol:h='Пол': 3 ,;
           pas:h='ь паспорта': 10 ,;
           pri:h='Дата приб.': 10 ,;
           otb:h='Дата отб.': 10 ,;
           opl:h='Оплач. до': 10 ,;
           num:h='ь гостя': 7 ;
           noed noap nodel in wind gosti when ttt() 

rele wind gosti
set deleted on
on key labe f3
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 HELP.PRG
retu
********************************************************************************
****************** Процедура ввода записей БД гостей ***************
proc dob
push key clear
defi wind dobav from  4 , 8  to  17 , 70 ; 
titl '<<< Характеристики нового гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B 
acti wind dobav
dime s( 8 )
store space( 5 ) to s( 1 )
store space( 20 ) to s( 2 )
store space( 1 ) to s( 3 )
store space( 10 ) to s( 4 )
store space( 10 ) to s( 5 )
store space( 10 ) to s( 6 )
store space( 10 ) to s( 7 )
store space( 2 ) to s( 8 )
if eof()
s( 1 )= 1 
else
go BOTTOM
endif
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
read cycle 
if a= 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  4 , 8  to  17 , 50 ; 
titl '<<< Редактирование гостя >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B
acti wind red
dime s( 8 )
s( 1 )=mes
s( 2 )=fam
s( 3 )=pol
s( 4 )=pas
s( 5 )=pri
s( 6 )=otb
s( 7 )=opl
s( 8 )=num
@  1 , 0  say'Место'
@  2 , 0  say'ФИО'
@  3 , 0  say'Пол'
@  4 , 0  say'Номер паспорта'
@  5 , 0  say'Дата приезда'
@  6 , 0  say'Дата отъезда'
@  7 , 0  say'Оплачено до'
@  8 , 0  say'Номер'

@  1 , 20  get s( 1 ) pict'99999'
@  2 , 20  get s( 2 ) pict'xxxxxxxxxxxxxxxxxxxx' 
@  3 , 20  get s( 3 ) pict'x'
@  4 , 20  get s( 4 ) pict'9999999999'
@  5 , 20  get s( 5 ) pict'99.99.9999' 
@  6 , 20  get s( 6 ) pict'99.99.9999'
@  7 , 20  get s( 7 ) pict'99.99.9999'
@  8 , 20  get s( 8 ) pict'99'

a= 0 
b= 0 
@  10 , 10  GET A FUNC '*   OK' 
@  10 , 20  GET B FUNC '*  Отмена' 
read cycle 
if a= 1 
gather from s
ENDIF
rele wind red
pop key
endif
return
********************************************************************************
****************** Процедура удаления записей БД  ***************
proc del
if !eof()
push key clear
define window vnc from  10 , 23  to  15 , 50   title '"ВHИМАHИЕ"';
shad doub color r+/b,n/n,rb/bg+ 
ACTI WIND vnc
*store  0  to i
A= 0 
B= 0 
@  0 , 05  SAY ' УДАЛИТЬ ЗАПИСЬ' 
@  2 , 03  GET A FUNC '*   OK' 
@  2 , 13  GET B FUNC '*  Отмена' 
*@  2 , 7  get i function '*h\! ОК;Отмена' size  3 , 13 , 3 
READ
IF a= 1 
delete
endif
rele wind vnc
pop key
endif
return
******************************************************************
          **** Процедура поиска ****
procedure poisk
define window find from  1 , 1  to  13 , 30 ;
title ' Поиск гостей ' foot 'Esc - Выход' 

defi wind mes from  5 , 20  to  10 , 70  ;
title " Пaрaмeтpы поискa " ;
foot 'Esc - Выход'
if Last_search= 0 
  acti wind find
  @  1 , 9  say'Искать по:'
  @  3 , 5  get k function"*RVT ;
  Месту в гостинице;Фамилии;Дате прибытия;Дате отбытия;Дате оплаты;Отмена";
  DEFAULT  1 
  read
  Last_search=k
  select guests
  r=recno()
  go top
  deactivate window find
else
  k=last_search
  select guests
endif

acti wind mes
do case
   case k= 1 
       store SPACE( 5 ) to U
       @  1 , 1  say'Введите место гостя:' get U  picture  ('99999')
       read
       deactivate wind mes
       locate rest for mes==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 2 
       store SPACE( 20 ) to U
       @  1 , 1  say 'Введите фамилию'
       @  2 , 1  say 'или ФИО гостя целиком:';
             get U  picture  ('xxxxxxxxxxxxxxxxxxxx')
       read
       deactivate wind mes
       locate rest for fam==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 3 
       store Ctod("") to U
       @  1 , 1  say'Введите дату прибытия гостя:';
             get U  picture  ('99.99.9999')
       read
       deactivate wind mes
       locate rest for pri==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 4 
       store ctod("") to U
       @  1 , 1  say'Введите дату отбытия гостя:';
             get U  picture  ('99.99.9999')
       read
       deactivate wind mes
       locate rest for otb==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 5 
       store ctod("") to U
       @  1 , 1  say'Введите дату оплаты гостя:';
             get U  picture  ('99.99.9999')
       read
       deactivate wind mes
       locate rest for opl==U 
       if found()
         r=recno()
       else
         wait window nowait "Поиск не дал результатов!!!"
         go r
       endif
   case k= 6 
       deacti wind find,mes
       Last_search= 0 
endcase
release windows find,mes
r=recno()
*read
*do wixod 
on key labe ENTER do wixod
retu

procedure wixod
define window vopros from  5 , 20  to  10 , 70 
activate window vopros
@  1 , 17  say "Продолжить поиск?"
@  3 , 1  get v function "*RHT Продолжить; Новый поиск; Завершить" default  1 
read
deactivate window vopros
do case
   case v= 1  
     if !Continue_search
       Continue_search=.t.
       Last_search= 0 
     endif
       do poisk
   case v= 2     
      Continue_search=.t.
      Last_search= 0 
      do poisk
   case v= 3 
      Continue_search=.t.
      Last_search= 0 
endcase
release window vopros
return

FUNCTION ttt &&-----------ФУНКЦИЯ обновления курсора 
r=RECNO() 
SHOW WINDOW gosti REFRESH 
RETURN
Правда, остался маленький недочёт. Когда перемещаешь в browse-окне по гостям, то знак ">" остаётся на строке, а не исчезает как в программе про этажи, с которой я начал эту тему. Подскажи, пожалуйста, как можно это предотвратить. Конечно, это вовсе необязательно, но всё-таки. И ещё. По заданию мне надо сделать выбор всех постояльцев отъезжающих сегодня. Скажи, пожалуйста, как это сделать.

P.S. Вот думал-думал, зачем ты при вызове процедуры поиска вызываешь процедуру выхода. Ведь при вызове первого должно открываться окно выбора признака гостя, а не вопрос "Продолжить поиск", когда ты его ещё не начинал.
...
Рейтинг: 0 / 0
24.07.2006, 13:54
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33874079
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Хм... Чё-то глюк какой-то. В тексте программы нажимаю Enter, чтобы перейти на новую строку, а мне ошибка "Файл WIXOD.PRG не найден.". У меня же программа не запущена и строка
Код: plaintext
on key labe ENTER do wixod
на данный момент же никакой роли не играет. В чём дело? Видно придётся поменять клавишу вызова процедуры wixod.
...
Рейтинг: 0 / 0
24.07.2006, 14:52
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33874331
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Слушай. А как сделать, чтобы выводилось часть числа? Например, есть в поле mes число 11011 и мне надо, чтобы выводилась только первая, только последняя и середина этого числа. Просто я пишу процедуру квитанции гостя и хочу, чтобы выводилось следующее: "Гость ... проживает в 101-м номере, который находится на 1-ом этаже. Место в номере: 1..." и т.д.
...
Рейтинг: 0 / 0
24.07.2006, 16:02
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33874704
Urri
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Urri
Участник
parenyokХм... Чё-то глюк какой-то. В тексте программы нажимаю Enter, чтобы перейти на новую строку, а мне ошибка "Файл WIXOD.PRG не найден.". У меня же программа не запущена и строка
Код: plaintext
on key labe ENTER do wixod
на данный момент же никакой роли не играет. В чём дело? Видно придётся поменять клавишу вызова процедуры wixod.О! У паренька начали возникать проблески понимания! Скоро он начнет задавать нормальные вопросы ;-)
Настройки on key не снимаются сами по себе после завершения программы с выходом в среду FoxPro. Надо до начала назначений сделать что-нибудь типа push key [clear], а перед возвратом в среду что-нибудт типа - pop key [all], чтобы все свои установки, сделанные в программе очистить.
Впрочем, за собой можно и не чистить - но тогда не делать и выход в среду, а делать сразу quit.
...
Рейтинг: 0 / 0
24.07.2006, 17:32
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33876967
Александр Овчинников
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Александр Овчинников
Гость
parenyokСлушай. А как сделать, чтобы выводилось часть числа? Например, есть в поле mes число 11011 и мне надо, чтобы выводилась только первая, только последняя и середина этого числа. Просто я пишу процедуру квитанции гостя и хочу, чтобы выводилось следующее: "Гость ... проживает в 101-м номере, который находится на 1-ом этаже. Место в номере: 1..." и т.д.
для первой left(поле,1,1)

для последней right(поле,1,1)

для середины использовать
d=len(alltr(поле))
substr(поле,2,d-1)
...
Рейтинг: 0 / 0
25.07.2006, 14:50
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33884329
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
Спасибо Александру за ответ! Теперь у меня вот какие проблемы с написанием процедуры квитанции. Ну, сначала приведу саму процедуру:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
procedure kvit
defi wind kvit from  4 , 8  to  17 , 60 ; 
titl '<<< Квитанция оплаты >>>'foot 'Выход - Esc' color , , W+/B,W+/B,W+/B
acti wind kvit
dime s( 4 )
s( 1 )=fam
s( 2 )=mes
s( 3 )=pri
s( 4 )=otb
@  1 , 16  say'проживает в'
@  1 , 36  say'номере.'
@  2 , 0  say'Дата оплаты номера:'
@  3 , 0  say'с'
@  3 , 13  say'до'

@  1 , 0  get s( 1 )  pict 'xxxxxxxxxxxxxxx' 
@  1 , 28  get s( 2 ) pict '99999'
@  3 , 02  get s( 3 ) pict '99.99.9999'
@  3 , 16  get s( 4 ) pict '99.99.9999'
return
Проблема в следующем. Если оставить всё как есть, то фон у фамилии гостя и у всего остального будет сереневый и почему-то на 4-ой строчке написана дата отбытия и на 3-ей дата прибытия (вначале этих строк!). Если убрать в 4-ёх последних строчках слово pict, то останутся фамилия и даты прибытия и отбытия. Правда последие два не там где надо. Скажите, пожалуйста, как сделать у всех слов одинаковый фон и убрать лишнее? Если проблема моя не совсем понята, то вот архив. Проблема в программе GUESTS.PRG. Вышеописанная процедура вызывается клавишей F2. Прошу, помогите!
...
Рейтинг: 0 / 0
28.07.2006, 10:28
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33885602
Urri
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Urri
Участник
HELP @
HELP set color commands
...
Рейтинг: 0 / 0
28.07.2006, 15:24
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33888275
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
UrriHELP @
HELP set color commandsТак... Как я понимаю set color commands это установка цвета в команде, т.е. в выделенных фоном словах, а HELP это намёк на то, чтобы я ввёл в Фоксе первое, выделил и нажал F1, да? :-) А HELP @ это что? Аналогично? Ну, помогите, пожалуйста, исправить вышеописанные проблемы. Ведь вы знаете как, ну. Пожалуйста! И подскажите, пожалуйста, как сделать выбор всех постояльцев, отъезжающих сегодня. И ещё. В этой программе:
Код: plaintext
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.
SET TALK OFF 
SET DATE GERMAN 
set century on
set deleted on

ON KEY LABEL F10 ACTIVATE WINDOW F10 && Вызов окна баэы 
ON KEY LABEL F6 ACTIVATE WIND e1 && Выэов окна первого этажа 
ON KEY LABEL F7 ACTIVATE WIND e2 && Вызов окна второго этажа 
ON KEY LABEL F8 ACTIVATE WIND e3 && Вызов окна третьего этажа 
ON KEY LABEL F9 ACTIVATE WIND e4 && Вызов окна четвёртого этажа

DEFINE WINDOW gost FROM  0 , 0  TO  8 , 79 ; 
       TITLE 'F10 Список гостей Сегодня '+dtoc(date()) && Окно - список гостей 
DEFINE WINDOW e1 FROM  5 , 00  TO  14 , 29 ; 
       TITLE 'F6 Этаж 1' COLOR n/gb && Окно первого этажа 
DEFINE WINDOW e2 FROM  15 , 00  TO  24 , 29 ; 
       TITLE 'F7 Этаж 2' COLOR n/gb && Окно второго этажа 
DEFINE WINDOW e3 FROM  5 , 49  TO  14 , 78 ; 
       TITLE 'F8 Этаж 3' COLOR n/gb && Окно третьего этажа 
DEFINE WINDOW e4 FROM  15 , 49  TO  24 , 78 ; 
       TITLE 'F9 Этаж 4' COLOR n/gb && Окно четвёртого этажа  

USE guests.dbf

go top

r=RECNO() 
browse;
  fiel t=iif(r=recno(),'>',' ') :h=' ', ;
       d=iif(date()>opl and !empty(fam),iif(empty(otb) or otb>date(),'Долг','Отбыл'),'    ') :h='Долг', ;
       mes :h='Место': 5 ,;
       fam :h='ФИО': 20 , ;
       pol :h='Пол': 3   ;
           :w=(pol='М' or pol='Ж') and pl(left(mes, 3 ),pol) ;
           :e='Только М или Ж', ;
       pas :h='ь паспорта': 10 , ;
       pri :h='Дата прибытия': 13 , ;
       otb :h='Дата отбытия': 12 , ;
       opl :h='Оплачено до': 11 , ;
       num :h='ь гостя': 7  ;
       color scheme  10  window gost nowait when ttt() noed noap nodel 

ACTIVATE WINDOW e1                           && Открытие окна первого этажа
@  0 , 0  SAY '----------------------------'
@  1 , 0  SAY '|1   3|1     |1    2|1     |'
@  2 , 0  SAY '|2   4|2     |      |2     |'
@  3 , 0  SAY '|-101----102----103---104--|'
@  4 , 0  SAY '|                          |'
@  5 , 0  SAY '|-105----106--      --107--|'
@  6 , 0  SAY '|1    |1     |      |1     |'
@  7 , 0  SAY '----------------------------'
@  1 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('1011')
@  2 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('1012')
@  1 , 4  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALID ms('1013')

ACTIVATE WINDOW e2   &&Открытие окна второго этажа
@  0 , 0  SAY '----------------------------'
@  1 , 0  SAY '|1   3|1     |1    2|1     |'
@  2 , 0  SAY '|2   4|2     |      |2     |'
@  3 , 0  SAY '|-201----202----203---204--|'
@  4 , 0  SAY '|                          |'
@  5 , 0  SAY '|-205----206--      --207--|'
@  6 , 0  SAY '|1    |1     |      |1     |'
@  7 , 0  SAY '----------------------------'
@  1 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('2011')
@  2 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('2012')

ACTIVATE WINDOW e3   && Открытие окна третьего этажа
@  0 , 0  SAY '----------------------------'
@  1 , 0  SAY '|1   3|1     |1    2|1     |'
@  2 , 0  SAY '|2   4|2     |      |2     |'
@  3 , 0  SAY '|-301----302----303---304--|'
@  4 , 0  SAY '|                          |'
@  5 , 0  SAY '|-305----306--      --307--|'
@  6 , 0  SAY '|1    |1     |      |1     |'
@  7 , 0  SAY '----------------------------'
@  1 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('3011')
@  2 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('3012')

ACTIVATE WINDOW e4   && Открытие окна третьего этажа
@  0 , 0  SAY '----------------------------'
@  1 , 0  SAY '|1   3|1     |1    2|1     |'
@  2 , 0  SAY '|2   4|2     |      |2     |'
@  3 , 0  SAY '|-401----402----403---404--|'
@  4 , 0  SAY '|                          |'
@  5 , 0  SAY '|-405----406--      --407--|'
@  6 , 0  SAY '|1    |1     |      |1     |'
@  7 , 0  SAY '----------------------------'
@  1 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('4011')
@  2 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('4012')

READ CYCLE 
DEACTIVATE WINDOW gost,e1,e2,e3,e4,F10 
RELEASE WINDOWS gost,e1,e2,e3,e4,F10
ON KEY 
return

FUNCTION ttt &&-----------ФУНКЦИЯ обновления курсора 
r=RECNO() 
SHOW WINDOW f10 REFRESH 
RETURN 

FUNCTION ms &&--0тслеживание в окне GOST записи с данными о 
            && человеке, занимающем место, где находится курсор в плане этажа 
PARAMETERS m 
if SEEK(m) && Поиск в BROWSE-окне выбранного на плане места 
  r=RECNO() 
else
 wait window "Not found!!!" timeout  2 
endif 
SHOW WINDOW f10 REFRESH 
RETURN 

FUNCTION pl &&-----Функция предупреждений (Мужчина/Женщина) 
PARAMETERS m,p 
nr=RECNO() && Запоминается номер текущей записи 
           && Поиск непустого места в той же комнате, где проживает 
           && человек с другим аначением поля POL 
go top           
locate for left(mes, 3 )==m AND !EMPTY(pol) AND pol#p 
IF found() && Если поиск удачный, выдается предупреждение 
   WAIT 'В комнате живет '+IIF(pol$'МM','Мужчина','Женщина'); 
         WINDOW NOWAIT 
   select guests
   GO nr && Возврат к исходной записи 
   return .f.
ENDIF 
RETURN .t.
я хочу сделать так, чтобы когда в окне этажа нажимаешь на какое-нибудь место, то, чтобы выводилось кто там живёт. Чтобы при добавлении гостя соответсвующее место выделилось, а при удалении стало пустым, т.е. занятость и освобождение места. Помогите, пожалуйста.
...
Рейтинг: 0 / 0
31.07.2006, 10:10
| Ответить | Цитировать | Написать  
Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
    #33888280
parenyok
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
parenyok
Участник
UrriHELP @
HELP set color commandsТак... Как я понимаю set color commands это установка цвета в команде, т.е. в выделенных фоном словах, а HELP это намёк на то, чтобы я ввёл в Фоксе первое, выделил и нажал F1, да? :-) А HELP @ это что? Аналогично? Ну, помогите, пожалуйста, исправить вышеописанные проблемы. Ведь вы знаете как, ну. Пожалуйста! И подскажите, пожалуйста, как сделать выбор всех постояльцев, отъезжающих сегодня. И ещё. В этой программе:
Код: plaintext
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.
SET TALK OFF 
SET DATE GERMAN 
set century on
set deleted on

ON KEY LABEL F10 ACTIVATE WINDOW F10 && Вызов окна баэы 
ON KEY LABEL F6 ACTIVATE WIND e1 && Выэов окна первого этажа 
ON KEY LABEL F7 ACTIVATE WIND e2 && Вызов окна второго этажа 
ON KEY LABEL F8 ACTIVATE WIND e3 && Вызов окна третьего этажа 
ON KEY LABEL F9 ACTIVATE WIND e4 && Вызов окна четвёртого этажа

DEFINE WINDOW gost FROM  0 , 0  TO  8 , 79 ; 
       TITLE 'F10 Список гостей Сегодня '+dtoc(date()) && Окно - список гостей 
DEFINE WINDOW e1 FROM  5 , 00  TO  14 , 29 ; 
       TITLE 'F6 Этаж 1' COLOR n/gb && Окно первого этажа 
DEFINE WINDOW e2 FROM  15 , 00  TO  24 , 29 ; 
       TITLE 'F7 Этаж 2' COLOR n/gb && Окно второго этажа 
DEFINE WINDOW e3 FROM  5 , 49  TO  14 , 78 ; 
       TITLE 'F8 Этаж 3' COLOR n/gb && Окно третьего этажа 
DEFINE WINDOW e4 FROM  15 , 49  TO  24 , 78 ; 
       TITLE 'F9 Этаж 4' COLOR n/gb && Окно четвёртого этажа  

USE guests.dbf

go top

r=RECNO() 
browse;
  fiel t=iif(r=recno(),'>',' ') :h=' ', ;
       d=iif(date()>opl and !empty(fam),iif(empty(otb) or otb>date(),'Долг','Отбыл'),'    ') :h='Долг', ;
       mes :h='Место': 5 ,;
       fam :h='ФИО': 20 , ;
       pol :h='Пол': 3   ;
           :w=(pol='М' or pol='Ж') and pl(left(mes, 3 ),pol) ;
           :e='Только М или Ж', ;
       pas :h='ь паспорта': 10 , ;
       pri :h='Дата прибытия': 13 , ;
       otb :h='Дата отбытия': 12 , ;
       opl :h='Оплачено до': 11 , ;
       num :h='ь гостя': 7  ;
       color scheme  10  window gost nowait when ttt() noed noap nodel 

ACTIVATE WINDOW e1                           && Открытие окна первого этажа
@  0 , 0  SAY '----------------------------'
@  1 , 0  SAY '|1   3|1     |1    2|1     |'
@  2 , 0  SAY '|2   4|2     |      |2     |'
@  3 , 0  SAY '|-101----102----103---104--|'
@  4 , 0  SAY '|                          |'
@  5 , 0  SAY '|-105----106--      --107--|'
@  6 , 0  SAY '|1    |1     |      |1     |'
@  7 , 0  SAY '----------------------------'
@  1 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('1011')
@  2 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('1012')
@  1 , 4  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALID ms('1013')

ACTIVATE WINDOW e2   &&Открытие окна второго этажа
@  0 , 0  SAY '----------------------------'
@  1 , 0  SAY '|1   3|1     |1    2|1     |'
@  2 , 0  SAY '|2   4|2     |      |2     |'
@  3 , 0  SAY '|-201----202----203---204--|'
@  4 , 0  SAY '|                          |'
@  5 , 0  SAY '|-205----206--      --207--|'
@  6 , 0  SAY '|1    |1     |      |1     |'
@  7 , 0  SAY '----------------------------'
@  1 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('2011')
@  2 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('2012')

ACTIVATE WINDOW e3   && Открытие окна третьего этажа
@  0 , 0  SAY '----------------------------'
@  1 , 0  SAY '|1   3|1     |1    2|1     |'
@  2 , 0  SAY '|2   4|2     |      |2     |'
@  3 , 0  SAY '|-301----302----303---304--|'
@  4 , 0  SAY '|                          |'
@  5 , 0  SAY '|-305----306--      --307--|'
@  6 , 0  SAY '|1    |1     |      |1     |'
@  7 , 0  SAY '----------------------------'
@  1 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('3011')
@  2 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('3012')

ACTIVATE WINDOW e4   && Открытие окна третьего этажа
@  0 , 0  SAY '----------------------------'
@  1 , 0  SAY '|1   3|1     |1    2|1     |'
@  2 , 0  SAY '|2   4|2     |      |2     |'
@  3 , 0  SAY '|-401----402----403---404--|'
@  4 , 0  SAY '|                          |'
@  5 , 0  SAY '|-405----406--      --407--|'
@  6 , 0  SAY '|1    |1     |      |1     |'
@  7 , 0  SAY '----------------------------'
@  1 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('4011')
@  2 , 1  GET n FUNCTION '*I' SIZE  1 , 1  DEFAULT  1  VALI ms('4012')

READ CYCLE 
DEACTIVATE WINDOW gost,e1,e2,e3,e4,F10 
RELEASE WINDOWS gost,e1,e2,e3,e4,F10
ON KEY 
return

FUNCTION ttt &&-----------ФУНКЦИЯ обновления курсора 
r=RECNO() 
SHOW WINDOW f10 REFRESH 
RETURN 

FUNCTION ms &&--0тслеживание в окне GOST записи с данными о 
            && человеке, занимающем место, где находится курсор в плане этажа 
PARAMETERS m 
if SEEK(m) && Поиск в BROWSE-окне выбранного на плане места 
  r=RECNO() 
else
 wait window "Not found!!!" timeout  2 
endif 
SHOW WINDOW f10 REFRESH 
RETURN 

FUNCTION pl &&-----Функция предупреждений (Мужчина/Женщина) 
PARAMETERS m,p 
nr=RECNO() && Запоминается номер текущей записи 
           && Поиск непустого места в той же комнате, где проживает 
           && человек с другим аначением поля POL 
go top           
locate for left(mes, 3 )==m AND !EMPTY(pol) AND pol#p 
IF found() && Если поиск удачный, выдается предупреждение 
   WAIT 'В комнате живет '+IIF(pol$'МM','Мужчина','Женщина'); 
         WINDOW NOWAIT 
   select guests
   GO nr && Возврат к исходной записи 
   return .f.
ENDIF 
RETURN .t.
я хочу сделать так, чтобы когда в окне этажа нажимаешь на какое-нибудь место, то, чтобы выводилось кто там живёт. Чтобы при добавлении гостя соответсвующее место выделилось, а при удалении стало пустым, т.е. занятость и освобождение места. Помогите, пожалуйста.
...
Рейтинг: 0 / 0
31.07.2006, 10:12
| Ответить | Цитировать | Написать  
25 сообщений из 68, страница 2 из 3
  2  все
Форумы / FoxPro, Visual FoxPro [игнор отключен] [закрыт для гостей] / Помогите, пожалуйста, исправить ошибки в программе на FoxPro 2.6 DOS
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=41&msg=33872209&tid=1590957]:
 0ms
get settings:
 10ms
get forum list:
 15ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 149ms
get topic data:
 10ms
get forum data:
 2ms
get page messages:
 82ms
get tp. blocked users:
 2ms
others: 230ms
total:  506ms
созд. / загр.: 506ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]