// Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.

#INCLUDE "s_public.ch"
#INCLUDE "s_refer.ch"
#INCLUDE "inkey.ch"


/*
  _cValuta  - Код валюты
  _dDate    - На какую дату курс
  _lInput   - Нужно ли вводить курс, если курса нет или,
                                     если CURR_CURS:=.F.
  _nCurs    - Начальное значение курса (актуально при CURR_CURS:=.F.)

  Возвращаемое значение: aBase[1] - Значение курса
                         aBase[2] - Множитель для курса
                         aBase[3] - Точность представления
                         aBase[4] - Множитель для валютной суммы

  ПРИМЕЧАНИЕ: CURR_MAIN - Точность представления глобальной валюты
              CURR_KARB - Множитель для глобальной валюты

  ПРИМЕР:     GlobalValuta := 'РУБ'
              CURR_MAIN    := 0
              CURR_KARB    := 100
         *1*
              Для USD  aBase := { 3.7, 1000, 2, 1 }

              Пересчет 10$ в рубли:    RAUND( (10.00*3.7*1000*1)/100, 0 )
              Получим  370 единиц
              При печати денежных документов умножим на множитель,
                  получим:  37000 Руб
              Запись в базе: VSUMMA := 10
                             SUMMA  := 370
              При печати денежных документов умножим на множитель,
                  получим:  37000 Руб
                            10    USD

         *2*
              Для USD  aBase := { 3.0, 1000, 2, 10 }

              Пересчет 50$ в рубли:    RAUND( (5.00*3.0*1000*10)/100, 0 )
              Получим 1500 единиц
              Запись в базе: VSUMMA := 5
                             SUMMA  := 1500
              При печати денежных документов умножим на множитель,
                  получим: 150000 Руб
                           50     USD




*/

FUNCTION InputVCurs
         PARAMETERS  _cValuta, _dDate, _lInput, _nCurs, _lPred
   LOCAL aSet, aSetKeys
   LOCAL nSel := SELECT(), nW := WSELECT()
   LOCAL aSel := { SELECT( "VCURS" ), SELECT( "VALUTA" ) }
   LOCAL GetList := {}, bakGetExit, cFilter

   FIELD DATE, VCURS                  IN VCURS
   FIELD MYLTIPLY, ACCURACY,VMYLTIPLY IN VALUTA
   FIELD VALUTA

   IF( ValType( _lInput ) <> 'L', _lInput:=.F., )
   IF( ValType( _nCurs  ) <> 'N', _nCurs:=IF( CURR_CURS, 1, 0 ),    )
   IF( ValType( _lPred ) <> 'L', _lPred:=.T., )

   PRIVATE  aBase := { _nCurs, 1, 2, 1 }


   WSELECT(0)

   BEGIN SEQUENCE
     // проверим открыты ли базы
     IF aSel[1] == 0
       AADD( aBase, 'VCURS' )
       NetUse( 'VCURS', 'VCURS' )
     ENDIF
     IF aSel[2] == 0
       AADD( aBase, 'VALUTA' )
       NetUse( 'VALUTA', 'VALUTA' )
     ENDIF

     SELECT VALUTA

     cFilter := dbFilter()
     dbClearFilter()

     IF !dbSeek( UPPER(_cValuta) )
       IF _lInput
         SayError( "Валюты с кодом:"+_cValuta+" нет в справочнике" )
       ENDIF
       BREAK
     ENDIF
     aBase := { _nCurs, MYLTIPLY, ACCURACY, 1/*VMYLTIPLY*/ }  // Результат

     IF UPPER(_cValuta) == UPPER(GlobalValuta)
       aBase[1] := 1
       BREAK
     ENDIF

     SELECT VCURS
     IF CURR_CURS .OR. aBase[1] == 0
       IF dbSeek( UPPER(_cValuta)+DTOS(_DDate), .T. )
         aBase[1] := VCURS->VCURS  // Курс есть
       ELSE
         IF( UPPER(VALUTA) <> UPPER(_cValuta), dbSkip(-1),IF( _lPred,(dbSkip(-1),IF(UPPER(VALUTA) <> UPPER(_cValuta),dbSkip(),)), ))
         IF UPPER(VALUTA) == UPPER(_cValuta)
           aBase[1] := VCURS->VCURS  // Ближайший куpс
         ENDIF
       ENDIF
     ENDIF
     IF _lInput .AND. ( !FOUND() .OR. !CURR_CURS )
       MakeCursRefer( 'Curs', 'aBase[1]', '_dDate', '_cValuta', 3  )
       aSet := SaveSet()
       SETCOLOR( COL_INPUT )
       ShadowBox( "",04,45,10,77 )
       @ 05,47 SAY "Валюта операций....: "+_cValuta
       @ 06,47 SAY "Национальная валюта: "+GlobalValuta
       @ 07,47 SAY "────────────────────────────"
       @ 08,47 SAY "Курс ("+if(int(aBase[2])==aBase[2],ALLTRIM(STR(aBase[2],6)),ALLTRIM(STR(aBase[2],6,2)))+" "+;
       LOWER(GlobalValuta)+" за 1 "+LOWER(_cValuta)+"):"
       @ 09, 47 REFER 'Curs' GET aBase[1] PICTURE "9999999.99999"  VALID aBase[1]>0
       SET CURSOR ON
       bakGetExit := ReadExit(.T.)
       aSetKeys := SaveSetKey()
       READ
       RestSet(aSet)
       RestSetKey(aSetKeys)
       ReadExit(bakGetExit)
       IF LASTKEY() <> K_ESC .AND. aBase[1] <> 0
         IF  CURR_CURS
           // запись в базу
           IF dbSeek( UPPER(_cValuta)+DTOS(_DDate) )
             PutNetRepl( { _cValuta, _dDate, aBase[1] } )
           ELSE
             PutNetAdd( { _cValuta, _dDate, aBase[1] } )
           ENDIF
         ENDIF
       ELSE
         aBase[1] := 0
       ENDIF
     ENDIF

   RECOVER

   END SEQUENCE

   IF !EMPTY(cFilter)
     VALUTA->(dbSetFilter(&("{||"+cFilter+"}"),cFilter))
   ENDIF

   IF aSel[1] == 0
       VCURS->( dbCloseArea() )
   ENDIF
   IF aSel[2] == 0
       VALUTA->( dbCloseArea() )
   ENDIF
   SELECT( nSel )
   WSELECT( nW )
