ON SELECTION BAR 2 OF MENU1 DO M1_12 WITH BAR()

ON SELECTION BAR 4 OF MENU1 ACTIVATE POPUP MENU12

ON SELECTION BAR 6 OF MENU1 DO M1_14 WITH BAR()

ON SELECTION BAR 7 OF MENU1 DO M1_15 WITH BAR()

ON SELECTION BAR 9 OF MENU1 DO M1_16 WITH BAR()

return

Лістінг модуля Dtop.prg

clear

CLEAR WINDOWS

clear

set talk off

set clock on

set message to 30 center

set century on

set date german

DEFINE WINDOW DTOP FROM 0,0 TO 24,79 COLOR SCHEME 1

ACTIVATE WINDOW DTOP

d=day(date())

m=month(date())

y=year(date())

@ 0,60 say 'Сьогодні '+alltrim(str(d))+','+alltrim(str(m))+','+alltrim(str(y))

@ 21,3 say '* Облік та нарахування амортизаці* основних засобів підприємства *'

@ 22,3 say '(C) 2000 ___ Зареєстровано: ВАТ "Коломийський сирзавод"'

return

Лістінг модуля М1_11.prg

parameter b

clear windows

close databases

set talk off

set date german

set century on

do dtop

select B

erase M1_111.idx

use dovvid

index on nazvav to M1_111.idx compact

define popup v01 prompt field nazvav from 5,5 shadow

on selection popup v01 do perv in M1_11 with recno()

define popup v02 prompt field nazvav from 5,5 shadow

on selection popup v02 do delv in M1_11 with recno()

define window p002 from 2,30 to 20,75 double shadow color scheme 1

define popup v03 prompt field nazvav from 3,5 shadow

on selection popup v03 do p23 in M1_11 with recno()

define popup p1 from 5,5 shadow

define bar 1 of p1 prompt 'Новий відділ'

define bar 2 of p1 prompt 'Перейменувати відділ'

define bar 3 of p1 prompt '\-'

define bar 4 of p1 prompt 'Знищити відділ'

on selection popup p1 do proc1 with bar()

activate popup p1

procedure proc1

parameter bar

do case

case bar=1

@ 2,10 say '*** ВНЕСЕННЯ НОВОГО ВІДДІЛУ ***'

DEFINE WINDOW w01 FROM 5,20 TO 9,65 double shadow COLOR SCHEME 1

ACTIVATE WINDOW w01

@ 0,4 say 'Введіть назву нового відділу'

nv=' '

@ 1,0 get nv

READ

NV=ALLTRIM(NV)

select b

go top

do while !eof()

if nazvav=nv

define window w02 from 7,7 to 16,70 double shadow color scheme 7

activate window w02

@ 0,8 say ' Такий відділ вже існує !'

@ 1,0 say ' Внесення даного відділу сприятиме виникненню помилок під час'

@ 2,0 say ' роботи оператора, оскільки існує висока імовірність переплу-'

@ 3,0 say ' тати відділи з оинаковими назвами !'

@ 5,10 prompt 'Внести відділ'

@ 5,40 prompt 'Відміна'

menu to r

deactivate window w02

if r=2

return

else

endif

else

endif

skip(1)

enddo

go bottom

x=kodv

append blank

go bottom

replace kodv with (x+1)

replace nazvav with nv

@ 2,0 say ' Новий відділ успішно внесений !'

@ 2,33 prompt ' OK '

menu to r

deactivate window w01

case bar=2

@ 2,10 say '*** ПЕРЕЙМЕНУВАННЯ ВІДДІЛУ *** '

select b

activate popup v01

case bar=4

@ 2,10 say '*** ВИДАЛЕННЯ ВІДДІЛУ *** '

select b

activate popup v02

ENDCASE

deactivate window dtop01

close databases

do dtop

deactivate popup p1

return

procedure perv

parameter r

goto(r)

define window w03 from 5,20 to 13,65 double shadow color scheme 5

activate window w03

@ 0,7 say '*** ПЕРЕЙМЕНУВАННЯ ВІДДІЛУ ***'

