Форум » Для флейма » Курсы ЦБ РФ на дату » Ответить

Курсы ЦБ РФ на дату

Haz: потребовалось часто и быстро дергать курсы валют с ЦБ РФ , за пару часов написал функцию. Может кому сгодиться на оригинальность не претендую , но работает . Возвращает массив значений на дату . [pre2] FUNC GetCBR( dDate) LOCAL oHttp, cHtml, oNode, oDoc, oVal, oIterator, oCurrent LOCAL aArray := {} LOCAL cNumCode, cCharCode ,cNominal, cName, cValue LOCAL aCur := {} LOCAL cDate := StrZero(Day( dDate ),2,0) + "/" + StrZero(month( dDate ),2,0) + "/" + StrZero(year( dDate ),4,0) oHttp := TIpClientHttp():new( "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + cDate ) IF ! oHttp:open() MsgBox( "Connection error:", oHttp:lastErrorMessage() ) RETURN {} ENDIF cHtml := oHttp:readAll() oHttp:close() oDoc := TXMLDocument():New( cHtml, 8 ) // см. hbxml.ch IF oDoc:nError != 0 MsgBox( "xml file parsing error " + hb_ntos( oDoc:nError ) ) RETURN {} ENDIF oVal := oDoc:findfirst( "Valute" ) IF oVal == NIL MsgBox( "no Valute found" ) RETURN {} ENDIF DO WHILE .T. oIterator := TXMLIterator():New( oVal ) DO WHILE .T. oCurrent := oIterator:Next() IF oCurrent == NIL EXIT ELSE switch oCurrent:cName case "CharCode" cCharCode := oCurrent:cData exit case "NumCode" cNumCode := oCurrent:cData exit case "Nominal" cNominal := oCurrent:cData exit case "Name" cName := oCurrent:cData exit case "Value" cValue := CharRepl(",", oCurrent:cData, ".") exit end switch ENDIF ENDDO AAdd(aCur, {cCharCode, cNumCode, Val(cNominal), cName, Val(cValue)} ) oVal := oDoc:findnext() IF oVal == NIL EXIT ENDIF ENDDO RETURN aCur [/pre2]

Ответов - 30, стр: 1 2 All

SergKis: PS Потерял ф-ю [pre2] *----------------------------------------------------------------------------* FUNC TxtWidth( cText, cFontName, nFontSize, cChr ) // get the width of the text *----------------------------------------------------------------------------* LOCAL hFont, nWidth LOCAL lFont := ! HB_ISNUMERIC(cFontName) DEFAULT cChr := 'A' IF VALTYPE( cText ) == 'N' cText := REPLICATE( cChr, cText ) ENDIF DEFAULT cText := REPLICATE( cChr, 2 ), ; cFontName := _HMG_DefaultFontName, ; nFontSize := _HMG_DefaultFontSize If lFont; hFont := InitFont( cFontName, nFontSize ) Else ; hFont := cFontName EndIf nWidth := GetTextWidth( 0, cText + cChr, hFont ) If lFont; DeleteObject( hFont ) EndIf RETURN nWidth Увидел ошибки tsbrowse.ch #xcommand @ <row>,<col> TBROWSE <name> ; ... [ <load: LOADFIELEDS> ] ; ... h_tsbrowse.prg FUNCTION _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; ... DEFINE COLUMN oCol DATA 'hb_ntos(iif( IndexOrd() > 0, ORDKEYNO(), RecNo() ))' ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH TxtWidth(6) ; PICTURE '9999999' ; MOVE 0 ; DBLCURSOR ; NAME ORDKEYNO ... [/pre2]

Andrey: SergKis пишет: Изменения ch файла показаны на версию Минигуи 2.07. prg файл взял от hmg 20.01 и наложил из своей версии А почему эти изменения нельзя добавить в основную версию МиниГуи ? Это же всем тоже будет удобно.

SergKis: Andrey пишет А почему эти изменения нельзя добавить в основную версию МиниГуи ? Повторю, у меня нет и не будет bcc 5.8, потому последние hmg только скачиваю. Могу сделать, отладить в версию hmg 19.09 вместе с примером


SergKis: SergKis пишет Могу сделать, отладить в версию hmg 19.09 вместе с примером Тут для hmg 19.09, если интересно https://TransFiles.ru/ff1ig

SergKis: PS В CBru.prg надо поправить (в моей версии объект дает :ClientHeight уже без :StatusBar:Height)[pre2] nW := oWnd:ClientWidth - nX * 2 nH := oWnd:ClientHeight - nY - oWnd:StatusBar:Height ... [/pre2]

Andrey: SergKis пишет: Повторю, у меня нет и не будет bcc 5.8, потому последние hmg только скачиваю. Могу сделать, отладить в версию hmg 19.09 вместе с примером Так я беру и правлю пути под BCC 5.5.1, и всех делов то... Под bcc 5.8 у меня тоже не всё компилирует, сборщик ресурсов глючит. SergKis пишет: Тут для hmg 19.09, если интересно Конечно интересно. Странно, под 20.01 (Update 3) не работает... Собрал и вылет с ошибкой:[pre2] Error BASE/1066 Argument error: conditional Args: [1] = U --------------------------------- Stack Trace --------------------------------- Called from TSBROWSE:MOUSEMOVE(9574) in module: h_tbrowse.prg Called from TCONTROL:HANDLEEVENT(913) in module: TControl.prg Called from TSBROWSE:HANDLEEVENT(8687) in module: h_tbrowse.prg Called from EVENTS(95) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1494) in module: h_windows.prg Called from DOMETHOD(5379) in module: h_controlmisc.prg Called from MAIN(127) in module: CBru.prg [/pre2] А понял в чём ошибка. Добавил в проект h_tbrowse.prg и всё заработало... А в стандартный МиниГуи добавить нельзя эти изменения из h_tbrowse.prg ? Григорий, посмотри пожалуйста разницу в h_tbrowse.prg !

gfilatov2002: Andrey пишет: в стандартный МиниГуи добавить нельзя эти изменения из h_tbrowse.prg ? Добавил эти изменения, за исключением обработки символов ";" и "\" в заголовках и персональных установок для Tbrowse, которые есть в коде. Собрал этот пример - работает (и выглядит) идентично оригиналу.

SergKis: gfilatov2002 пишет Добавил эти изменения Поправить надо[pre2] Function _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight,; ... oBrw:InsColumn( nColNumber, oCol ) oBrw:nCell := nColNumber + 1 oBrw:nFreeze := nColNumber oBrw:lLockFreeze := .T. IF HB_ISNUMERIC(nW) .and. nW > 0 oBrw:GetColumn(nColNumber):nWidth := nW ENDIF ... [/pre2]

gfilatov2002: SergKis пишет: Поправить надо Поправил. Благодарю за помощь

Andrey: gfilatov2002 пишет: Собрал этот пример - работает (и выглядит) идентично оригиналу. Классно ! Ждем с нетерпением новую версию !



полная версия страницы