SET TALK OFF 
SET DATE GERMAN 
ON KEY LABEL F10 ACTIVATE WINDOW gost && Вызов окна баэы 
ON KEY LABEL F6 ACTIVATE WIND e1 && Выэов окна первого этажа 
ON KEY LABEL F7 ACTIVATE WIND e2 && Вызов окна второго этажа 
ON KEY LABEL F8 ACTIVATE WIND e3 && Вызов окна третьего этажа 

USE guests.dbf
* INDEX guests 
r=RECNO() 
DEFINE WINDOW gost FROM  0 , 0  TO  8 , 62 ; 
       TITLE 'F10 Список гостей' && Окно - список гостей 
DEFINE WINDOW e1 FROM  5 , 49  TO  14 , 78 ; 
       TITLE 'F6 Этаж 1' COLOR n/gb && Окно первого этажа 
DEFINE WINDOW e2 FROM  15 , 19  TO  24 , 48 ; 
       TITLE 'F7 Этаж 2' COLOR n/gb && Окно второго этажа 
DEFINE WINDOW e3 FROM  15 , 49  TO  24 , 78 ; 
       TITLE 'F8 Этаж 3' COLOR n/gb && Окно третьего этажа 

*noed noap in wind gost
*rele wind gost
*set deleted on

ACTIVATE WINDOW gost
pack
browse;
  fiel d=iif(date()>opl.and.!empty(fam),'Долг',' ') :h='Долг', ;
       r=iif(r=recno(),'>',' ') :h=' ', ;
       fam :h='ФИО': 20 , ;
       pol :h='Пол': 3 , ;
           :v=(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()
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')

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

FUNCTION ttt &&-----------ФУНКЦИЯ обновления курсора 
r=RECNO() 
SHOW WINDOW gost REFRESH 
RETURN 
FUNCTION ms &&--0тслеживание в окне GOST записи с данными о 
            && человеке, занимающем место, где находится курсор в плане этажа 
PARAMETERS.m 
SEEK m && Поиск в BROWSE-окне выбранного на плане места 
r=RECNO() 
SHOW WINDOW gost REFRESH 
RETURN 

FUNCTION pl &&-----Функция предупреждений (Мужчина/Женщина) 
PARAMETERS m,p 
nr=KECNO() && Запоминается номер текущей записи 
           && Поиск непустого места в той же комнате, где проживает 
           && человек с другим аначением поля POL 
LOCATE FOR mee=m.AND.!EMPTY(pol).AND.pol#p 
IF FOUND() && Если поиск удачный, выдается предупреждение 
   WAIT 'В комнате живет '+IIF(pol='M','Мужчина','Женщина'); 
         WINDOW NOWAIT 
   GO nr && Возврат к исходной записи 
ENDIF 
RETURN

browse;
  fiel d=iif(date()>opl.and.!empty(fam),'Долг',' ') :h='Долг', ;
       r=iif(r=recno(),'>',' ') :h=' ', ;
       fam :h='ФИО': 20 , ;
       pol :h='Пол': 3 , ;
           :v=(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()

FUNCTION ms &&--0тслеживание в окне GOST записи с данными о 
            && человеке, занимающем место, где находится курсор в плане этажа 
PARAMETERS.m 

FUNCTION pl &&-----Функция предупреждений (Мужчина/Женщина) 
PARAMETERS m,p 
nr=KECNO() && Запоминается номер текущей записи 
           && Поиск непустого места в той же комнате, где проживает 
           && человек с другим аначением поля POL 

  browse;
  fiel d=iif(date()>opl.and.!empty(fam),'Долг',' ') :h='Долг', ;

********************************************************************************
****************** Работа с БД гостей ***************
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    

********************************************************************************
****************** Работа с БД гостей ***************
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

locate for <fam>==cString

 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

locate for <fieldname>==cString

show window F10 refresh

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

 show window SFEDIT refresh

defi wind result from  5 , 00  to  20 , 80 ;
title 'Результаты поиска' foot 'Esc-Выход'
acti wind result

 show window result refresh

********************************************************************************
****************** Работа с БД гостей ***************
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