Сторонние программы, полезные пользователям системы : КИС Lack & УС Land

    
* --------------------------------------------------------------------------------------------------
*   Универсальная процедура циклической подгонки цены с возможностью копипаста результата
PROC pgClcPrice()
    LOCA cOldCol:=SetColor(), GetList:={}
    LOCA nInp:=100, nNds:=20, nDir:=2, nMin:=0, nMax:=0
    LOCA nI:=0, nS:=0, nJ:=0, nT:=0
    
    //  Открываю головную форму с инструкцией для циклического в ней ввода и расчета цен
    fswOpen(0,0,11,59,cColor,3)
    
    @ 1,1   SAY "Пожалуйста введите значения и принципы расчетов цен от НДС"    COLO cHelpc
    @ 2,1   SAY "См. направление. Цена включая НДС или без НДС ............"
    @ 3,1   SAY "Процент ставки НДС на расчетный товар               ......"
    @ 4,1   SAY "Направление: 2-Вы ввели цену включая НДС. Программа подбе-"
    @ 5,1   SAY "рёт цены, что бы без НДС они были ровные, иначе Вы вводите"
    @ 6,1   SAY "цену без НДС, а программа будет подбирать цены с НДС     ."
    @ 7,1   SAY "----------------------------------------------------------"
    @ 8,1   SAY "Подходящая большая ............, меньшая цена ............"
    @ 9,1   SAY "Получаемые цены:                                          "    
    @10,1   SAY "Esc- выход, Ctrl+C - копировать в буфер, Enter- продолжить"    COLO cHelpc
    
    WHIL TRUE
        @ 2,47  GET nInp  PICT "999999999.99"     VALI lValid({||nInp > 0},"Запрещена отрицательная цена!")
        @ 3,53  GET nNds  PICT "999.99"           VALI lValid({||nNds >= 0},"Запрещена отрицательное значение!")
        @ 6,58  GET nDir  PICT "9"
        READ
        IF LastKey() == K_ESC THEN EXIT
        
        //  Подбор подходящих цен перебирая по копейке в зависимости от направления
        IF nDir == 2    //  Подбираем, что бы была ровной цена без НДС
            FOR nJ := 1 TO 2
                nT  := nInp
                WHIL TRUE
                    nS  := nT / (1 + nNds/100)
                    IF Abs(nS*100 - zInt(nS*100)) <= 0.000001 THEN EXIT
                    nT  += IF(nJ=1,(-1),(+1))*0.01
                END
                IF nJ = 1
                    nMin    := nS*(1 + nNds/100)
                ELSE
                    nMax    := nS*(1 + nNds/100)
                ENDI
            NEXT nJ
        ELSE            //  Подбираем ровные цены с НДС
            FOR nJ := 1 TO 2
                nT  := nInp
                WHIL TRUE
                    nS  := nT * (1 + nNds/100)
                    IF Abs(nS*100 - zInt(nS*100)) <= 0.000001 THEN EXIT
                    nT  += IF(nJ=1,(-1),(+1))*0.01
                END
                IF nJ = 1
                    nMin    := nS/(1 + nNds/100)
                ELSE
                    nMax    := nS/(1 + nNds/100)
                ENDI
            NEXT nJ
        ENDI

        GetList     := {}
        @ 9,20  SAY Str(IF(nDir <> 2, nMax*(1+nNds/100), nMax/(1+nNds/100)),12,2)
        @ 9,47  SAY Str(IF(nDir <> 2, nMin*(1+nNds/100), nMin/(1+nNds/100)),12,2)

        @ 8,20  GET nMax    PICT "999999999.99"
        @ 8,47  GET nMin    PICT "999999999.99"
        READ
        IF LastKey() == K_ESC THEN EXIT
    END

    fDeact( cOldCol )
    RETU

 ==================================================================================================
*   Проверка изменения списка кодов КВАП алкогольной продукции.
*   Разработка:   Жуков Андрей Николаевич                                          Автор: Жуков А.Н.
*   
*   Pdf файл списка КВАП сохраняем в текстовом файле каталога программы с любым именем. Программа
*   определяет список файлов *.txt своего каталога, выбирая из них самые свежие по шаблонам:
*   Last*.txt       - результат последней предыдущей проверки. Получаю массив aLast:={КВАП}
*   НЕ Last*.txt    - полагая его свежим списком КВАП. Перекачка в массив памяти aNew строки по
*       шаблону: длина строки 3-5 знаков и все знаки цифровые... полагая это кодами КВАП
*   Сличаю старый и новый массив, делаю лог расхождения *.log, сохраняю новый массив в Last*.txt
* ==================================================================================================
#include "..\LACK\LS\PRG\laks.ch"

* --------------------------------------------------------------------------------------------------
*   Головной модуль программы
PROC Main()
    LOCA cStr:="", cC:="", aTxt:=Directory("*.txt"), nI:=0, nL:=0, nS:=0, nLast:=0, nNew:=0, nN:=0
    LOCA cfLast:="", cfNew:="", aLast:={}, aNew:={}, dLast:=Ctod(""), dNew:=Ctod(""), dT:=Date()
    LOCA lBad:=TRUE, nJ:=0, cLog:=""

    //  Глобальные системные установки пакета.
    SET DATE GERMAN
    SET DELE ON
    SET ESCA ON
    SET SCOR OFF
    SET WRAP ON
    SET CENT OFF
    SET CURS OFF

    //  Стандартная цветовая гамма программы
    PRIV cMainc_c   := "GR+/B,N+/W,,,N/W",  cMainc_m    := "W/N,N/W,,,N/W+"
    PRIV cColor_c   := "N/W,GR+/B,,,N/G",   cColor_m    := "W/N,N/W,,,N/W+"
    PRIV cError_c   := "W+/R,W/N,,,W/B",    cError_m    := "W+/N,N/W,,,W/N"
    PRIV cHelpc_c   := "N/G,R/G,,,N/G+",    cHelpc_m    := "N/W,W/N,,,N/W+"
    PRIV cOther_c   := "N+/G,W/N,,,B/G",    cOther_m    := "N/W,W/N,,,N/W"
    PRIV cMainc     := IF(ISCOLOR(),cMainc_c,cMainc_m)
    PRIV cColor     := IF(ISCOLOR(),cColor_c,cColor_m)
    PRIV cError     := IF(ISCOLOR(),cError_c,cError_m)
    PRIV cHelpc     := IF(ISCOLOR(),cHelpc_c,cHelpc_m)
    PRIV cOther     := IF(ISCOLOR(),cOther_c,cOther_m)
    PRIV l_mus      := TRUE

    IF (nL:=Len(aTxt)) <= 0 THEN fErrQuit("В каталоге программы нет файлов *.txt для сравнения!",cError)
    pWind("Сличение новых кодов КВАП с раннее сохраненными. Версия 19.03.2022","test.ico")
    CLS

    //  Определяю имена самых свежих файлов сохраненного списка КВАП и файла от ФСРАР
    FOR nI := 1 TO nL
        IF At("LAST",Upper(aTxt[nI,1])) == 1        //  Сохранение списков КВАП. Может отсутствовать
            dT  := CToD(Subs(aTxt[nI,1],5,8))       //  Дата сохраненного файла, прописанная в имени
            IF dT >= dLast
                dLast   := dT
                nLast   := nI
            ENDI
        ELSE                                        //  Прочие файлы. Полагаю преобразования PDF от РАР в TXT 
            dT  := aTxt[nI,3]                       //  Системная дата сохраненного файла
            IF dT >= dNew
                dNew    := dT
                nNew    := nI
            ENDI
        ENDI
    NEXT
    IF nNew <= 0 THEN fErrQuit("В каталоге нет преобразованного в *.txt файла от ФСРАР!",cError)
    
    //  Перегоняю подходящие строки из файла от ФСРАР в массив памяти
    cStr    := MemoRead(aTxt[nNew,1])
    nN      := NumToken(cStr,CRLF)
    FOR nI := 1 TO nN
        X_DEMO
        cC  := Alltrim(Token(cStr,CRLF,nI))         //  Строка из текстового файла от ФСРАР
        
        //  Проверяю её на шаблон: длина строки 3-5 знаков и все знаки цифровые
        IF !(Len(cC)>=3 .AND. Len(cC)<=5) THEN LOOP
        
        lBad    := FALSE
        FOR nJ := 1 TO Len(cC)
            IF !IsDigit( Subs(cC,nJ,1) ) THEN lBad := TRUE
        NEXT nJ
        
        //  Подходящую строку с типа кодом КВАП добавляю в массив памяти
        IF !lBad THEN aadd(aNew,cC)
    NEXT nI
    
    //  При наличии предыдущего списка кодов перегоняю его в массив памяти и произвожу сличение списков
    IF nLast > 0    
        cStr    := MemoRead(aTxt[nLast,1])
        nN      := NumToken(cStr,CRLF)
        FOR nI := 1 TO nN
            X_DEMO
            cC  := Alltrim(Token(cStr,CRLF,nI))     //  Строка из текстового файла сохраненных кодов. Проверок не произвожу
            aadd(aLast,cC)
        NEXT nI
        
        lBad    := FALSE                            //  Признак наличия расхождения кодов
        cC      := Hb_OemToAnsi("Новый Старый")+CRLF
        FOR nI := 1 TO Len(aNew)                    //  Появился новый код КВАП
            X_DEMO
            nJ  := ascan(aLast,{|x|x==aNew[nI]})
            IF nJ <= 0
                cC      += aNew[nI]+Spac(6)+CRLF
                lBad    := TRUE
            ENDI
        NEXT nI
        FOR nI := 1 TO Len(aLast)                   //  Нереально - удалили код КВАП в новой таблице
            X_DEMO
            nJ  := ascan(aNew,{|x|x==aLast[nI]})
            IF nJ <= 0
                cC      += Spac(6)+aLast[nI]+CRLF
                lBad    := TRUE
            ENDI
        NEXT nI
        
        //  При наличии расхождений вывожу в текущий каталог файл логов. Сообщение зависит от результата
        IF lBad
            cLog    := "Rash_"+Dtos(Date())+"_"+StrTran(Time(),":")+".log"
            ErrMess("Расхождения! Смотрите в файле "+cLog,cError)
            MemoWrit( cLog, cC )
        ELSE
            ErrMess("Расхождений в списке кодов КВАП не обнаружено!",cColor)
        ENDI
    ENDI
    
    //  Сохраняю свежий список КВАП от РАР в файле последних кодов
    cC      := ""
    FOR nI := 1 TO Len(aNew) DO cC += aNew[nI]+CRLF
    MemoWrit( "Last"+Dtos(Date())+".txt", cC )

    fErrQuit("Спасибо за работу со мной!",cMainc)
    RETU