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

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

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

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]

Ответов - 46, стр: 1 2 3 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 пишет: Собрал этот пример - работает (и выглядит) идентично оригиналу. Классно ! Ждем с нетерпением новую версию !

SergKis: Haz пишет Добавь к :GetColumn("Name"):cPicture := "@R " + Replicate("X", 50) именно @R c пробелом(иногда и по два и более делаю) , будет отступ от вертикальной линии ЗЫ я такими шаблонами вложенность строк в структурах показываю ... для показа шаблон со сдвигом, в :prevedit меняю на обычный, в :editexit восстанавливаю сдвиг. Сам сдвиг храниться в спец поле indent, количество пробелов в шаблоне равно indent*2 Попробовал использовать Picture "@R " + Replicate("X", 50) с заменой, как то не зашло, т.к. picture почти нигде не задаю (на default упор) Вернулся к реализации с пробелами, но залез в CLASS TsBrowse, ввел переменную, поправил методы [pre2] DATA nCellMarginLR // space margin left or right cell ... METHOD DrawHeaders( lFooters ) CLASS TSBrowse ... Local nCellMarginLR, aTmp, cTmp, nK, nN ... IF nAlign != 1 .and. ::nCellMarginLR != NIL nCellMarginLR := If( Valtype( ::nCellMarginLR ) == "B", Eval( ::nCellMarginLR, nJ, Self, oColumn, nAlign, 1 ), ::nCellMarginLR ) IF HB_ISNUMERIC( nCellMarginLR ) .and. nCellMarginLR > 0 IF lMultiLine aTmp := hb_ATokens(uData, CRLF) cHeading := '' nN := Len(aTmp) FOR nK := 1 TO nN cTmp := aTmp[ nK ] IF nAlign == 0 ; cTmp := space( nCellMarginLR ) + cTmp ELSEIF nAlign == 2 ; cTmp += space( nCellMarginLR ) ENDIF cHeading += cTmp + iif( nK == nN, "", CRLF ) NEXT ELSE IF nAlign == 0 ; cHeading := space( nCellMarginLR ) + cHeading ELSEIF nAlign == 2 ; cHeading += space( nCellMarginLR ) ENDIF ENDIF ENDIF ENDIF TSDrawCell( hWnd, ; // 1 hDC, ; // 2 0, ; // 3 nStartCol, ; // 4 aColSizes[ nJ ] + nDeltaLen, ; // 5 cHeading, ; // 6 ... If ::lFooting .and. ::lDrawFooters ... IF nAlign != 1 .and. HB_ISCHAR(cFooting) .and. ::nCellMarginLR != NIL nCellMarginLR := If( Valtype( ::nCellMarginLR ) == "B", Eval( ::nCellMarginLR, nJ, Self, oColumn, nAlign, 2 ), ::nCellMarginLR ) IF HB_ISNUMERIC( nCellMarginLR ) .and. nCellMarginLR > 0 IF lMultiLine aTmp := hb_ATokens(uData, CRLF) cFooting := '' nN := Len(aTmp) FOR nK := 1 TO nN cTmp := aTmp[ nK ] IF nAlign == 0 ; cTmp := space( nCellMarginLR ) + cTmp ELSEIF nAlign == 2 ; cTmp += space( nCellMarginLR ) ENDIF cFooting += cTmp + iif( nK == nN, "", CRLF ) NEXT ELSE IF nAlign == 0 ; cFooting := space( nCellMarginLR ) + cFooting ELSEIF nAlign == 2 ; cFooting += space( nCellMarginLR ) ENDIF ENDIF ENDIF ENDIF TSDrawCell( hWnd, ; // 1 hDC, ; // 2 ::nRowCount(), ; // 3 nStartCol, ; // 4 aColSizes[nJ] + nDeltaLen, ; // 5 cFooting, ; // 6 ... METHOD DrawLine( xRow ) CLASS TSBrowse ... Local nCellMarginLR, aTmp, cTmp, nK, nN ... IF nAlign != 1 .and. ::nCellMarginLR != NIL nCellMarginLR := If( Valtype( ::nCellMarginLR ) == "B", Eval( ::nCellMarginLR, nJ, Self, oColumn, nAlign, 0 ), ::nCellMarginLR ) IF HB_ISNUMERIC( nCellMarginLR ) .and. nCellMarginLR > 0 IF lMultiLine aTmp := hb_ATokens(uData, CRLF) uData := '' nN := Len(aTmp) FOR nK := 1 TO nN cTmp := aTmp[ nK ] IF nAlign == 0 ; cTmp := space( nCellMarginLR ) + cTmp ELSEIF nAlign == 2 ; cTmp += space( nCellMarginLR ) ENDIF uData += cTmp + iif( nK == nN, "", CRLF ) NEXT ELSE IF nAlign == 0 ; uData := space( nCellMarginLR ) + uData ELSEIF nAlign == 2 ; uData += space( nCellMarginLR ) ENDIF ENDIF ENDIF ENDIF TSDrawCell( hWnd, ; // 1 hDC, ; // 2 xRow, ; // 3 nStartCol , ; // 4 aColSizes[ nJ ] + nDeltaLen, ; // 5 uData, ; // 6 ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... Local nCellMarginLR, aTmp, cTmp, nK, nN ... IF nAlign != 1 .and. ::nCellMarginLR != NIL nCellMarginLR := If( Valtype( ::nCellMarginLR ) == "B", Eval( ::nCellMarginLR, nJ, Self, oColumn, nAlign, 0 ), ::nCellMarginLR ) IF HB_ISNUMERIC( nCellMarginLR ) .and. nCellMarginLR > 0 IF lMulti aTmp := hb_ATokens(uData, CRLF) uData := '' nN := Len(aTmp) FOR nK := 1 TO nN cTmp := aTmp[ nK ] IF nAlign == 0 ; cTmp := space( nCellMarginLR ) + cTmp ELSEIF nAlign == 2 ; cTmp += space( nCellMarginLR ) ENDIF uData += cTmp + iif( nK == nN, "", CRLF ) NEXT ELSE IF nAlign == 0 ; uData := space( nCellMarginLR ) + uData ELSEIF nAlign == 2 ; uData += space( nCellMarginLR ) ENDIF ENDIF ENDIF ENDIF TSDrawCell( hWnd, ; // 1 hDC, ; // 2 nRowPos, ; // 3 nStartCol, ; // 4 aColSizes[ nJ ] + nDeltaLen, ; // 5 uData, ; // 6 ... [/pre2] Если :nCellMarginLR задан блоком кода, то передаются параметры в него - номер колонки - объект тсб oBrw - объект колонки - и тип вызова 0 - линия тсб ( :DrawLine(), :DrawSelect() ) 1 - Header ( :DrawHeader() ) 2 - Footer ( :DrawFooter() ) Eval( ::nCellMarginLR, nJ, Self, oColumn, nAlign, 0 ) Если возвращает число пробелов > 0, то делается margin Left or Right Попробовал в простом примере, без блока - работает и по мне, удобно в использовании.

