Журнал-ордер. Универсальная форма.



Posted by Анатолий, Херсон. on April 05, 2000 at 14:01:34:

Не знаю что нашло, но нашло.

Вспомнил свои наработки - решил поделиться.

Многие увидят кривизну алгоритма и т.п,
но эта форма в производстве была 2 раза:
1-й раз - в 1996 году. 1-е рождение.
2-й раз - в 1999 году. 2-е рождение(массивы, пременная ширина колонок, убрал нулевые значения и др.).
Самое главное - форма работает, и неплохо.

Попробуйте. Может кому и пригодится ?


* Журнал-ордер по субсчетам
* Строкань Анатолий, г.Херсон
* Версия: 2.01 от 18.07.1999
************************************************************
* Данная форма, является прямым потомком Шахматки из
* стандартного комплета ФбП v.4000. Идея Автора ФбП(А.Г.Водяника).
************************************************************
* Эта фоpма может быть выполнена "Финансами без пpоблем" *
* веpсии ultra/H и выше *
************************************************************
* Фоpма не зависит от набоpа счетов и их паpаметpов.
******************************************************************************
* Форма строит журнал-ордер для субсчетов указанного счета
* в разрезе корреспонденций со счетами "Плана счетов"
******************************************************************************
* Форма строится всегда в пределеах c 01.MF.YC по 31.ML.YC
* Нулевые значения не отображаются, ширина колонок настраивается автоматически.
* Ширина колонки наименований не превышает 40 символов, "хвост" отсекается
*******************************************************************************
if DF=0 FD=1
else FD=DF
endif
if DL=0
if ML<12 LD=[da 1,ML+1,YC]-[da 1,ML,YC]
else LD=31
endif
else LD=DL
endif
D1=YC*100+MF+FD/100
D2=YC*100+ML+LD/100
G1=FD+MF/100
G2=LD+ML/100
*
NX=[IS 'По какому счету:','',8]
* Авторизация, отключена
*! [pa *NX]='70' [p 1,'70'];call Autorise
*! [n1 *NX]='70' [p 1,'70'];call Autorise
*
WL=[iy ' В линейку ? ']
AL=0 '~[iy ' Не показывать субсчета без движения ? ']отключено
LP=[ir 'Пpедельная шиpина пpинтеpа?',255,0]
C0=0.0004999 малое число для оценок пустоты
*
* (".99")
KO=2*1 всегда с копейками
*KO=2*[iy ' Числа с копейками ? ']
*
* прочие параметры
WN=1 ширина колонки наименований
RK=1 ширина колонки ОД
RD=1 ширина колонки ОК
* расчет ширины поля наименования - не более 25 **********
#*NX
RR=[length [n2 #]]
if RR>WN WN=RR; endif
RR=[length [intsn [OK #,MF,ML]]]
if RR>RK RK=RR; endif
RR=[length [intsn [OD #,MF,ML]]]
if RR>RD RD=RR; endif
#
! WN > 25 WN=25
WA=8 ширина поля с/счетов
*********************************************************
NA=[na *NX]
! [as *NX]=0

Счет ^^^^^^^^^^^^^^^^NA^^^^^^^^^^^^^^^^^^^^ не имеет субсчетов.
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Построить журнал-ордер ведомость для этого счета нельзя.
stop
!
****************************************************************
* подготовка массивов со счетами и их оборотами
ID=1 Индекс по дебету
IK=1 Индекс по кредиту
SD=0 сумма оборотов по дебиту
SK=0 сумма оборотов по кредиту
WD=0 длина строки по дебету
WK=0 длина строки по кредиту
********************************
#План
X=[op *NX,#,MF,ML]
if X <>0 были коppеспонденции по дебету (т.е.обороты по кредиту)?
L1=[length [intsn X]]+1+KO определим длину суммы+ 3 (".99")
if X <0 L1=L1+1; endif
[L ID,L1] запомним длину суммы
[S ID,X] сумма оборота
[N ID,[n1 #]] наименование счета
SD=SD+X суммирование оборотов
WD=WD+L1 суммирование длины по дебету
[A ID,1] признак дебета
ID=ID+1 индекс ++
endif
*************************************************************
X=[op #,*NX,MF,ML]
if X <>0 были коppеспонденции по кpедиту (т.е .обороты по дебету)?
L1=[length [intsn X]]+1+KO определим длину суммы+KO (".99")
if X<0 L1=L1+1; endif
[X IK,L1] запомним длину суммы
[Y IK,X] сумма оборота
[Z IK,[n1 #]] наименование счета
SK=SK+X суммирование оборотов
WK=WK+L1 суммирование длины по кредиту
IK=IK+1 индекс ++
endif
*************************************************************
#
* Итого по дебету
RR=[length [intsn SD]]
! RD L1=RD+1+KO определим длину суммы итогов+ 3 (".99") по дебету
[L ID,L1] запомним длину суммы
[S ID,SD] сумма оборота
[N ID,'План'] наименование счета
WD=WD+L1 суммирование длины по дебету
[A ID,1] признак дебета
ID=ID+1 индекс ++
* Итого по кредиту
RR=[length [intsn SK]]
! RK L1=RK+1+KO определим длину суммы итогов+ 3 (".99") по кредиту
[X IK,L1] запомним длину суммы
[Y IK,SK] сумма оборота
[Z IK,'План'] наименование счета
WK=WK+L1 суммирование длины по кредиту
* IK=IK+1 индекс ++
*******************************************************************
* опр. ширины поля нач. сальдо LB
L1=[length [intsn [bd *NX,MF]]]; L2=1+[length [intsn[bk *NX,MF]]]; LB=L1+1+KO
! L1 < L2 LB=L2+1+KO
* опр. ширины поля кон. сальдо LE
L1=[length [intsn [ed *NX,ML]]]; L2=1+[length [intsn[ek *NX,ML]]]; LE=L1+1+KO
! L1 < L2 LE=L2+1+KO
*******************************************************************
* слияние массивов Дт+Кт
for i=1 to IK
[L ID,[X i]]
[S ID,[Y i]]
[N ID,[Z i]]
[A ID,2]
ID=ID+1
endfor
ID=ID-1
****************** освобождение ненужных массивов
array X,Y,Z
*******************************************************************
PG=1 признак текущей страницы
*
^^^^^^^^^^^^^^^^^^^^^^^^^^^^C1^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Журнал по счету ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^NA^ с ^^G1^^ по ^^G2^^ ^^^^^S1.
^^^f1 ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
**********************************************************
AN=1
IN=1
* определения разделителей - длина=40
LD='═════════════════════════════════════════' line double
LS='─────────────────────────────────────────' line single
Z1='╦════════════════════════════════════════'
Z2='╬════════════════════════════════════════'
Z3='╫────────────────────────────────────────'
Z4='╩════════════════════════════════════════'
Z5='╤════════════════════════════════════════'
Z6='╪════════════════════════════════════════'
Z7='┼────────────────────────────────────────'
Z8='╧════════════════════════════════════════'
ZD='║'; ZS='│'
**********************************************************
:BEGIN
* Заголовки строк
LI=2
H2='╔═══════'
H1='║Субсчет'
H9='╠═══════'
H3='╟───────'
H6='║ Итого '
H4='╚═══════'
LW=WA+1 line wide текущая
***
if PG=1
H2=H2+[cp '╤══════════════════════════',1,WN+1]+[cp Z1,1,LB+1]
H1=H1+[cp '│Наименование ',1,WN+1]+ZD+[cp 'Сальдо нач. ',1,LB]
H9=H9+[cp '╪══════════════════════════',1,WN+1]+[cp Z2,1,LB+1]
H3=H3+[cp '┼──────────────────────────',1,WN+1]+[cp Z3,1,LB+1]
H6=H6+[cp '│ ',1,WN+1]+ZD+[sn [ba *NX,MF],LB,KO]
H4=H4+[cp '╧══════════════════════════',1,WN+1]+[cp Z4,1,LB+1]
LW=LW+WN+LB+1
LI=2 признак двойной линии
endif
*
DD=0
AM=[S 0]
for j=AN to AM
L=[L j] длина
N=[N j] счет
NA=N имя для отображения
DA=[A j] тип 1-дебет, 2-кредит
if LI=2 если первый счет то двойной разделитель
DD=1; LI=1 двойные рамки
else DD=0; LI=0
endif
if NA='План' если План то подведение итогов
NA='ДЕБЕТ'
if DA=2 если тип=кредит
NA='КРЕДИТ'
endif
LI=2; DD=1 двойные рамки
endif
****
if DA=1
LS=[SN [op *NX,*N,MF,ML],L,KO]
else
LS=[SN [op *N,*NX,MF,ML],L,KO]
endif
LN=[cp NA+' ',1,L]
IF DD>0 если режим двойной рамки
H6=H6+ZD+LS
H1=H1+ZD+LN
H2=H2+[cp Z1,1,L+1]
H9=H9+[cp Z2,1,L+1]
H3=H3+[cp Z3,1,L+1]
H4=H4+[cp Z4,1,L+1]
LW=LW+L+1
else иначе одинарные рамки
H6=H6+ZS+LS
H1=H1+ZS+LN
H2=H2+[cp Z5,1,L+1]
H9=H9+[cp Z6,1,L+1]
H3=H3+[cp Z7,1,L+1]
H4=H4+[cp Z8,1,L+1]
LW=LW+L+1
endif
AN=j+1 следующий счет для обработки
if (AN< AM) & (LW+[L AN]>LP) j=AM; endif
endfor
* если еще не все субсчета
! AN < AM goto DISPLAY
*
if AN=[L 0]+1 если все обработано отобразим кон.сальдо
H1=H1+ZD+[cp 'Сальдо кон. ',1,LE]+ZD
H6=H6+ZD+[sn [ea *NX,ML],LE,2]+ZD
H2=H2+[cp Z1,1,LE+1]+'╗'
H9=H9+[cp Z2,1,LE+1]+'╣'
H3=H3+[cp Z3,1,LE+1]+'╢'
H4=H4+[cp Z4,1,LE+1]+'╝'
endif
*
:DISPLAY
LZ=H2; call DISPL_LZ
LZ=H1; call DISPL_LZ
LZ=H9; call DISPL_LZ
***************************************************************************
* цикл по строкам
IM=AN-1 последний элемент
#*NX
*
A=[n1 #] субсчет
! AL=1 goto ALL
LL=0
! [BA *A,MF] in -C0..C0 LL=LL+1
! [od *A,MF,ML] in -C0..C0 LL=LL+1
! [ok *A,MF,ML] in -C0..C0 LL=LL+1
! [ea *A,ML] in -C0..C0 LL=LL+1
! LL=4 goto L6
:ALL
* Заголовки строк
AR=[length A];RA=1
if (AR > WA-1) RA=AR-(WA-2); endif
H5='║'+[cp A+' ',RA,WA-1]
***
if PG=1
NN='│'+[cp [n2 *A]+' ',1,WN]
LS=[sn [ba *A,MF],LB,KO]
if LS=[SN 0,LB,KO] уберем нули
LS=[cp ' ',1,LB]
endif
H5=H5+NN+ZD+LS
endif
*
LI=2 признак двойной линии
IM=AN-1
for j=IN to IM
L=[L j] длина
N=[N j] счет
NA=N имя для отображения
DA=[A j] тип 1-дебет, 2-кредит
if LI=2 если первый счет то двойной разделитель
DD=1; LI=1 двойные рамки
else
DD=0; LI=0
endif
if NA='План' если План то подведение итогов
NA='ДЕБЕТ'
if DA=2 если тип=кредит
NA='КРЕДИТ'
endif
LI=2; DD=1 двойные рамки
endif
****
if DA=1 LS=[SN [op *A,*N,MF,ML],L,KO]
else LS=[SN [op *N,*A,MF,ML],L,KO]
endif
if LS=[SN 0,L,KO] уберем нули
LS=[cp ' ',1,L]
endif
IF DD=1 H5=H5+ZD+LS если режим двойной рамки
else H5=H5+ZS+LS иначе одинарные рамки
endif
endfor
if IM < AM если еще не все
goto DISPLINE
endif
*
LS=[sn [ea *A,ML],LE,2]
if LS=[SN 0,LE,KO] уберем нули
LS=[cp ' ',1,LE]
endif
H5=H5+ZD+LS+ZD
*
:DISPLINE
* вывод результатов
LZ=H5; call DISPL_LZ
! WL=1 LZ=H3; call DISPL_LZ
:L6
#
* ИТОГИ
! WL=0 LZ=H3; call DISPL_LZ
LZ=H6; call DISPL_LZ
LZ=H4; call DISPL_LZ
*^^e1
^^^ff


! (AN < [S 0]+1) PG=PG+1; IN=AN; goto BEGIN
^E1^ ^ff
stop

*************************************************************
* Подпрограмма вывода строки
:DISPL_LZ
* LZ = строка вывода
JL=[length LZ]
! JL > 255
╔══════════════════════════════════════╗
║ Ошибка !!!! ║
║ - строка вывода более 255 !!!! ║
╚══════════════════════════════════════╝
!
*goto WinClient для режима WinClient
goto DosMode для режима ДОС
:WinClient
^LZ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
goto DisReturn
:DosMode
JM=(JL-JL%5)/5+[ro (JL%5)/5+0.49]
for JI=1 to JM
JP=JI*5-4; JS=[cp LZ,JP,5]
^^JS^\
endfor

:DisReturn
return DISPL_LZ
*************************************************************




Пpишедшие ответы: