ACTIVATE POPUP P01

PROCEDURE PR01

PARAMETER RR

SELECT B

GO TOP

GOTO(RR)

KOD=KODV

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

activate window newd

r=1

do while r=1

clear

SELECT A

go bottom

lich=npp

APPEND blank

go bottom

replace npp with (lich+1)

replace GRP with KOD

replace grupa with g

CLEAR

@ 0,3 say 'Внесення ОЗ в '+b.nazvav+alltrim(str(G))+' група'

@ 1,1 say 'Введіть номер рахунку'

activate popup p1

@ 1,37 say 'Вибрано '+str(nrax)

@ 3,1 say 'Введіть дату придбання ОЗ'

@ 3,37 get data picture '##/##/##'

@ 4,1 say 'Введіть інвентарний номер'

@ 4,37 get invnom

@ 5,1 say 'Введіть назву засобу'

@ 5,22 get nazva

@ 6,1 say 'Введіть балансову вартість'

@ 6,37 get balrax picture '#######.##'

@ 7,1 say 'Введіть вартість на початок кварталу'

@ 7,37 get cena picture '#######.##'

read

replace oper1 with round(cena*C.P1*C.P2/100,2)

replace amrt with cena-oper1

@ 10,15 prompt 'Ще один запис' message 'повторити поновлення бази '

@ 10,35 prompt 'Вихід' message 'Вихід в основне меню'

menu to r

if r=2

clear windows

do dtop

deACTIVATE POPUP P01

return

else

endif

enddo

clear windows

do dtop

deACTIVATE POPUP P01

return

procedure raxproc

parameter prmt

replace nrax with val(prmt)

deactivate popup p1

return

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

parameter a

set talk off

define window www from 18,40 to 24,77 double shadow color scheme 7

activate window www

@ 0,3 say '*** ПРОВОДИТЬСЯ ПЕРЕРАХУНОК ***'

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)

@ 1,0 SAY 'для-'+nazva

@ 2,0 say str(cena)

@ 3,0 say str(amrt)

enddo

clear windows

do dtop

return

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

parameter bar

clear windows

close databases

set talk off

clear

do dtop

define window w033 from 5,5 to 19,55 double shadow

activate window w033

USE ZAH

@ 0,4 say '*** ПРОЦЕДУРА КОРЕКЦІ° КОЕФІЦІЄНТІВ ***'

@ 1,3 say 'Введіть коефіцієнти для 1* групи'

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

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

@ 4,1 say '-------------------------------------------'

@ 5,3 say 'Введіть коефіцієнти для 2* групи'

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

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

@ 8,1 say '-------------------------------------------'

@ 9,3 say 'Введіть коефіцієнти для 3* групи'

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

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

read

clear windows

do dtop

return

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

parameter bar

clear

clear windows

close databases

do dtop

set date german

set century on

select a

use amortiz

select b

use zah

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

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

activate window nk

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

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

select b

if kvt=kvrt

@ 2,1 say 'УВАГА перехід на новий квартал проводиться завчасно !'

else

endif

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

@ 6,13 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

select a

go top

do while !eof()

replace cena with amrt

skip(1)

enddo

do M1_1.prg &&виклик перерах

clear window nk

select b

replace kvt with kvrt

close databases

return

case r=2

clear windows

do dtop

return

endcase

clear windows

do dtop

return

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

parameter bar

set date german

set century on

set talk off

close databases

clear windows

do dtop

erase prm12.idx

select a

use amortiz

index on nazva to prm12.idx compact

ERASE m12m1ind.idx

select b

use dovvid

index ON NAZVAV TO m12m1ind.idx COMPACT

select c

use filter

select a

if c.frax!=0

set filter to a.nrax=c.frax

else

endif

set filter to between(a.data,c.fdata1,c.fdata2)

if c.fgrp!=0

set filter to grupa=c.fgrp

else

endif

if alltrim(c.fnazva)!='Назва'

set filter to nazva=c.fnazva

else

endif

if c.fbalv1!=0.and.c.fbalv2!=0

set filter to between(balrax,c.fbalv1,c.fbalv2)

else

endif

if c.fzal1!=0.and.c.fzal2!=0

set filter to between(Amrt,c.fzal1,c.fzal2)

else

endif

define popup m12m01 prompt field b.nazvav from 1,50 shadow

on selection popup m12m01 do m01b1pr with recno() in m12_2.prg

DEFINE WINDOW m12w1 FROM 2,0 TO 22,79 double shadow COLOR SCHEME 1

ACTIVATE WINDOW m12w1

@ 0,10 say '*** КОРЕКЦІЯ ТА СПИСАННЯ ОЗ ***'

@ 2,2 say 'ESC-вийти, F4-підсумок F8-зписати'

ON KEY LABEL F4 DO SUMPR in m12_2.prg

on KEY LABEL F8 delete

do case

case bar=2

@ 1,2 SAY 'Визначіть відділ якій треба переглянути'

select b

activate popup m12m01

case bar=1

do browser in m12_2.prg

otherwise

return

endcase

procedure m01b1pr

parameter recn

select b

go top

goto(recn)

DVKEY1=RECN

dvkey=kodv

select a

set filter to grp=dvkey

do browser

clear windows

do dtop

deactivate popup m12m01

CLOSE DATABASES

RETURN

procedure browser

parameter ddd

define window w0201 from 6,1 to 21,78 DOUBLE

activate window w0201

browse title 'Oсновні засоби відділу - '+b.nazvav fields invnom :h='інв.N',;

grupa :h='група', nrax :h='рахунок', Nazva :h='Назва ОЗ',balrax :h='балансова вартість',;

cena :h='варт.на початок кврт',;

oper1 :h='Знос за кв.',amrt :h='замортизована варт'

return

procedure sumpr

parameter k

select a

go top

select d

use sumator

replace d.sbalv with 0

replace d.scena with 0

replace d.soper with 0

replace d.samrt with 0

do while !eof()

select a

replace d.sbalv with d.sbalv+a.balrax

replace d.scena with d.scena+a.cena

replace d.soper with d.soper+a.oper1

replace d.samrt with d.samrt+a.amrt

skip(1)

enddo

define window w044 from 17,1 to 24,77 double shadow color scheme 1 title 'ПІДСУМКИ'

activate window w044

@ 0,1 say 'Cумарна балансова вартість ОЗ відділу='

@ 0,40 say d.sbalv

@ 1,1 say 'На початок кв.='

@ 1,17 say d.scena

@ 2,1 say 'Знос за квартал='

@ 2,17 say d.soper

@ 3,1 say 'Вартість на кінець кварталу='

@ 3,35 say d.samrt

@ 4,35 prompt ' ДАЛІ '

MENU TO R

IF R=1

DEACTIVATE WINDOW W044

select a

RETURN

ELSE

ENDIF

DEACTIVATE WINDOW W044

RETURN

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

parameter bar

set date german

set century on

set talk off

close databases

clear windows

do dtop

select a

use filter

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

define popup r1 from 0,40

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

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

define bar