RETURN ( aBase )

//
PROCEDURE MakeCursRefer( cRefer, cDest, dDate, cValuta, nTypeRefer, cHelp )

  cRefer     := IF( ValType(cRefer)=="C",     cRefer,    "Curs" )
  nTypeRefer := IF( ValType(nTypeRefer)=="N", nTypeRefer, 1     )
  cHelp:=IF(cHelp=NIL,"F2:Справочник курсов",cHelp)
  IF( ValType( dDate ) == 'D', dDate := DTOC(dDate), )

  MakeRefer( cRefer, 'СПРАВОЧНИК КУРСОВ ВАЛЮТ', nTypeRefer, ;
             {'Валюта','Дата','Курс'}, {3,35,15},      ;
             COL_REFER, {'VCURS'}, {cDest}, 'UPPER('+cValuta+'+DTOS('+dDate+'))', ;
             {FIELDBLOCK('VALUTA'),FIELDBLOCK('DATE'),FIELDBLOCK('VCURS')},             ;
            {{'','Код?','VALUTA','TRIM(UPPER(aIn[1]))','@K','!EMPTY(aIn[1])'}},;
            {{'Код валюты.................: ','Valuta'},;
             {'Дата установки курса.......: ','Date'  },;
             {'Курс к основной валюте.... : ','VCurs' } ;
            },;
             ,,,,,,,,,cHelp  )
RETURN


PROCEDURE Hot_VCurs()
   STATIC nTop    := 4, ;
          nCol    := 19
   LOCAL aSet, aSetKey := SaveSetKey(),;
         lOpen := ( SELECT('VCURS') == 0 ), nSel:= SELECT()
   LOCAL cHead:=' СПРАВОЧНИК КУРСОВ ВАЛЮТ '
   LOCAL cColHead:={;
                    'Валюта   Дата       Курс     ' }
*                     XXX   XX/XX/XX 123456.123456
*                    0123456789012345678901234567890
*

   LOCAL aBlockCols := { { {|| FIELD->VALUTA}, 01 },;
                         { {|| FIELD->DATE  }, 07 },;
                         { {|| FIELD->VCURS }, 16 } ;
                       }

   LOCAL nUniMode:=2
   LOCAL aSortSeek:={;
         {'По валютам и датам',;
                     {'Код валюты.:',;
                      'Дата.......:'},{'VALUTA','DATE'},;
          "UPPER(aIn[1])+DTOS(aIn[2])",{'XXX','@D 99/99/99'} },;
         {'По датам и валютам',;
                     {'Дата.......:',;
                      'Код валюты.:'},{'DATE','VALUTA'},;
          "DTOS(aIn[1])+UPPER(aIn[2])",{'@D 99/99/99',"XXX"} } ;
         }
   LOCAL aPHeads:={'СПРАВОЧНИК КУРСОВ ВАЛЮТ','Код','Дата','Курс'}
   LOCAL nW, nOldW := WSELECT(), bKey := SETKEY( K_ALT_V, )
   WSELECT(0)
   aSet := SaveSet()

   Help_Code := "Hot_091"

   BEGIN SEQUENCE

     IF lOpen .AND. !M_Open_Base( {'VCURS'} )
       BREAK
     ENDIF
     SELECT VCURS
     nW := NewWindow(nTop,nCol, nTop+15, 32,cHead,2,.T.,, COL_BROWSE)
     ScrTitul( 24, 'Tab:Занести в поле ввода' )
     SETKEY( K_F8,  {|| NIL } )
     SETKEY( K_F9,  {|| NIL } )
     SETKEY( K_TAB, {|| Get_Curs(), 0 } )
     InitList(1,17,cColHead,aBlockCols,,,,;
         ,,,nUniMode,,,aSortSeek,aPHeads,,,,,,0)
     nCol := WCOL()
   END SEQUENCE
   #ifdef __HARBOUR__
   WCLOSE()
   #endif
   IF lOpen
     M_Close_Base( {'VCURS'} )
   ENDIF
   SELECT( nSel )
   SETKEY( K_ALT_V, bKey )
   WSELECT(0)
   RestSet(aSet)
   RestSetKey(aSetKey)
   
   WSELECT(nOldW)
   CLEAR TYPEAHEAD
   SETLASTKEY(0)
RETURN

STATIC PROCEDURE Get_Curs()
  LOCAL oGet := GetActive(),;
        nCurs := VCURS->VCURS

  If ( oGet != NIL .AND. oGet:type="N" .AND. nCurs <> 0 )
           //If (At('.',oGet:Buffer) == 0) && Значит число целое
           //   If Len( AllTrim(Str(Round(Val(strout),0),13,0)) ) <= Len(oGet:buffer)
           //      oGet:VarPut( Round(Val(strout),0) )
           //   EndIF
           //Else
     //If Len( AllTrim(Str(Val(strout),17,Len(oGet:buffer)-oGet:decPos)) ) <= Len(oGet:buffer)
       oGet:VarPut(  nCurs )
     //EndIF
  EndIf
RETURN

