Разработка базы данных «Учет добычи и отгрузки угля на шахте» (Приложения к дипломному проекту. Текст программы), страница 2

set status off

SET TALK OFF

SET DATE TO GERMAN

SET CENTURY ON

SET ESCAPE OFF

SET DEFAULT TO C:\111_V7

SET PATH TO LIBS, PRG, MENUS, DATA, REPORTS

ON SHUTDOWN DO ALVExitProc

PUSH MENU _MSYSMENU

*        Вызываем, на выполнение форму

DO FORM C:\111_V7\FORMS\Parol

_SCREEN.Visible = .T.

READ EVENTS

*        Восстанавливаем настройки

POP MENU _MSYSMENU

on SHUTDOWN

*        Процедура завершения программы

PROCEDURE ALVExitProc

CLEAR EVENTS

quit

Продолжение приложения Г

************** Оперативная сводка на форме «Добыча угля ************

thisform.label13.caption=str(p2008.up5d/kol_dn,5)

thisform.label14.caption=str(-p2008.up5d/kol_dn+u2008.uf5d,7)

thisform.label15.caption=str(p2008.up6d/kol_dn,5)

thisform.label16.caption=str(-p2008.up6d/kol_dn+u2008.uf6d,7)

thisform.label17.caption=str(p2008.upgd/kol_dn,5)

thisform.label18.caption=str(-p2008.upgd/kol_dn+u2008.ufgd,7)

thisform.label19.caption=str(p2008.uppd/kol_dn,5)

thisform.label20.caption=str(-p2008.uppd/kol_dn+u2008.ufpd,7)

thisform.label21.caption=str(p2008.updd/kol_dn,5)

thisform.label22.caption=str(-p2008.updd/kol_dn+u2008.ufdd,7)

i=inkey(4)

*if messagebox("Çàêðûòü ñâîäêó?", 4+32+256,"Îïåðàòèâíàÿ ñâîäêà")=6

thisform.label2.caption='             '

thisform.label5.caption='    '

thisform.label3.caption=space(5)

thisform.label6.caption=space(7)

thisform.label7.caption=space(5)

thisform.label8.caption=space(7)

thisform.label9.caption=space(5)

thisform.label10.caption=space(7)

thisform.label11.caption=space(5)

thisform.label12.caption=space(7)

thisform.label13.caption=space(5)

thisform.label14.caption=space(7)

thisform.label15.caption=space(5)

thisform.label16.caption=space(7)

thisform.label17.caption=space(5)

thisform.label18.caption=space(7)

Продолжение приложения Г

thisform.label19.caption=space(5)

thisform.label20.caption=space(7)

thisform.label21.caption=space(5)

thisform.label22.caption=space(7)

*else

*  _screen.ActiveForm.Refresh()

*endif

*thisform.text2.value=p2008.up2d/kol_dn

*thisform.text3.value=p2008.up3d/kol_dn

*thisform.text4.value=p2008.up4d/kol_dn

*thisform.text5.value=p2008.up5d/kol_dn

*thisform.text6.value=p2008.up6d/kol_dn

*thisform.text7.value=p2008.upgd/kol_dn

*thisform.text8.value=p2008.uppd/kol_dn

*thisform.text9.value=p2008.updd/kol_dn  skip

enddo

sele 3

use www

33

29

close all

*** Form_sv_dob.prg – Формирование оперативной сводки ***

dimension k(12), m(9), g(9)

STORE 0 TO m, g

k(1)=31

k(2)=28

k(3)=31

k(4)=30

k(5)=31

k(6)=30

k(7)=31

k(8)=31

k(9)=30

k(10)=31

k(11)=30

Продолжение приложения Г

k(12)=31

dat1=thisForm.text1.Value

nm=mont(dat1)

den= DAY(dat1)

kol_dn=k(nm)

SELECT c

d=CURDIR()+'\data\svodka_d'

USE &d EXCLUSIVE

DELETE ALL

PACK

SELECT b

USE p2008  EXCLUSIVE

sele a

use u2008  EXCLUSIVE

*** за день

LOCATE FOR data=dat1

IF !FOUND()

messagebox("Нет факта за этот день",48,"Внимание")

thisForm.text1.SetFocus()

thisForm.text1.Value=dat1

_screen.ActiveForm.Refresh()

SELECT d

t=CURDIR()+'\data\svodka'

USE &t EXCLUSIVE

DELETE ALL

PACK

return

ELSE

SET FILTER TO data=dat1

SELECT b

LOCATE FOR mes=nm

IF !FOUND()

messagebox("Нет плана за этот месяц",48,"Внимание")

thisForm.text1.SetFocus()

thisForm.text1.Value=dat1

_screen.ActiveForm.Refresh()

SELECT d

       Продолжение приложения Г

t=CURDIR()+'\data\svodka'

USE &t  EXCLUSIVE

DELETE ALL

PACK

return

ENDIF

SET FILTER TO mes=nm

SELECT c

APPEND BLANK

replace dat WITH a.data, uf1d WITH a.uf1d, uf2d WITH a.uf2d, uf3d WITH a.uf3d, uf4d WITH a.uf4d, uf5d WITH a.uf5d, uf6d WITH a.uf6d

replace ufgd WITH a.ufgd, ufpd WITH a.ufpd, ufdd WITH a.ufdd

repl  ufsd with uf1d+uf2d+uf3d+uf4d+uf5d+uf6d+ufgd+ufpd+ufdd

replace  up1d WITH b.up1d/kol_dn , up2d WITH b.up2d/kol_dn , up3d WITH b.up3d/kol_dn

replace  up4d WITH b.up4d/kol_dn , up5d WITH b.up5d/kol_dn , up6d WITH b.up6d/kol_dn

replace upgd WITH b.upgd/kol_dn, uppd WITH b.uppd/kol_dn, updd WITH b.updd/kol_dn

repl  upsd with up1d+up2d+up3d+up4d+up5d+up6d+upgd+uppd+updd

** с начала месяца

SELECT e

d=CURDIR()+'\data\svodka_m'

USE &d  EXCLUSIVE

DELETE ALL

PACK