SergKis: PS В предпросмотре ровненько показывает, как и в редакторе, а включение в тему и текст прыгает тудой-сюдой.

Haz: SergKis пишет: залез в CLASS TsBrowse, ввел переменную, поправил методы Сергей. Давно тоже хотел зашить в методы колонки. Правда реализация через блоки показалась слишком сложной. Пошёл по пути пикчи на основании значения спец поля. Если и вводить переменную то в клас колонки, при этом учитывая что тип может быть не только символьный. А тут кроме пикчи в голову ничего не приходит Ps. Кстати не нравится что значения числовых полей прилипают вплотную к правой линии.... И тут тоже пикчей дополняют пробелы

SergKis: Haz пишет Кстати не нравится что значения числовых полей прилипают вплотную к правой линии.... Игорь, мне тоже не нравится такое прилипание еще и символьных (другие тоже) полей вплотную к левой линии. Сделанная переменная на класс это, в первую очередь, исправить прижимание к границе\линии, задав 1 или 2 получается приличный вид всех колонок с DT_LEFT, DT_RIGHT. Особенно это заметно при задании цвета отрицательным значением, т.е. обводка ячеек линией. Пока такой пример Tsb_array_2\demo3.prg и пробовал. Если и вводить переменную то в клас колонки, при этом учитывая что тип может быть не только символьный Тоже была такая мысль, но решил ограничится, пока, переменной класса, передавая в блок параметры oColumn, nAlign и тип вызова ( 0 для строки, 1 header, 2 footer ). Т.е. для колонки с опред. именем и nAlign можно вернуть числовое нужное смещение, для всех других, к примеру 1 для отступа от линии.

SergKis: PS Сделал эти изменения только в своей версии. Надо такое в hmg или усиливать по колонкам, а может, вообще, лишнее ?

