DOC TO DOC2 — различия между версиями

Материал из Фабиус wiki
Перейти к: навигация, поиск
(Новая страница: «= Смотрите также = Полезные функции Функции Delphi»)
 
м (→‎Текст)
 
(не показаны 2 промежуточные версии этого же участника)
Строка 1: Строка 1:
 +
[[DOC_TO_DOC2]]- это программа из справочника [[R266]]
 +
  Копирование второго этажа
 +
[[DOC_TO_DOC2]]( kinddoc,  data,  lvlnum )
 +
= Текст =
 +
parameters kinddoc, data, lvlnum
 +
 +
local path, ocd1, del, aa, fld, i, sql, msg, sql2, lvl
 +
 +
if [[EMPTY]]( lvlnum )
 +
  lvl := '1'
 +
else
 +
  lvl := lvlnum
 +
endif
 +
 +
path := '\\FABIUS\FABIUS\OPDATA'
 +
del := [ KINDDOC = '] + kinddoc + [' and LVLNUM = '] + lvl + [' ]
 +
 +
ocd1 := OpenChildDoc( kinddoc, lvl, ~ParentForm := "", ~IsCondition := false, ~Month := Month( data ), ~Year := Year( data )  )
 +
( ocd1 )->( SetFilter( del ) )
 +
( ocd1 )->( Refresh() )
 +
 +
lvl := Str( val( lvl ) + 1 )
 +
 +
fld := {}
 +
 +
aa := ( ocd1 )->( DbStruct() )
 +
if !IsEmpty( aa )
 +
  for i := 6 to len( aa )
 +
    Aadd( fld, aa[i,1] )
 +
  next
 +
endif
 +
 +
sql := [ Select ]
 +
if !Empty( fld )
 +
  for i := 1 to len( fld )
 +
    sql := sql + fld[i] + [, ]
 +
  next
 +
endif
 +
sql := Left( sql, len( sql ) - 2 )
 +
sql := StrTran( sql, [ SUM,], [ "SUM",] )
 +
sql := sql + [ From DOCS] + Ret_f_ext( data ) + [ ;
 +
  Where KINDDOC = '] + kinddoc + [' and LVLNUM = '] + lvl + [' and PARENT = ']
 +
 +
( ocd1 )->( DbGoTop() )
 +
try
 +
  while !( ocd1 )->( eof() )
 +
    WaitMsg( 'Документ номер ' + ( ocd1 )->NUMDOC + ' от ' + ( ocd1 )->DATDOC + Chr( 10 ) + kinddoc + ' ' + RealName( 'R169', kinddoc ), msg )
 +
 +
    sql2 := sql + ( ocd1 )->USR_RGNUM + [' ]
 +
    aa := SqlToArr( sql2, fld, path )
 +
    if !IsEmpty( aa )
 +
      AddAll( kinddoc, lvl, ( ocd1 )->RGNUM,, fld, aa,, ;
 +
        ( ocd1 )->( GetForm( GetArea() ) ),,,,,, false,,, { false, false, false, false, false } )
 +
    endif
 +
    ( ocd1 )->( DbSkip() )
 +
  end
 +
finally
 +
  HideMsg( msg )
 +
end
 +
 +
( ocd1 )->( DbGoTop() )
 +
( ocd1 )->( MakePrvs( GetArea(),, 2 ) )
 +
 
= Смотрите также =
 
= Смотрите также =
 
[[Полезные функции]]
 
[[Полезные функции]]
  
 
[[Функции Delphi]]
 
[[Функции Delphi]]

Текущая версия на 14:37, 29 сентября 2017

DOC_TO_DOC2- это программа из справочника R266 

 Копирование второго этажа

DOC_TO_DOC2( kinddoc, data, lvlnum )

Текст

parameters kinddoc, data, lvlnum

local path, ocd1, del, aa, fld, i, sql, msg, sql2, lvl

if EMPTY( lvlnum )
  lvl := '1'
else
  lvl := lvlnum
endif

path := '\\FABIUS\FABIUS\OPDATA'
del := [ KINDDOC = '] + kinddoc + [' and LVLNUM = '] + lvl + [' ]

ocd1 := OpenChildDoc( kinddoc, lvl, ~ParentForm := "", ~IsCondition := false, ~Month := Month( data ), ~Year := Year( data )  )
( ocd1 )->( SetFilter( del ) )
( ocd1 )->( Refresh() )

lvl := Str( val( lvl ) + 1 )

fld := {}

aa := ( ocd1 )->( DbStruct() )
if !IsEmpty( aa )
  for i := 6 to len( aa )
    Aadd( fld, aa[i,1] )
  next
endif

sql := [ Select ]
if !Empty( fld )
  for i := 1 to len( fld )
    sql := sql + fld[i] + [, ]
  next
endif
sql := Left( sql, len( sql ) - 2 )
sql := StrTran( sql, [ SUM,], [ "SUM",] )
sql := sql + [ From DOCS] + Ret_f_ext( data ) + [ ;
  Where KINDDOC = '] + kinddoc + [' and LVLNUM = '] + lvl + [' and PARENT = ']

( ocd1 )->( DbGoTop() )
try
  while !( ocd1 )->( eof() )
    WaitMsg( 'Документ номер ' + ( ocd1 )->NUMDOC + ' от ' + ( ocd1 )->DATDOC + Chr( 10 ) + kinddoc + ' ' + RealName( 'R169', kinddoc ), msg )

    sql2 := sql + ( ocd1 )->USR_RGNUM + [' ]
    aa := SqlToArr( sql2, fld, path )
    if !IsEmpty( aa )
      AddAll( kinddoc, lvl, ( ocd1 )->RGNUM,, fld, aa,, ;
        ( ocd1 )->( GetForm( GetArea() ) ),,,,,, false,,, { false, false, false, false, false } )
    endif
    ( ocd1 )->( DbSkip() )
  end
finally
  HideMsg( msg )
end

( ocd1 )->( DbGoTop() )
( ocd1 )->( MakePrvs( GetArea(),, 2 ) )

Смотрите также

Полезные функции

Функции Delphi

Источник — «https://wiki.sftserv.ru/index.php?title=DOC_TO_DOC2&oldid=27200»