define bar 4 of r1 prompt 'Переглянути 26 рахунок'

define bar 5 of r1 prompt 'Переглянути 44 рахунок'

define bar 6 of r1 prompt 'Переглянути 81 рахунок'

on selection popup r1 do pr01 with bar() in m12proc.prg

define popup r2 from 0,40

define bar 1 of r2 prompt 'Переглянути 1 групу'

define bar 2 of r2 prompt 'Переглянути 2 групу'

define bar 3 of r2 prompt 'Переглянути 3 групу'

on selection popup r2 do pr02 with bar() in m12proc.prg

DO CASE

CASE BAR=1

do m12_2 with bar()

CASE BAR=2

do m12_2 with bar()

CASE BAR=4

activate window w1201

@ 0,1 say 'Виберіть рахунок '

@ 1,1 say 'який треба переглянути'

activate popup r1

clear windows

do dtop

return

CASE BAR=5

define window w1202 from 6,10 to 12,70 double shadow color scheme 1

activate window w1202

@ 0,1 say 'Визначіть діапазон дати придбання для засобів, '

@ 1,1 say 'які треба переглянути'

d1=a.fdata1

d2=a.fdata2

@ 3,0 say 'Введіть початкову дату ' get d1

@ 4,0 say 'Введіть кінцеву дату ' get d2

read

replace fdata1 with d1

replace fdata2 with d2

clear windows

do dtop

return

CASE BAR=6

define window w1203 from 6,10 to 10,70 double shadow color scheme 1

activate window w1203

@ 0,1 say 'Виберіть групу '

@ 1,1 say 'яку треба переглянути'

activate popup r2

clear windows

do dtop

return

case bar=7

define window w1203 from 6,10 to 10,70 double shadow color scheme 1

activate window w1203

@ 0,1 say 'Введіть назву засобу, або перші кілька букв '

@ 1,1 get a.fnazva

read

CASE BAR=8

define window w1202 from 6,10 to 12,70 double shadow color scheme 1

activate window w1202

@ 0,1 say 'Визначіть діапазон балансово* вартості для засобів, '

@ 1,1 say 'які треба переглянути'

@ 3,0 say 'Введіть нижню межу вартості ' get fbalv1

@ 4,0 say 'Введіть верхню межу вартості ' get fbalv2

read

CASE BAR=9

define window w1206 from 6,10 to 12,70 double shadow color scheme 1

activate window w1206

@ 0,1 say 'Визначіть діапазон балансово* вартості для засобів, '

@ 1,1 say 'які треба переглянути'

@ 3,0 say 'Введіть нижню межу залишку ' get fzal1

@ 4,0 say 'Введіть верхню межу залишку ' get fzal2

read

case bar=11

replace frax with 0

replace fdata1 with {01/01/1900}

replace fdata2 with {01/01/2200}

replace fgrp with 0

replace fnazva with 'Назва'

replace fbalv1 with 0

replace fbalv2 with 0

replace fzal1 with 0

replace fzal2 with 0

use amortiz

set filter to

close databases

OTHERWISE

CLEAR WINDOWS

DO DTOP

close databases

RETURN

ENDCASE

CLEAR WINDOWS

DO DTOP

close databases

RETURN

procedure pr01

parameter bar

do case

case bar=1

replace a.frax with 23

case bar=2

replace a.frax with 231

case bar=3

replace a.frax with 24

case bar=4

replace a.frax with 26

case bar=5

replace a.frax with 44

case bar=6

replace a.frax with 81

otherwise

deactivate popup r1

return

endcase

deactivate popup r1

return

procedure pr02

parameter bar

do case

case bar=1

replace a.fgrp with 1

case bar=2

replace a.fgrp with 2

case bar=3

replace a.fgrp with 3

otherwise

replace a.fgrp with 0

deactivate popup r2

endcase

deactivate popup r2

return

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

parameter bar

close databases

set talk off

set date german

clear windows

clear

do dtop

select a

use amortiz

select b

use dovvid

define popup mg01 from 0,33