Haz: SergKis пишет: Надо такое в hmg или усиливать по колонкам, а может, вообще, лишнее ? По колонками может пригодиться. С мультилайном мысль интересная, её шаблоном не сделать. И может слева и права иметь возможность дополнять не только пробелами, можно использовать псевдографику для рисования псевдо дерева к примеру. То есть блок выдает не число, а строку. Я не занимался этим вопросом серьёзно, для решения локальной задачи играл с шаблонами т. к. они независимы от типа данных. Была даже мысль добавить переменные cLPicture и cRPicture, для добавления стандартного слева справа перед применением. Потом компания купила Битрикс и пришлось с головой уйти в синхронизацию данных с этой витриной посредством rest запросов и написанием своего вэб сервера. Поэтому бросил. Может тут все выскажут свое мнение? Мне все же как-то с шаблонами справа и слева через блоки больше нравится, универсальное, но и твоё предложение тоже полезно

SergKis: Haz пишет И может слева и права иметь возможность дополнять не только пробелами, можно использовать псевдографику для рисования псевдо дерева к примеру. Добавить проверку возврата на строку и добавлять ее, это реально и просто. Делать переменные в класс колонки, пока не знаю, может в будущем. Тогда переменная из tsbrowse класса определяет глобальную установку отступа колонок DT_LEFT, DT_RIGHT, если задано в классе колонки, то подменять общее значение на значение полученное из колонки. Но, думается, решить это можно для колонки и от переменной из tsbrowse класса

Haz: SergKis пишет: Но, думается, решить это можно для колонки и от переменной из tsbrowse класса Да, согласен. Можно так для строкового значения сделать. В процессе использования придёт понимание чего не хватает

SergKis: Haz Вот что получилось hmg 20.04. Изменения тсб [pre2] CLASS TSBrowse FROM TControl ... DATA nCellMarginLR // space margin left or right cell ... If HB_ISNUMERIC( oColumn:nHLineStyle ) nLineStyle := oColumn:nHLineStyle EndIf IF nAlign != DT_CENTER .and. ::nCellMarginLR != NIL cHeading := ::CellMarginLeftRight( nJ, cHeading, oColumn, nAlign, lMultiLine, 0 ) ENDIF TSDrawCell( hWnd, ; // 1 ... If ::lFooting .and. ::lDrawFooters ... If HB_ISNUMERIC( oColumn:nFLineStyle ) nLineStyle := oColumn:nFLineStyle EndIf IF nAlign != DT_CENTER .and. ::nCellMarginLR != NIL cFooting := ::CellMarginLeftRight( nJ, cFooting, oColumn, nAlign, lMultiLine, 0 ) ENDIF TSDrawCell( hWnd, ; // 1 ... METHOD DrawLine( xRow ) CLASS TSBrowse ... Else l3DText := nClr3dL := nClr3dS := Nil EndIf IF nAlign != DT_CENTER .and. ::nCellMarginLR != NIL uData := ::CellMarginLeftRight( nJ, uData, oColumn, nAlign, lMultiLine, 0 ) ENDIF TSDrawCell( hWnd, ; // 1 ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... If lDrawCell IF nAlign != DT_CENTER .and. ::nCellMarginLR != NIL uData := ::CellMarginLeftRight( nJ, uData, oColumn, nAlign, lMulti, 0 ) ENDIF lDraw := TSDrawCell( hWnd, ; // 1 ... METHOD CellMarginLeftRight( nJ, cData, oColumn, nAlign, lMultiLine, nOut ) CLASS TSBrowse Local nCellMarginLR, aTmp, cTmp, nK, nN, cBuf Local uTmp := ::nCellMarginLR nCellMarginLR := If( Valtype( uTmp ) == "B", Eval( uTmp, nJ, Self, oColumn, nAlign, nOut ), uTmp ) IF HB_ISNUMERIC ( nCellMarginLR ) ; cBuf := space( nCellMarginLR ) ELSEIF HB_ISCHAR( nCellMarginLR ) ; cBuf := nCellMarginLR ENDIF IF HB_ISCHAR( cBuf ) .and. Len( cBuf ) > 0 DEFAULT cData := "" IF lMultiLine aTmp := hb_ATokens( cData, CRLF ) cData := '' nN := Len( aTmp ) FOR nK := 1 TO nN cTmp := aTmp[ nK ] IF nAlign == DT_LEFT ; cTmp := cBuf + cTmp ELSEIF nAlign == DT_RIGHT ; cTmp += cBuf ENDIF cData += cTmp + iif( nK == nN, "", CRLF ) NEXT ELSE IF nAlign == DT_LEFT ; cData := cBuf + cData ELSEIF nAlign == DT_RIGHT ; cData += cBuf ENDIF ENDIF ENDIF RETURN cData [/pre2] Пример demo5.prg и h_tbrowse.prg тут https://TransFiles.ru/zkhi1

SergKis: PS Запуск demo5.exe без параметров - работа с массивом demo5.exe * работа с dbf demo5.exe * 7 работа с dbf только 7 полей

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