@ 1,0 SAY 'Стара назва відділу - '+nazvav

@ 2,0 say 'Введіть нову назву відділу'

nn=' '

@ 3,0 get nn

read

replace nazvav with alltrim(nn)

@ 5,0 say 'Відділ успішно перейменовано !'

@ 5,35 prompt ' O K '

menu to r

deactivate window w03

deactivate popup v01

return

procedure delv

parameter r

goto(r)

Define window d01 from 5,10 to 11,60 double shadow color scheme 5

activate window d01

@ 0,5 say 'УВАГА ВИКОНУЄТЬСЯ ЗНИЩЕННЯ ВІДДІЛУ !'

@ 1,0 SAY ' Буде знищено відділ - '+nazvav

@ 3,10 prompt ' ЗНИЩИТИ '

@ 3,30 prompt ' ВІДМІНА '

MENU TO y

do case

case y=1

clear

@ 0,4 say 'Увага , ОЗ даного відділу зараз можна '

@ 1,4 say 'перенести до іншого відділу, або зтерти'

@ 3,0 say 'Що зробити з ОЗ відділу ? '

@ 4,4 prompt ' ПЕРЕНЕСТИ '

@ 4,20 prompt ' ЗНИЩИТИ '

@ 4,35 prompt ' ВІДМІНА '

MENU TO X

do case

case x=1

activate window p002

@ 0,0 say 'Запропоновано перелік віділів'

@ 1,0 say 'Визначіть відділ в який перенести ОЗ'

activate popup v03

delete

pack

case x=2

k=kodv

use amortiz

delete for grp=k

pack

clear window d01

close database

clear windows

do dtop

return

case x=3

clear windows

do dtop

return

endcase

case y=2

clear windows

do dtop

return

endcase

clear windows

do dtop

return

Лістінг модуля M1_12.prg

PARAMETER BAR

SET TALK OFF

clear windows

close databases

do dtop

SELECT A

USE AMORTIZ

SELECT C

USE ZAH

SELECT B

erase M1_12dv.idx

USE DOVVID

index on nazvav to M1_12dv.idx

clear windows

do dtop

define window w033 from 5,5 to 10,75 double shadow

activate window w033

@ 0,0 say '*** Визначіть групу та коєфіцієнти ***'

@ 1,0 say 'Введіть номер групи'

g=1

@ 1,37 get G range 1,3 picture '#' error 'Введіть номер групи від 1 до 3'

read

do case

case g=1

@ 2,1 say 'Введіть норму амортизаці* ' get c.g1p1 picture '##.##'

@ 3,1 say 'Введіть понижуючий коефіцієнт ' get c.g1p2 picture '##.##'

read

replace c.p1 with c.g1p1

replace c.p2 with c.g1p2

case g=2

@ 2,1 say 'Введіть норму амортизаці* ' get c.g2p1 picture '##.##'

@ 3,1 say 'Введіть понижуючий коефіцієнт ' get c.g2p2 picture '##.##'

read

replace c.p1 with c.g2p1

replace c.p2 with c.g2p2

case g=3

@ 2,1 say 'Введіть норму амортизаці* ' get c.g3p1 picture '##.##'

@ 3,1 say 'Введіть понижуючий коефіцієнт ' get c.g3p2 picture '##.##'

read

replace c.p1 with c.g3p1

replace c.p2 with c.g3p2

otherwise

return

endcase

clear windows

do dtop

define window newd from 3,3 to 17,75 title 'Введення нових даних' double shadow

activate window newd

define popup p1 from 0,55

define bar 1 of p1 prompt '23'

define bar 2 of p1 prompt '231'

define bar 3 of p1 prompt '24'

define bar 4 of p1 prompt '26'

define bar 5 of p1 prompt '44'

define bar 6 of p1 prompt '81'

on selection popup p1 do raxproc with prompt()

select b

@ 0,2 SAY 'ВИБЕРІТЬ ВІДДІЛ'

DEFINE POPUP P01 PROMPT FIELD NAZVAV FROM 1,6 SHADOW

ON SELECTION POPUP P01 DO