Додаток 20 (продовження)
Parameters _rah
if parameters() = 0
howrah = 0
else
if type("_RAH") = "C"
howrah = _rah
else
howrah = alltrim(str(_rah))
endif
endif
*HOWRAH = '62'
_screen.caption = 'Рахунок'
******** SetSet
_screen.windowstate = 2
_SCREEN.CLS
clear wind all
CLOSE ALL
set dele on
set excl off
set multi on
set confirm on
set point to ','
set separator to [']
set reprocess to 5
PUSH MENU _msysmenu
hide menu _msysmenu
set dele on
SET TALK OFF
SET SAFETY OFF
SET DATE GERMAN
set escape off
set century on
************* Означення глобальних змінних
public gnpdv, znak, kurs, _YY_, _MM_, _yyarh_, _arh_, ACTIWIND, activind2, archiv, findstr, _minprcnad,
apname, findstr
public basesrahs, beforemm, beforeyear, _srtable_, _sttable_, _typeprn_
store ' ' to _sttable_, _srtable_, _tmpdt_, _tmpkt_, _typeprn_
********* Визначення базової директорії
ff = sys(16)
if 'FXP' $ FF OR 'PRG' $ FF
tt = rat('\',ff)
ff = left(ff,tt-1)
tt = rat('\',ff)
ff = left(ff,tt-1)
else
tt = rat('\',ff)
ff = left(ff,tt-1)
ENDIF
set defa to &ff
*-- Save and configure environment.
fpath = sys(5)+sys(2003)
g2 = fpath+'\sysapps;'
g3 = fpath+'\temp;'
g4 = fpath+'\datsets;'
g5 = fpath+'\reports;'
gpath = fpath+';'+ g2 +g3+g4+g5
set path to &gpath
if empty(howrah)
howrah = '60'
endif
_pathrah1 = alltrim(howrah)
hh = alltrim(howrah)
if len(hh) =2
*** добавляємо 00
_srtable_ = 'sr'+hh+'00'
else
_srtable_ = 'sr'+hh
endif
Додаток 22 (продовження)
_sttable_ ='set'+hh+'r'
g1 = fpath+'\R'+_pathrah1+';'
gpath = gpath+g1
SET PATH TO &gpath
if !file(_srtable_+'.dbf')
* create table &_srtable_ (pathfind m(4), archfind c(150), othefind c(150), basepath c(50))
* append blank
* use
* do form finddata to yy
* if empty(yy)
= messagebox("не знайдено файлу конфігурації")
close all
quit
* endif
endif
select 0
use &_srtable_
serverpath = pathFIND
_typeprn_ = typeprn
use
gpath = gpath+serverpath
SET PATH TO &gpath
SET CLASSLIB TO RAHS, diagram ADDITIVE
lcOnShutdown="ShutDown()"
ON SHUTDOWN &lcOnShutdown
ON ERROR ErrorHandler(ERROR(),PROGRAM(),LINENO())
*ON ERROR
_shell="DO Cleanup IN startprg"
apname = space(30)
findstr = space(20)
actiwind2 = .f.
public row_dos
row_dos = 63
_minprcnad = 40
findstr = space(50)
archiv = .f.
*SET PROC TO
SET PROCEDURE TO LIBRARY ADDITIVE
*ll = sysacces("0000003")
*if ll = -1
* close table all
* close data all
* ON ERROR
* ON SHUTDOWN
* retu
*endif
*-- Instantiate application object.
if !directory('temp')
md temp
endif
do setsetup
*do formclie
RELEASE goApp
PUBLIC goApp
goApp=CREATEOBJECT("cApplication")
goapp.appsoft = 0
*goapp.level = ll
*-- Configure application object.
otlb=createobject("tlbs")
*Otlb.Dock(0)
Додаток 22 (продовження)
Otlb.Show()
goApp.SetCaption('Рахунок '+alltrim(basesrahs))
goApp.cStartupMenu="MENUMENU.mpr"
do form f0000000
beforemm = _mm_
beforeyy = _yy_
*-- Show application.
goApp.Show
*-- Release application.
RELEASE goApp, otlb
*-- Restore default menu.
POP MENU _msysmenu
*-- Restore environment.
close table all
close data all
ON ERROR
ON SHUTDOWN
RETURN
*******************************************
FUNCTION ErrorHandler(nError,cMethod,nLine)
LOCAL lcErrorMsg,lcCodeLineMsg
WAIT CLEAR
lcErrorMsg=MESSAGE()+CHR(13)+CHR(13)
lcErrorMsg=lcErrorMsg+"Method: "+cMethod
lcCodeLineMsg=MESSAGE(1)
IF BETWEEN(nLine,1,10000) AND NOT lcCodeLineMsg="..."
lcErrorMsg=lcErrorMsg+CHR(13)+"Line: "+ALLTRIM(STR(nLine))
IF NOT EMPTY(lcCodeLineMsg)
lcErrorMsg=lcErrorMsg+CHR(13)+lcCodeLineMsg+chr(13)+chr(13)+'Припинити роботу?..'
ENDIF
ENDIF
IF MESSAGEBOX(lcErrorMsg,20,_screen.Caption)#6
RETURN .F.
else
QUIT
ENDIF
ENDFUNC
****************************************************
FUNCTION ShutDown
IF TYPE("goApp")=="O" AND NOT ISNULL(goApp)
RETURN goApp.OnShutDown()
ENDIF
Cleanup()
QUIT
ENDFUNC
FUNCTION Cleanup
IF CNTBAR("_msysmenu")=7
RETURN
ENDIF
ON ERROR
ON SHUTDOWN
SET CLASSLIB TO
*SET PATH TO
Додаток 22 (закінчення)
*CLEAR ALL
CLOSE ALL
close table all
close data all
POP MENU _msysmenu
RETURN
* p0000004
* Сальдо на поточний період на вказане число
local _nameorg, _ends
public fdata
lday = cdm(_mm_,_yy_)
fdata = ctod(str(lday,2)+'/'+str(_mm_,2)+'/'+str(_yy_,4))
do form getdata3 to ll
if empty(ll)
rele fdata
retu
endif
set textmerge on
set textmerge to t100004.txt noshow
set console off
public _br, ld, lk
_br = basesrahs
clrecv = ifused("recv")
clbases = ifused("bases")
clsaldos = ifused("saldos")
clclients = ifused(_clunions_)
_nameorg = recv.name
if clrecv
use in recv
endif
************************************************************************************
* Відбір даних по Д-ту вказаного рахунку
* та формування масиву відповідних рахунків
select * from bases ;
into table tdt1;
where dt = _br and month = _mm_ and year = _yy_ ;
order by codep
select * from tdt1 ;
into table tdt;
where daten <= fdata;
order by codep
public dime rds(1)
select distinct kt from tdt into array rds
ld = alen(rds)
if ld = 1 and empty(rds(1))
rds(1) = ' '
endif
dime sds(ld), zds(ld)
store 0 to sds, zds
************************************************************************************
* Відбір даних по K-ту вказаного рахунку
* та формування масиву відповідних рахунків
select * from bases ;
into table tkt1;
where kt = _br and month = _mm_ and year = _yy_;
order by codep
select * from tkt1 ;
into table tkt;
where daten <= fdata;
order by codep
public dime rks(1)
select distinct dt from tkt into array rks
lk = alen(rks)
if lk = 1 and empty(rks(1))
rks(1) = ' '
endif
dime sks(lk), zks(lk)
store 0 to sks, zks
*****************************************************
* Загальні суми
Додаток 23 (продовження)
store 0 to z_spd, z_spk, z_skd, z_skk, z_sod, z_sok
* по одному клієнту
* _spd - сальдо початкове по Д-ту
* _spk - сальдо початкове по К-ту
* _skd - сальдо кінцеве по К-ту
* _skk - сальдо кінцеве по Д-ту
* _sod - обороти по Д-ту
* _sok - обороти по К-ту
*
select (_clunions_)
do dgr_box with recc(), 'Побудова кінцевого сальдо','Pax.'+alltrim(_br)
\ <<_nameorg>>
\ Сальдо на кінець місяця по <<alltrim(_br)>> рах. Період: <<mstn(_mm_)>> <<_yy_>>p.
stor = 2
do sh00004
stor = stor +5
*set order to tag namep
npp = 0
scan
STORE 0 TO SKS, SDS
do dgr_mov
cd = codep
store 0 to _spd, _spk, _skd, _skk, _sod, _sok
select saldos
locate for codep = cd and month = _mm_ and year = _yy_ and dt = _br
if found()
_spd = sumdt
_spk = sumkt
endif
select tdt
scan for codep = cd and month = _mm_ and year = _yy_
for i = 1 to ld
if kt = rds(i)
sds(i) = sds(i) + sum &&накопичення по колонках
_sod = _sod +sum &&накопичення по рядку по Д-ту
endif
endfor
endscan
select tkt
scan for codep = cd and month = _mm_ and year = _yy_
for i = 1 to lk
if dt = rks(i)
sks(i) = sks(i) + sum &&накопичення по колонках
_sok = _sok +sum &&накопичення по рядку по K-ту
endif
endfor
endscan
_ends = _spd + _sod -(_spk + _sok)
do case
case _ends > 0
_skd = _ends
_skk = 0
case _ends < 0
_skk = (-1)*_ends
_skd = 0
endcase
*********************************************************************************
* Перевірка чи вносити рядок в TXT-файл
if empty(_sKd) and empty(_sKk) &&and empty(_sod) and empty(_sok)
* недрукуємо
else
*друкуємо
sele (_clunions_)
npp = npp+1
\<<str(npp,5)>>|<<left(namep,40)>>|
*** сальдо кінцеве
\<<iif(empty(_skd),space(10), str(_skd,10,2))>>|
\<<iif(empty(_skk),space(10), str(_skk,10,2))>>
**** підрахунок загальний сум
* поч.сальдо
z_spd = z_spd + _spd
Додаток 23 (продовження)
z_spk = z_spk + _spk
* Д-т
z_sod = z_sod + _sod
for i = 1 to ld
zds(i) = zds(i) + sds(i)
endfor
*К-т
z_sok = z_sok + _sok
for i = 1 to lk
zks(i) = zks(i) + sks(i)
endfor
* кін.сальдо
z_skd = z_skd + _skd
z_skk = z_skk + _skk
*******************************************
* Сторінка
stor = stor +1
if stor >=59
\<<chr(12)>>
stor = 7
do sh00004
endif
endif
select (_clunions_)
endscan
************
* Вивід загальних сум
do l00004
stor = stor +1
if stor >=59
\<<chr(12)>>
stor = 7
do sh00004
endif
\<<space(5)>>|<<padc('*** Всього ***',40,' ')>>|
*** сальдо кінцеве
\<<iif(empty(z_skd),space(10), str(z_skd,10,2))>>|
\<<iif(empty(z_skk),space(10), str(z_skk,10,2))>>
\ Згорнуте <<str(z_skd-z_skk,10,2))>>
\<<space(20)>>
do dgr_end
if clclients
sele (_clunions_)
use
endif
if clbases
use in bases
endif
if clsaldos
use in saldos
endif
if used("tdt")
use in tdt
endif
if used("tkt")
use in tkt
endif
if file("tdt.dbf")
erase tdt.dbf
endif
if file("tk.dbf")
erase tkt.dbf
endif
if used("tdt1")
use in tdt1
endif
if used("tkt1")
use in tkt1
endif
if file("tdt1.dbf")
erase tdt1.dbf
Додаток 23 (закінчення)
endif
if file("tkt1.dbf")
erase tkt1.dbf
endif
set textmerge to
set textmerge off
set console on
rele _nameorg, lk, ld, _br, _spd, _spk, _skd, _skk, _sod, _sok
rele z_spd, z_spk, z_skd, z_skk, z_sod, z_sok, sks, zks, sds, zds, rks, rds, fdata
**************************************
*
**************************************
PROCEDURE sh00004
* 1.
\-----+----------------------------------------+---------------------
* 2.***<<padc('П О С Т А Ч А Л Ь Н И К И
\ |<<space(40)>>|<<padc(' Сальдо на кін.місяця',21,' ')>>
* 3.
\ № +<<padc('П О С Т А Ч А Л Ь Н И К И',40,' ')>>+----------+----------
* 4.
\ |<<SPACE(40)>>+<<padc('Дебет',10,' ')>>+<<padc('Кредит',10,' ')>>
* 5.
\-----+----------------------------------------+----------+----------
RETU
**************************************
*
**************************************
PROCEDURE l00004
\-----+----------------------------------------+----------+----------
RETU
Додаток 2