define bar 1 of mg01 prompt '1 група'

define bar 2 of mg01 prompt '2 група'

define bar 3 of mg01 prompt '3 група'

on selection popup mg1 do prg01 with bar() in m2_1.prg

define popup zmd01 prompt field nazvav shadow

on selection popup zmd01 do prmd01 with recno() in M2_1.prg

do case

case bar=1

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

ACTIVATE WINDOW w01

@ 1,0 say ' Для яко* групи вивести звіт ? '

activate popup mg01

NG=GGG()

case bar=2

select b

activate popup zmd01

NV=kv()

case bar=3

do prprint

case bar=5

set filter to

otherwise

do dtop

return

endcase

procedure prg01

parameter b1,GGG

do case

case b1=1

GGG=1

case b1=2

GGG=2

case b1=3

GGG=3

otherwise

deactivate popup mg01

clear windows

do dtop

return

endcase

return

procedure prmd01

parameter nv,KV

goto(nv)

KV=kodv

return

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

close databases

clear windows

clear

do dtop

set talk off

set date german

set century on

yr=year(date())

ms=month(date())

dt=date()

DO CASE

CASE MS>=1.AND.MS<=3

kvrt=1

CASE MS>=4.AND.MS<=6

kvrt=2

CASE MS>=7.AND.MS<=9

kvrt=3

CASE MS>=10.AND.MS<=12

kvrt=4

endcase

use zah

skv=kvt

staw=p1

staw1=p2

close databases

if skv!=kvrt

define window nk from 3,3 to 13,65 double shadow color scheme 7 title 'Перехід на новий квартал'

activate window nk

@ 0,20 say 'СЬОГОДНІ '+dmy(dt)

@ 1,20 say 'ПОТОЧНИЙ КВАРТАЛ '+STR(kvrt)

@ 3,10 prompt ' ПРОВЕСТИ ПЕРЕРАХУНОК ДЛЯ НОВОГО КВАРТАЛУ '

@ 5,17 prompt ' ПРОДОВЖИТИ БЕЗ ПЕРЕРАХУНКУ '

menu to r

do case

case r=1

do case

case kvrt=1

copy file c:\amortiz\amortiz.dbf to c:\amortiz\kvartal1\oz1.dbf

case kvrt=2

copy file c:\amortiz\amortiz.dbf to c:\amortiz\kvartal2\oz2.dbf

case kvrt=3

copy file c:\amortiz\amortiz.dbf to c:\amortiz\kvartal3\oz3.dbf

case kvrt=4

copy file c:\amortiz\amortiz.dbf to c:\amortiz\kvartal4\oz4.dbf

endcase

use amortiz

go top

do while !eof()

replace cena with amrt

replace oper1 with round(cena*staw*staw1/100,2)

replace amrt with cena-oper1

skip(1)

enddo

deactivate window nk

use zah

replace kvt with kvrt

close database

return

case r=2

deactivate window nk

return

endcase

else

do dtop

return

endif

do dtop

return

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

select a

USE ZAH

select b

use amortiz

go top

do while !eof()

do case

case grupa=1

replace oper1 with round(cena*a.g1P1*a.g1P2/100,2)

replace amrt with cena-oper1

case grupa=2

replace oper1 with round(cena*a.g2P1*a.g2P2/100,2)

replace amrt with cena-oper1

case grupa=3

replace oper1 with round(cena*a.g3P1*a.g3P2/100,2)

replace amrt with cena-oper1

otherwise

replace oper1 with 10101

replace amrt with 10101

endcase

skip(1)

enddo

return

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

clear windows

close databases

set talk off

do dtop

select a

use amortiz

select b

use pids

replace sbg1 with 0

replace spg1 with 0

replace skg1 with 0

replace szg1 with 0

replace s23g1 with 0

replace s231g1 with 0

replace s24g1 with 0

replace s26g1 with 0

replace s44g1 with 0

replace s81g1 with 0

replace sbg2 with 0

replace spg2 with 0

replace skg2 with 0

replace szg2 with 0

replace s23g2