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

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

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

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

Dima: Haz

Andrey: Сделай этот пример для МиниГуи ! Будет классно для всех.

Haz: Andrey пишет: Сделай этот пример для МиниГуи ! Сделаю сегодня

rvu: Я в свое время делал нечто подобное, поэтому могу оценить. Красиво!

Haz: Андрей: Сделай этот пример для МиниГуи ! где то так [pre2] #include "minigui.ch" #include "TSBrowse.ch" REQUEST DBFCDX Func Main() LOCAL aStr := {} LOCAL cDbf := "Rates" LOCAL n := 0 LOCAL oWnd SET OOP ON SET DATE FORMAT 'DD.MM.YYYY' rddSetDefault( 'DBFCDX' ) IF !hb_FileExists( cDbf + ".dbf" ) AAdd( aStr, { 'DATE', 'D', 8, 0 } ) AAdd( aStr, { 'CHARCODE', 'C', 3, 0 } ) AAdd( aStr, { 'NUMCODE', 'C', 3, 2 } ) AAdd( aStr, { 'NAME', 'C', 50, 0 } ) AAdd( aStr, { 'NOMINAL', 'N', 5, 0 } ) AAdd( aStr, { 'VALUE', 'N', 12, 4 } ) dbCreate( cDbf + ".dbf", aStr ) ENDIF USE ( cDbf + ".dbf" ) ALIAS "RATES" EXCL NEW IF hb_FileExists( cDbf + ".cdx" ) SET INDEX TO ( cDbf + ".cdx") ELSE INDEX ON DATE TAG "DATE" TO ( cDbf + ".cdx") END RATES->(OrdSetFocus("DATE")) DEFINE WINDOW Form_0 ; At 0, 0 ; WIDTH 510 ; HEIGHT 700 ; TITLE "Exchange rate of the Central Bank of the Russian Federation" ; MAIN ; NOMAXIMIZE NOSIZE ; ON RELEASE dbCloseArea( "RATES" ) oWnd := ThisWindow.Object DEFINE STATUSBAR STATUSITEM "" WIDTH 230 FONTCOLOR BLUE END STATUSBAR END WINDOW DEFINE LABEL Label_1 PARENT Form_0 ROW 7 COL 5 WIDTH 300 HEIGHT 16 FONTNAME 'Arial Narrow' FONTSIZE 9 FONTBOLD TRUE FONTITALIC TRUE FONTCOLOR {0,0,0} VALUE "Exchange rate of the Central Bank of the Russian Federation on:" END LABEL DEFINE DATEPICKER Date_1 PARENT Form_0 ROW 2 COL oWnd:ClientWidth - 105 WIDTH 100 VALUE Date() SHOWNONE .F. FONTNAME 'Arial' FONTSIZE 9 FONTBOLD FALSE FONTITALIC FALSE ON CHANGE { || SetDate( This.Value ) } TABSTOP .F. END DATEPICKER DEFINE TBROWSE oBrw ; AT 30, 1 ; ALIAS "RATES" ; OF Form_0 ; WIDTH oWnd:ClientWidth - 2 ; HEIGHT oWnd:ClientHeight - 30 - oWnd:StatusBar:Height; GRID ; COLORS { CLR_BLACK, CLR_BLUE } ; FONT "MS Sans Serif" ; SIZE 9 :aColSel := {"CHARCODE", "NUMCODE", "NAME", "NOMINAL", "VALUE"} :LoadFields( TRUE ) :lCellBrw := TRUE :nHeightCell := 20 :nWheelLines := 1 :nHeightHead := 25 :SetColor( { 11 }, { { || Rgb( 255, 255, 255 ) } } ) :nClrLine := RGB(180,180,180)//COLOR_GRID :lNoPopUp := TRUE :hBrush := CreateSolidBrush(255,255,240) AEval( oBrw:aColumns, {| oCol| oCol:lFixLite := TRUE } ) :SetColor( { 2 }, { { || RGB(255,255,240) } } ) :SetColor( { 5 }, { { || RGB(0,0,0) } } ) :SetColor( { 6 }, { { |a,b,c| IF( c:nCell == b, -CLR_HRED , -RGB(128,225,225) ) } } ) :SetColor( { 12 }, { { |a,b,c| IF( c:nCell == b, -RGB(128,225,225) , -RGB(128,225,225) ) } } ) :SetColor( { 11 }, { { || RGB(0,0,0) } } ) :SetAppendMode( FALSE ) :SetDeleteMode( FALSE ) :SetColSize( "CharCode", 40) :GetColumn( "CharCode" ):cHeading := "Char" + CRLF + "Code" :GetColumn( "CharCode"):lEdit := FALSE :GetColumn( "CharCode"):nAlign := DT_CENTER :GetColumn( "CharCode"):cPicture := "@R XXX " :SetColSize( "NumCode", 40) :GetColumn( "NumCode" ):cHeading := "Num" + CRLF + "Code" :GetColumn( "NumCode"):lEdit := FALSE :GetColumn( "NumCode"):nAlign := DT_CENTER :GetColumn( "NumCode"):cPicture := "@R XXX " :SetColSize( "Name", 300) :GetColumn( "Name" ):cHeading := "Name" :GetColumn( "Name"):lEdit := FALSE :GetColumn( "Name"):nAlign := DT_LEFT :GetColumn( "Name"):cPicture := "@R " + Replicate("X", 50) + " " :SetColSize( "Nominal", 50) :GetColumn( "Nominal" ):cHeading := "Nominal" :GetColumn( "Nominal"):lEdit := FALSE :GetColumn( "Nominal"):nAlign := DT_CENTER :GetColumn( "Nominal"):cPicture := "@R 99999 " :SetColSize( "Value", 50) :GetColumn( "Value" ):cHeading := "Value" :GetColumn( "Value"):lEdit := FALSE :GetColumn( "Value"):nAlign := DT_CENTER :GetColumn( "Value"):cPicture := "@R 999.9999 " END TBROWSE SetDate( Date() ) Form_0.Center Form_0.Activate RETURN NIL FUNC SetDate( dDate ) LOCAL aArray := {} Rates->(OrdScope(0, NIL )) Rates->(OrdScope(1, NIL )) IF !Rates->(dbSeek(dDate)) aArray := GetCBR( dDate ) IF !Empty(aArray) AEval( aArray, {|e| Rates->(DBAppend()),; Rates->Date := dDate,; Rates->CHARCODE := e[1],; Rates->NUMCODE := e[2],; Rates->NOMINAL := e[3],; Rates->NAME := e[4],; Rates->VALUE := e[5] ; } ) END END Rates->(OrdScope(0, dDate )) Rates->(OrdScope(1, dDate )) Rates->(dbGoTop()) oBrw:Reset() RETURN nil FUNC GetCBR( dDate) LOCAL oHttp, cHtml, oNode, oDoc, oVal, oIterator, oCurrent LOCAL cNumCode, cCharCode ,cNominal, cName, cValue LOCAL aArray := {} 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() Form_0.StatusBar.Item(2) := "Connection error: " + oHttp:lastErrorMessage() RETURN {} ENDIF Form_0.StatusBar.Item(2) := "Connection established" cHtml := oHttp:readAll() oHttp:close() oDoc := TXMLDocument():New( cHtml, 8 ) // см. hbxml.ch IF oDoc:nError != 0 Form_0.StatusBar.Item(1) := "xml parsing error " + hb_ntos( oDoc:nError ) RETURN {} ENDIF oVal := oDoc:findfirst( "Valute" ) IF oVal == NIL Form_0.StatusBar.Item(1) := "xml parsing error " + "Key not 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(aArray, {cCharCode, cNumCode, Val(cNominal), cName, Val(cValue)} ) oVal := oDoc:findnext() IF oVal == NIL EXIT ENDIF ENDDO IF !Empty(aArray) Form_0.StatusBar.Item(1) := "Data successfully received" END RETURN aArray [/pre2]

rvu: Надо, чтобы включили в примеры.

SergKis: Игорь, пример оч. хороший ! СПАСИБО ! Перенес в свою версию на ура. Вот что получилось, в тек. версии hmg должно работать тоже, кроме ";" в HEADERS. Текст совсем короткий [pre2] #include "minigui.ch" #include "TSBrowse.ch" REQUEST DBFCDX REQUEST HB_CODEPAGE_LV866 Function Main() LOCAL aStr := {} LOCAL cDbf := "Rates" LOCAL n := 0 LOCAL oWnd, nY, nX, nW, nH hb_cdpSelect("LV866") ; hb_setTermCP("LV866") SET OOP ON SET CENTURY ON SET DATE FORMAT 'DD.MM.YYYY' rddSetDefault( 'DBFCDX' ) IF !hb_FileExists( cDbf + ".dbf" ) AAdd( aStr, { 'DATE', 'D', 8, 0 } ) AAdd( aStr, { 'CHARCODE', 'C', 3, 0 } ) AAdd( aStr, { 'NUMCODE', 'C', 3, 2 } ) AAdd( aStr, { 'NAME', 'C', 50, 0 } ) AAdd( aStr, { 'NOMINAL', 'N', 5, 0 } ) AAdd( aStr, { 'VALUE', 'N', 12, 4 } ) dbCreate( cDbf + ".dbf", aStr ) ENDIF USE ( cDbf + ".dbf" ) ALIAS "RATES" EXCL NEW IF hb_FileExists( cDbf + ".cdx" ) SET INDEX TO ( cDbf + ".cdx") ELSE INDEX ON DATE TAG "DATE" TO ( cDbf + ".cdx") END RATES->(OrdSetFocus("DATE")) DEFINE WINDOW Form_0 ; At 0, 0 ; WIDTH 610 ; HEIGHT 700 ; TITLE "Exchange rate of the Central Bank of the Russian Federation" ; MAIN ; NOMAXIMIZE NOSIZE ; ON RELEASE dbCloseArea( "RATES" ) oWnd := ThisWindow.Object DEFINE STATUSBAR BOLD STATUSITEM "" WIDTH 230 // FONTCOLOR BLUE END STATUSBAR ON KEY ESCAPE ACTION ThisWindow.Release DEFINE LABEL Label_1 PARENT Form_0 ROW 7 COL 5 WIDTH 300 HEIGHT 16 FONTNAME 'Arial Narrow' FONTSIZE 9 FONTBOLD TRUE FONTITALIC TRUE FONTCOLOR {0,0,0} VALUE "Exchange rate of the Central Bank of the Russian Federation on:" END LABEL DEFINE DATEPICKER Date_1 PARENT Form_0 ROW 2 COL oWnd:ClientWidth - 105 WIDTH 100 VALUE Date() SHOWNONE .F. FONTNAME 'Arial' FONTSIZE 9 FONTBOLD FALSE FONTITALIC FALSE ON CHANGE { || SetDate( This.Value ) } TABSTOP .F. END DATEPICKER nY := This.Date_1.Row + This.Date_1.Height + 5 nX := 1 nW := oWnd:ClientWidth - nX * 2 nH := oWnd:ClientHeight - nY - oWnd:StatusBar:Height; DEFINE TBROWSE oBrw AT nY, nX ALIAS "RATES" OF Form_0 WIDTH nW HEIGHT nH GRID ; COLORS { CLR_BLACK, CLR_BLUE } ; FONT "MS Sans Serif" SIZE 9 ; HEADERS {"Char;Code", "Num;Code", "Name", "Nominal", "Value" } ; COLUMNS {"CHARCODE" , "NUMCODE" , "NAME", "NOMINAL", "VALUE" } :LoadFields( FALSE ) :nHeightCell += 4 :nWheelLines := 1 :SetColor( { 11 }, { { || Rgb( 255, 255, 255 ) } } ) :nClrLine := RGB(180,180,180) // COLOR_GRID :lNoPopUp := TRUE :hBrush := CreateSolidBrush(255,255,240) AEval( oBrw:aColumns, {| oCol| oCol:lFixLite := TRUE, ; oCol:nAlign := DT_CENTER } ) :GetColumn("Name"):nAlign := DT_LEFT :GetColumn("Name"):nWidth := 300 :SetColor( { 2 }, { { || RGB(255,255,240) } } ) :SetColor( { 5 }, { { || RGB(0,0,0) } } ) :SetColor( { 6 }, { { |a,b,c| IF( c:nCell == b, -CLR_HRED , -RGB(128,225,225) ) } } ) :SetColor( { 12 }, { { |a,b,c| IF( c:nCell == b, -RGB(128,225,225) , -RGB(128,225,225) ) } } ) :SetColor( { 11 }, { { || RGB(0,0,0) } } ) :SetAppendMode( FALSE ) :SetDeleteMode( FALSE ) :AdjColumns() END TBROWSE oBrw:SetNoHoles() SetDate( Date() ) END WINDOW Form_0.Center Form_0.Activate RETURN NIL FUNC SetDate( dDate ) LOCAL aArray := {} Form_0.StatusBar.Item(2) := "... W A I T ..." Rates->(OrdScope(0, NIL )) Rates->(OrdScope(1, NIL )) IF !Rates->(dbSeek(dDate)) aArray := GetCBR( dDate ) IF !Empty(aArray) AEval( aArray, {|e| Rates->(DBAppend()),; Rates->Date := dDate,; Rates->CHARCODE := e[1],; Rates->NUMCODE := e[2],; Rates->NOMINAL := e[3],; Rates->NAME := Dos4W5(e[4], 6),; Rates->VALUE := e[5] ; } ) END END Rates->(OrdScope(0, dDate )) Rates->(OrdScope(1, dDate )) Rates->(dbGoTop()) oBrw:Reset() oBrw:SetFocus() Form_0.StatusBar.Item(2) := " " RETURN nil [/pre2]

Haz: SergKis пишет: Вот что получилось Отлично оптимизировал Добавь к [pre2] :GetColumn("Name"):nAlign := DT_LEFT :GetColumn("Name"):nWidth := 300 :GetColumn("Name"):cPicture := "@R " + Replicate("X", 50) именно @R c пробелом(иногда и по два и более делаю) , будет отступ от вертикальной линии ЗЫ я такими шаблонами вложенность строк в структурах показываю [/pre2]

SergKis: Haz пишет я такими шаблонами вложенность строк в структурах показываю И как ты это делаешь ? меняешь oCol:cPicture налету ? Я в :bDecode от кода строки (или еще от чего) добавляю определенное кол-во space(nN) для сдвига

Haz: SergKis пишет: И как ты это делаешь ? меняешь oCol:cPicture налету ? Да, для показа шаблон со сдвигом, в :prevedit меняю на обычный, в :editexit восстанавливаю сдвиг. Сам сдвиг храниться в спец поле indent, количество пробелов в шаблоне равно indent*2 Сначала тоже дополнял само значение слева пробелами, но потом понял что менять значение не удобно тк в редактирование значение шло с телефона пробелами, а пользователь мог удалить, а мог и нет., и не понять что он ввел

SergKis: Haz пишет Да, для показа шаблон со сдвигом, в :prevedit меняю на обычный, в :editexit восстанавливаю сдвиг. Сам сдвиг храниться в спец поле indent, количество пробелов в шаблоне равно indent*2 OK! Надо тоже переходить на такую схему

Haz: SergKis пишет: шло с телефона пробелами, а Откуда тут с "телефона" не набирал точно, хотя набирал с телефона

Pasha: Мне время от времени приходится выбирать информацию из формата xml, делаю это с помощью класса Александра Кресина. Он есть и в поставке hmg Разбор курсов валют ЦБР выглядел бы так: [pre]Function ScanCBR(cHtml) Local oXml, oCurs Local aCur := {} if (oXml := HXmlDoc():ReadString(cHtml)) # nil .and. (oCurs := oXml:Find("ValCurs")) # nil AEval(oCurs:aItems, {|o| AADD(aCur, {ItmValue(o, "NumCode"), ItmValue(o, "CharCode"), ItmValue(o, "Nominal"), ItmValue(o, "Name"), ItmValue(o, "Value")})}) endif Return aCur Static function ItmValue(oItem, cName) Local oIt1 := oItem:Find(cName) Return if(oIt1#nil.and.len(oIt1:aItems)>0, oIt1:aItems[1], "") [/pre] cHtml - строка, полученная с сайта Центробанка в примере Игоря

SergKis: Pasha пишет Мне время от времени приходится выбирать информацию из формата xml, делаю это с помощью класса Александра Кресина. Он есть и в поставке hmg Тоже использую этот класс и подтверждаю работает предложенный вариант Вот, что получилось у меня (полностью перевел пример на свою lib), включат оба разбора cHtml [pre2] #include "minigui.ch" #include "TSBrowse.ch" REQUEST DBFCDX REQUEST HB_CODEPAGE_LV866 Function Main() LOCAL aStr := {} LOCAL cDbf := "Rates" LOCAL n := 0, cAlias LOCAL oWnd, nY, nX, nW, nH hb_cdpSelect("LV866") ; hb_setTermCP("LV866") SET OOP ON SET CENTURY ON SET DATE FORMAT 'DD.MM.YYYY' rddSetDefault( 'DBFCDX' ) SET FONT TO "MS Sans Serif" , 9 DEFINE FONT Normal FONTNAME _HMG_DefaultFontName SIZE _HMG_DefaultFontSize DEFINE FONT Header FONTNAME "Arial" SIZE _HMG_DefaultFontSize BOLD DEFINE FONT Footer FONTNAME "Arial" SIZE _HMG_DefaultFontSize BOLD IF !hb_FileExists( cDbf + ".dbf" ) AAdd( aStr, { 'DATE', 'D', 8, 0 } ) AAdd( aStr, { 'CHARCODE', 'C', 3, 0 } ) AAdd( aStr, { 'NUMCODE', 'C', 3, 2 } ) AAdd( aStr, { 'NAME', 'C', 50, 0 } ) AAdd( aStr, { 'NOMINAL', 'N', 5, 0 } ) AAdd( aStr, { 'VALUE', 'N', 12, 4 } ) dbCreate( cDbf + ".dbf", aStr ) ENDIF USE ( cDbf + ".dbf" ) ALIAS "RATES" EXCL NEW IF hb_FileExists( cDbf + ".cdx" ) SET INDEX TO ( cDbf + ".cdx") ELSE INDEX ON DTOS(DATE)+CHARCODE TAG "DATE" TO ( cDbf + ".cdx") END cAlias := ALIAS() (cAlias)->( OrdSetFocus("DATE") ) DEFINE WINDOW Form_0 ; At 0, 0 ; WIDTH 710 ; HEIGHT 700 ; TITLE "Exchange rate of the Central Bank of the Russian Federation" ; MAIN ; NOMAXIMIZE NOSIZE ; ON RELEASE dbCloseArea( cAlias ) oWnd := ThisWindow.Object DEFINE STATUSBAR BOLD STATUSITEM "" STATUSITEM "" WIDTH 230 // FONTCOLOR BLUE END STATUSBAR ON KEY ESCAPE ACTION ThisWindow.Release DEFINE LABEL Label_1 ROW 7 COL 5 WIDTH 300 HEIGHT 16 FONTNAME 'Arial Narrow' FONTSIZE 9 FONTBOLD TRUE FONTITALIC TRUE FONTCOLOR {0,0,0} VALUE "Exchange rate of the Central Bank of the Russian Federation on:" END LABEL DEFINE DATEPICKER Date_1 ROW 2 COL oWnd:ClientWidth - 105 WIDTH 100 VALUE Date() SHOWNONE .F. FONTNAME 'Arial' FONTSIZE 9 FONTBOLD FALSE FONTITALIC FALSE ON CHANGE { || SetDate( This.Value ) } TABSTOP .F. END DATEPICKER nY := This.Date_1.Row + This.Date_1.Height + 5 nX := 1 nW := oWnd:ClientWidth - nX * 2 nH := oWnd:ClientHeight - nY //- oWnd:StatusBar:Height; DEFINE TBROWSE oBrw AT nY, nX ALIAS cAlias WIDTH nW HEIGHT nH GRID ; FONT { "Normal", "Header", "Footer" } ; COLORS { CLR_BLACK, CLR_BLUE } ; HEADERS { "Char;Code", "Num;Code", "Name" , "Nominal", "Value" } ; COLSIZES { 40 , 40 , 250 , 50 , 50 } ; PICTURE { , , "@R "+Repl('X',50), , } ; JUSTIFY { DT_CENTER , DT_CENTER , DT_LEFT , DT_CENTER, DT_CENTER } ; COLUMNS { "CHARCODE" , "NUMCODE" , "NAME" , "NOMINAL", "VALUE" } ; COLNAMES { "CHAR" , "NUM" , "NAME" , "NOM" , "VAL" } ; BRUSH { 255, 255, 240 } ; LOADFIELDS FIXED :InsColumn( 1, oColsData( cAlias ):Get('OrdKeyNo') ) // колонку # добавили :GetColumn( 1 ):nWidth := 30 :nCell := 2 :nFreeze := 1 :lLockFreeze := .T. :nHeightFoot := :nHeightCell :nHeightCell += 4 :nClrLine := RGB(180,180,180) // COLOR_GRID // :SetColor( { 11 }, { { || RGB( 255, 255, 255 ) } } ) :SetColor( { 11 }, { { || RGB(0,0,0) } } ) :SetColor( { 2 }, { { || RGB(255,255,240) } } ) :SetColor( { 5 }, { { || RGB(0,0,0) } } ) :SetColor( { 6 }, { { |a,b,c| iif( c:nCell == b, -CLR_HRED , -RGB(128,225,225) ) } } ) :SetColor( { 12 }, { { |a,b,c| iif( c:nCell == b, -RGB(128,225,225), -RGB(128,225,225) ) } } ) :AdjColumns() END TBROWSE oBrw:SetNoHoles() SetDate( Date() ) END WINDOW Form_0.Center Form_0.Activate RETURN NIL FUNC SetDate( dDate ) LOCAL aArray := {} LOCAL cDate := DtoS(dDate) Form_0.StatusBar.Item(2) := "... W A I T ..." Rates->(OrdScope(0, NIL )) Rates->(OrdScope(1, NIL )) IF !Rates->(dbSeek(cDate)) aArray := GetCBR( dDate ) IF !Empty(aArray) AEval( aArray, {|e| Rates->(DBAppend()),; Rates->Date := dDate,; Rates->CHARCODE := e[1],; Rates->NUMCODE := e[2],; Rates->NOMINAL := e[3],; Rates->NAME := Dos4W5(e[4], 6),; Rates->VALUE := e[5] ; } ) END END Rates->(OrdScope(0, cDate )) Rates->(OrdScope(1, cDate )) Rates->(dbGoTop()) oBrw:Reset() oBrw:SetFocus() Form_0.StatusBar.Item(2) := " " RETURN nil FUNC GetCBR( dDate) LOCAL oHttp, cHtml, oNode, oDoc, oVal, oIterator, oCurrent LOCAL cNumCode, cCharCode ,cNominal, cName, cValue LOCAL aArray := {} LOCAL cDate := StrZero(Day( dDate ),2,0) + "/" + StrZero(month( dDate ),2,0) + "/" + StrZero(year( dDate ),4,0) Form_0.StatusBar.Item(1) := " " oHttp := TIpClientHttp():new( "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + cDate ) IF ! oHttp:open() Form_0.StatusBar.Item(2) := "Connection error: " + oHttp:lastErrorMessage() RETURN {} ENDIF Form_0.StatusBar.Item(2) := "Connection established" cHtml := oHttp:readAll() oHttp:close() aArray := ScanCBR( cHtml ) /* Pasha */ // aArray := FindCBR( cHtml ) /* Haz */ IF ! Empty(aArray) Form_0.StatusBar.Item(1) := "Data successfully received" END RETURN aArray FUNC FindCBR( cHtml ) LOCAL oNode, oDoc, oVal, oIterator, oCurrent LOCAL cNumCode, cCharCode ,cNominal, cName, cValue LOCAL aArray := {} oDoc := TXMLDocument():New( cHtml, 8 ) // см. hbxml.ch IF oDoc:nError != 0 Form_0.StatusBar.Item(1) := "xml parsing error " + hb_ntos( oDoc:nError ) RETURN {} ENDIF oVal := oDoc:findfirst( "Valute" ) IF oVal == NIL Form_0.StatusBar.Item(1) := "xml parsing error " + "Key not 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(aArray, {cCharCode, cNumCode, Val(cNominal), cName, Val(cValue)} ) oVal := oDoc:findnext() IF oVal == NIL ; EXIT ENDIF ENDDO RETURN aArray Function ScanCBR( cHtml ) Local oXml, oCurs Local aCur := {} if (oXml := HXmlDoc():ReadString(cHtml)) # nil .and. (oCurs := oXml:Find("ValCurs")) # nil AEval(oCurs:aItems, {|o| AADD(aCur, {ItmValue(o, "NumCode"), ItmValue(o, "CharCode"), ItmValue(o, "Nominal"), ItmValue(o, "Name"), ItmValue(o, "Value")})}) endif Return aCur Static function ItmValue(oItem, cName) Local oIt1 := oItem:Find(cName) Return if(oIt1#nil.and.len(oIt1:aItems)>0, oIt1:aItems[1], "") [/pre2]

Andrey: SergKis пишет: Вот, что получилось у меня (полностью перевел пример на свою lib), включат оба разбора cHtml Не собирается... Отправил проект к тебе Собирал через MiniGUI 20.01 (Update 3)

SergKis: Andrey SergKis пишет:полностью перевел пример на свою lib hmg надо доводить, если надо, конечно ? Сам пример тут https://TransFiles.ru/oymu6

Andrey: SergKis пишет: hmg надо доводить, если надо, конечно ? Надо ! Обязательно ! Потом можно будет доводить этот пример для TsbrowseSaveDbf( oBrw, "fileBrw.obrw" ) TsbrowseRestoreDbf( "fileBrw.obrw", oBrw )

SergKis: Andrey пишет Надо ! Обязательно ! Тогда это самостоятельно, т.к. bcc 5.8 у меня не установлен (и не будет пока) Позже выложу изменения

Andrey: SergKis пишет: Тогда это самостоятельно, т.к. bcc 5.8 у меня не установлен (и не будет пока) Вот такие ошибки вылазят: Harbour 3.2.0dev (r2001311434) Copyright (c) 1999-2020, https://harbour.github.io/ Compiling 'demo.prg'... demo.prg(119) Error E0030 Syntax error "syntax error at 'TBROWSE'" demo.prg(120) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(121) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(122) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(123) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(124) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(125) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(126) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(127) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(129) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(130) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(131) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(132) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(133) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(134) Error E0061 Implicit send operator with no WITH OBJECT in sight demo.prg(135) Error E0010 ENDIF does not match IF 16 errors No code generated.

SergKis: SergKis пишет Позже выложу изменения Выкладываю, но надо иметь ввиду, что сделаны изменения под себя. Изменения ch файла показаны на версию Минигуи 2.07. prg файл взял от hmg 20.01 и наложил из своей версии [pre2] hmg 2.07 ======== tsbrowse.ch ... #xcommand @ <row>,<col> TBROWSE <name> ; [ ID <nId> ] ; [ <dummy1: OF, PARENT, DIALOG> <parent> ] ; [ WIDTH <w> ] ; [ HEIGHT <h> ] ; [ <head: HEAD,HEADER,HEADERS> <aHeaders,...> ] ; [ <sizes: WIDTHS, FIELDSIZES, SIZES, COLSIZES> <aColSizes,...> ] ; [ <format: PICTURE, FORMAT> <aPicture,...> ] ; [ <alias: ALIAS, ITEMS, ARRAY, WORKAREA, RECORDSET, RECSET> <uAlias> ] ; [ FIELDS <Fields,...> ] ; [ <enum: ENUMERATOR> ] ; [ <autosearch: AUTOSEARCH> [ USERSEARCH <uUserSearch> ] ]; [ <autofilter: AUTOFILTER> [ USERFILTER <uUserFilter> ] ]; [ VALUE <value> ] ; [ FONT <fontname> ] ; [ SIZE <fontsize> ] ; [ <bold : BOLD> ] ; [ <italic : ITALIC> ] ; [ <underline : UNDERLINE> ] ; [ <strikeout : STRIKEOUT> ] ; [ TOOLTIP <tooltip> ] ; [ BACKCOLOR <backcolor> ] ; [ FONTCOLOR <fontcolor> ] ; [ <color: COLOR, COLORS> <aColors,...> ] ; [ ON GOTFOCUS <gotfocus> ] ; [ ON CHANGE <uChange> ] ; [ ON LOSTFOCUS <lostfocus> ] ; [ ON DBLCLICK <uLDblClick> ] ; [ <cell: CELL, CELLED, GRID> ] ; [ STYLE <nStyle> ] ; [ <append : APPEND> ] ; [ ON HEADCLICK <aHeadClick> ] ; [ WHEN <uWhen> ] ; [ VALID <aValidFields> ] ; [ VALIDMESSAGES <aValidMessages> ] ; [ MESSAGE <cMsg> ] ; [ READONLY <aReadOnly> ] ; [ <lock: LOCK> ] ; [ <Delete: DELETE> ] ; [ <style: NOLINES> ] ; [ IMAGE <aImages,...> ] ; [ JUSTIFY <aJust> ] ; [ HELPID <helpid> ] ; [ <break: BREAK> ] ; [ <lTransparent: TRANSPARENT> ] ; [ SELECTOR <uSelector> ] ; [ <lEditable: EDIT, EDITABLE> ] ; [ <lAutoCol: AUTOCOLS> ] ; [ <colsel:COLUMNS, INCLUDE> <aColSel,...> ] ; [ <names: NAMES,COLNAMES> <aNames> ] ; [ <foot: FOOT,FOOTER,FOOTERS> <aFooters> ] ; [ <keyno: NUMBER,COLKEYNO,COLNUMBER> <number> ] ; [ BRUSH <aBrush> ] ; [ <load: LOADFILEDS> ] ; [ <cur: DBLCURSOR, DOUBLE CURSOR, FIXED> ] ; [ ON INIT <bInit> ] ; =>; <name> :=_DefineTBrowse (<"name"> , ; <"parent">, ; [ <col> ], ; [ <row> ], ; [ <w> ], ; [ <h> ], ; [ \{<aHeaders>\}] , ; [ \{<aColSizes>\}], ; [ \{|| \{ <Fields> \} \} ], ; [ <value> ], ; [ <fontname> ], ; [ <fontsize> ], ; [ <tooltip> ], ; [ <{uChange}> ], ; [ \{|nRow,nCol,nFlags|<uLDblClick>\} ], ; [ <aHeadClick> ], ; [ <{gotfocus}> ], ; [ <{lostfocus}> ], ; [ <uAlias> ], ; [ <.Delete.> ], ; [ <.style.> ], ; [ \{<aImages>\} ], ; [ <aJust> ], ; [ <helpid> ], ; [ <.bold.> ], ; [ <.italic.> ], ; [ <.underline.> ], ; [ <.strikeout.> ], ; [ <.break.> ] , ; [ <backcolor> ], ; [ <fontcolor> ], ; [ <.lock.> ], ; [ <.cell.> ], ; [ <nStyle> ], ; [ <.append.> ], ; [ <aReadOnly> ], ; [ <{aValidFields}> ], ; [ <aValidMessages> ], ; [ \{<aColors>\} ], ; [ <{uWhen}> ],[ <nId> ],[\{<(Fields)>\}],[<cMsg>], .t. ,; [ <.enum.> ],[ <.autosearch.> ],[ <{uUserSearch}> ],; [ <.autofilter.> ], [ <{uUserFilter}> ], [\{<aPicture>\}],; [ <.lTransparent.> ],[ <uSelector> ], [ <.lEditable.> ], ; [ <.lAutoCol.> ], [ \{<aColSel>\} ], [ <bInit> ], ; [ <.load.> ], [ <.cur.> ], [ <aNames> ], [ <aFooters> ], ; [ <number> ], [ <aBrush> ] ) ;; with object <name> #xcommand DEFINE TBROWSE <name> ; AT <row>,<col> ; [ ID <nId> ] ; [ <dummy1: OF, PARENT, DIALOG> <parent> ] ; [ WIDTH <w> ] ; [ HEIGHT <h> ] ; [ <head: HEAD,HEADER,HEADERS> <aHeaders,...> ] ; [ <sizes: WIDTHS, FIELDSIZES, SIZES, COLSIZES> <aColSizes,...> ] ; [ <format: PICTURE, FORMAT> <aPicture,...> ] ; [ <alias: ALIAS, ITEMS, ARRAY, WORKAREA, RECORDSET, RECSET> <uAlias> ] ; [ FIELDS <Fields,...> ] ; [ <enum: ENUMERATOR> ] ; [ <autosearch: AUTOSEARCH> [ USERSEARCH <uUserSearch> ] ]; [ <autofilter: AUTOFILTER> [ USERFILTER <uUserFilter> ] ]; [ VALUE <value> ] ; [ FONT <fontname> ] ; [ SIZE <fontsize> ] ; [ <bold : BOLD> ] ; [ <italic : ITALIC> ] ; [ <underline : UNDERLINE> ] ; [ <strikeout : STRIKEOUT> ] ; [ TOOLTIP <tooltip> ] ; [ BACKCOLOR <backcolor> ] ; [ FONTCOLOR <fontcolor> ] ; [ <color: COLOR, COLORS> <aColors,...> ] ; [ ON GOTFOCUS <gotfocus> ] ; [ ON CHANGE <uChange> ] ; [ ON LOSTFOCUS <lostfocus> ] ; [ ON DBLCLICK <uLDblClick> ] ; [ <cell: CELL, CELLED, GRID> ] ; [ STYLE <nStyle> ] ; [ <append : APPEND> ] ; [ ON HEADCLICK <aHeadClick> ] ; [ WHEN <uWhen> ] ; [ VALID <aValidFields> ] ; [ VALIDMESSAGES <aValidMessages> ] ; [ MESSAGE <cMsg> ] ; [ READONLY <aReadOnly> ] ; [ <lock: LOCK> ] ; [ <Delete: DELETE> ] ; [ <style: NOLINES> ] ; [ IMAGE <aImages,...> ] ; [ JUSTIFY <aJust> ] ; [ HELPID <helpid> ] ; [ <break: BREAK> ] ; [ <lTransparent: TRANSPARENT> ] ; [ SELECTOR <uSelector> ] ; [ <lEditable: EDIT, EDITABLE> ] ; [ <lAutoCol: AUTOCOLS> ] ; [ <colsel:COLUMNS, INCLUDE> <aColSel,...> ] ; [ <names: NAMES,COLNAMES> <aNames> ] ; [ <foot: FOOT,FOOTER,FOOTERS> <aFooters> ] ; [ <keyno: NUMBER,COLKEYNO,COLNUMBER> <number> ] ; [ BRUSH <aBrush> ] ; [ <load: LOADFIELDS> ] ; [ <cur: DBLCURSOR, DOUBLE CURSOR, FIXED> ] ; [ ON INIT <bInit> ] ; =>; <name> :=_DefineTBrowse (<"name"> , ; <"parent">, ; [ <col> ], ; [ <row> ], ; [ <w> ], ; [ <h> ], ; [ \{<aHeaders>\}] , ; [ \{<aColSizes>\}] , ; [ \{|| \{ <Fields> \} \} ], ; [ <value> ], ; [ <fontname> ], ; [ <fontsize> ], ; [ <tooltip> ], ; [ <{uChange}> ], ; [ \{|nRow,nCol,nFlags|<uLDblClick>\} ], ; [ <aHeadClick> ], ; [ <{gotfocus}> ], ; [ <{lostfocus}> ], ; [ <uAlias> ], ; [ <.Delete.> ], ; [ <.style.> ], ; [ \{<aImages>\} ], ; [ <aJust> ], ; [ <helpid> ] , ; [ <.bold.> ], ; [ <.italic.> ], ; [ <.underline.> ], ; [ <.strikeout.> ], ; [ <.break.> ] , ; [ <backcolor> ], ; [ <fontcolor> ], ; [ <.lock.> ], ; [ <.cell.> ], ; [ <nStyle> ], ; [ <.append.> ], ; [ <aReadOnly> ], ; [ <{aValidFields}> ], ; [ <aValidMessages> ], ; [ \{<aColors>\} ], ; [ <{uWhen}> ],[ <nId> ],[\{<(Fields)>\}],[<cMsg>], .f. ,; [ <.enum.> ],[ <.autosearch.> ],[ <{uUserSearch}> ],; [ <.autofilter.> ], [ <{uUserFilter}> ], [\{<aPicture>\}],; [ <.lTransparent.> ],[ <uSelector> ], [ <.lEditable.> ], ; [ <.lAutoCol.> ], [ \{<aColSel>\} ], [ <bInit> ], ; [ <.load.> ], [ <.cur.> ], [ <aNames> ], [ <aFooters> ], ; [ <number> ], [ <aBrush> ] ) ;; with object <name> ... hmg 20.01 ========= h_tbrowse.prg ... *-----------------------------------------------------------------------------* FUNCTION _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; aHeaders, aWidths, bFields, value, fontname, fontsize, tooltip, change, ; bDblclick, aHeadClick, gotfocus, lostfocus, uAlias, Delete, lNogrid, ; aImages, aJust, HelpId, bold, italic, underline, strikeout, break, ; backcolor, fontcolor, lock, cell, nStyle, appendable, readonly, ; valid, validmessages, aColors, uWhen, nId, aFlds, cMsg, lRePaint, ; lEnum, lAutoSearch, uUserSearch, lAutoFilter, uUserFilter, aPicture, ; lTransparent, uSelector, lEditable, lAutoCol, aColSel, bInit, ; lLoad, lDblCursor, aNames, aFooters, nColNumber, aBrush ) *-----------------------------------------------------------------------------* // BK LOCAL a, c, i, j, n, t, aFont, aFonts := {} LOCAL cFontHead, cFontFoot, oCol, nW LOCAL hFontHead, hFontFoot LOCAL oBrw, ParentFormHandle, mVar, k LOCAL ControlHandle, FontHandle, blInit, aBmp := {} LOCAL bRClick, bLClick, hCursor, update, nLineStyle := 1 LOCAL aTmpColor := Array( 20 ), aClr LOCAL i, nColums, nLen LOCAL oc := NIL, ow := NIL #ifdef _OBJECT_ ow := oDlu2Pixel() #endif DEFAULT nRow := 0, ; nCol := 0, ; nHeight := 120, ; nWidth := 240, ; value := 0, ; aImages := {}, ; aHeadClick := {}, ; aFlds := {}, ; aHeaders := {}, ; aWidths := {}, ; aPicture := {}, ; aJust := {}, ; hCursor := 0, ; cMsg := "", ; update := .F., ; lNogrid := .F., ; lock := .F., ; appendable := .F., ; lEnum := .F., ; lAutoSearch := .F., ; lAutoFilter := .F., ; lAutoCol := .F. HB_SYMBOL_UNUSED( break ) HB_SYMBOL_UNUSED( validmessages ) IF lNogrid nLineStyle := 0 ENDIF IF Len( aHeaders ) > 0 .AND. ValType( aHeaders[ 1 ] ) == 'A' aHeaders := aHeaders[ 1 ] // BK AEval(aHeaders, {|ct,nt| aHeaders[ nt ] := iif( HB_ISCHAR(ct) .and. ';' $ ct, StrTran(ct, ';', CRLF), ct ) }) AEval(aHeaders, {|ct,nt| aHeaders[ nt ] := iif( HB_ISCHAR(ct) .and. '\' $ ct, StrTran(ct, '\', CRLF), ct ) }) ENDIF IF Len( aWidths ) > 0 .AND. ValType( aWidths[ 1 ] ) == 'A' aWidths := aWidths[ 1 ] ENDIF IF Len( aPicture ) > 0 .AND. ValType( aPicture[ 1 ] ) == 'A' aPicture := aPicture[ 1 ] ENDIF IF Len( aFlds ) > 0 .AND. ValType( aFlds[ 1 ] ) == 'A' aFlds := aFlds[ 1 ] ENDIF IF ValType( aColSel ) != 'U' .AND. ValType( aColSel ) == 'A' IF ValType( aColSel[ 1 ] ) == 'A' aColSel := aColSel[ 1 ] ENDIF ENDIF IF HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .AND. ValType( aColors[ 1 ] ) == 'A' aColors := aColors[ 1 ] ENDIF /* BK 18.05.2015 */ IF ValType( uWhen ) == 'B' IF ValType( readonly ) != 'A' readonly := ! Eval( uWhen ) ENDIF uWhen := NIL // its needed else will be crash ENDIF IF ValType( valid ) == 'B' valid := Eval( valid ) ENDIF // BK If ! empty(FontName) .and. HB_ISARRAY( FontName ) AEval(FontName, {|cf| AAdd(aFonts, cf) }) aFont := ASIZE(aFonts, 3) FontName := aFont[1] cFontHead := aFont[2] cFontFoot := aFont[3] If ! empty(cFontHead) ; hFontHead := GetFontHandle( cFontHead ) EndIf If ! empty(cFontFoot) ; hFontFoot := GetFontHandle( cFontFoot ) EndIf IF empty(cFontFoot) .and. ! empty(cFontHead) ; hFontFoot := hFontHead ENDIF EndIf /* BK end */ IF ( FontHandle := GetFontHandle( FontName ) ) != 0 GetFontParamByRef( FontHandle, @FontName, @FontSize, @bold, @italic, @underline, @strikeout ) ENDIF IF Type( '_TSB_aControlhWnd' ) != 'A' PUBLIC _TSB_aControlhWnd := {}, _TSB_aControlObjects := {}, _TSB_aClientMDIhWnd := {} ENDIF IF aColors != NIL .AND. ValType( aColors ) == 'A' If HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) FOR EACH aClr IN aColors If HB_ISNUMERIC( aClr[1] ) .and. aClr[1] > 0 .and. aClr[1] <= Len( aTmpColor ) aTmpColor[ aClr[1] ] := aClr[2] EndIf NEXT Else AEval( aColors, {| bColor, nEle | aTmpColor[ nEle ] := bColor } ) EndIf ENDIF IF ValType( fontcolor ) != "U" aTmpColor[ 1 ] := RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) ENDIF IF ValType( backcolor ) != "U" aTmpColor[ 2 ] := RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) ENDIF IF _HMG_BeginWindowActive .OR. _HMG_BeginDialogActive IF _HMG_BeginWindowMDIActive ParentFormHandle := GetActiveMdiHandle() ParentFormName := _GetWindowProperty ( ParentFormHandle, "PROP_FORMNAME" ) ELSE ParentFormName := if( _HMG_BeginDialogActive, _HMG_ActiveDialogName, _HMG_ActiveFormName ) ENDIF IF .NOT. Empty( _HMG_ActiveFontName ) .AND. ValType( FontName ) == "U" FontName := _HMG_ActiveFontName ENDIF IF .NOT. Empty( _HMG_ActiveFontSize ) .AND. ValType( FontSize ) == "U" FontSize := _HMG_ActiveFontSize ENDIF ENDIF IF _HMG_FrameLevel > 0 nCol += _HMG_ActiveFrameCol[_HMG_FrameLevel ] nRow += _HMG_ActiveFrameRow[_HMG_FrameLevel ] ParentFormName := _HMG_ActiveFrameParentFormName[_HMG_FrameLevel ] ENDIF IF .NOT. _IsWindowDefined ( ParentFormName ) .AND. .NOT. _HMG_DialogInMemory MsgMiniGuiError( "Window: " + ParentFormName + " is not defined." ) ENDIF IF _IsControlDefined ( ControlName, ParentFormName ) .AND. .NOT. _HMG_DialogInMemory MsgMiniGuiError ( "Control: " + ControlName + " Of " + ParentFormName + " already defined." ) ENDIF IF aImages != NIL .AND. ValType( aImages ) == 'A' aBmp := Array( Len( aImages ) ) AEval( aImages, {| cImage, nEle | aBmp[ nEle ] := LoadImage( cImage ) } ) ENDIF mVar := '_' + ParentFormName + '_' + ControlName k := _GetControlFree() IF _HMG_BeginDialogActive ParentFormHandle := _HMG_ActiveDialogHandle nStyle := WS_CHILD + WS_TABSTOP + WS_VISIBLE + WS_CAPTION + WS_BORDER + WS_SYSMENU + WS_THICKFRAME IF _HMG_DialogInMemory // Dialog Template IF GetClassInfo( GetInstance(), ControlName ) == nil IF !Register_Class( ControlName, CreateSolidBrush( GetRed ( GetSysColor ( COLOR_BTNFACE ) ), GetGreen ( GetSysColor ( COLOR_BTNFACE ) ), GetBlue ( GetSysColor ( COLOR_BTNFACE ) ) ) ) RETURN NIL ENDIF ENDIF blInit := {| x, y, z| InitDialogBrowse( x, y, z ) } AAdd( _HMG_aDialogItems, { nId, k, ControlName, nStyle, 0, nCol, nRow, nWidth, nHeight, "", HelpId, tooltip, FontName, FontSize, bold, italic, underline, strikeout, blInit, _HMG_BeginTabActive, .F., _HMG_ActiveTabPage } ) IF _HMG_aDialogTemplate[ 3 ] // Modal RETURN NIL ENDIF ELSE ControlHandle := GetDialogItemHandle( ParentFormHandle, nId ) SetWindowStyle ( ControlHandle, nStyle, .T. ) nCol := GetWindowCol ( Controlhandle ) nRow := GetWindowRow ( Controlhandle ) nWidth := GetWindowWidth ( Controlhandle ) nHeight := GetWindowHeight ( Controlhandle ) ENDIF ELSE ParentFormHandle := GetFormHandle ( ParentFormName ) hToolTip := GetFormToolTipHandle ( ParentFormName ) oBrw := TSBrowse():New( ControlName, nRow, nCol, nWidth, nHeight, ; bFields, aHeaders, aWidths, ParentFormName, ; change, bDblClick, bRClick, fontname, fontsize, ; hCursor, aTmpColor, aBmp, cMsg, update, uAlias, uWhen, value, cell, ; nStyle, bLClick, aFlds, aHeadClick, nLineStyle, lRePaint, ; Delete, aJust, lock, appendable, lEnum, ; lAutoSearch, uUserSearch, lAutoFilter, uUserFilter, aPicture, ; lTransparent, uSelector, lEditable, lAutoCol, aColSel, tooltip ) // BK oBrw:SetAppendMode( .F. ) oBrw:SetDeleteMode( .F. ) If ! empty(hFontHead) ; oBrw:hFontHead := hFontHead EndIf If ! empty(hFontFoot) ; oBrw:hFontFoot := hFontFoot EndIf oBrw:nWheelLines := 1 oBrw:lNoGrayBar := .F. oBrw:nClrLine := COLOR_GRID oBrw:lNoMoveCols := .T. oBrw:lNoLiteBar := .F. oBrw:lNoResetPos := .F. oBrw:nLineStyle := LINES_ALL // LINES_NONE LINES_ALL LINES_VERT LINES_HORZ LINES_3D LINES_DOTTED oBrw:lPickerMode := .F. oBrw:nFireKey := VK_F4 oBrw:lNoHScroll := .T. oBrw:nStatusItem := 0 oBrw:lNoPopUp := .T. oBrw:hToolTip := GetFormToolTipHandle (ParentFormName) ControlHandle := oBrw:hWnd IF ValType( gotfocus ) != "U" oBrw:bGotFocus := gotfocus ENDIF IF ValType( lostfocus ) != "U" oBrw:bLostFocus := lostfocus ENDIF IF ! lRePaint _HMG_ActiveTBrowseName := ControlName _HMG_ActiveTBrowseHandle := ControlHandle _HMG_BeginTBrowseActive := .T. ENDIF // BK IF ! empty(lLoad) .and. oBrw:lIsDbf oBrw:LoadFields( ! Empty(lEditable) ) IF ( n := len(oBrw:aColumns) ) > 0 IF HB_ISARRAY(aHeaders) j := Min(Len(aHeaders), n) FOR t := 1 TO j IF aHeaders[ t ] != NIL oBrw:aColumns[ t ]:cHeading := aHeaders[ t ] ENDIF NEXT ENDIF IF HB_ISARRAY(aWidths) j := Min(Len(aWidths), n) FOR t := 1 TO j IF aWidths[ t ] != NIL oBrw:aColumns[ t ]:nWidth := aWidths[ t ] ENDIF NEXT ENDIF IF HB_ISARRAY(aJust) j := Min(Len(aJust), n) FOR t := 1 TO j IF aJust[ t ] != NIL oBrw:aColumns[ t ]:nAlign := aJust[ t ] oBrw:aColumns[ t ]:nFAlign := aJust[ t ] ENDIF NEXT ENDIF IF HB_ISARRAY(aPicture) j := Min(Len(aPicture), n) FOR t := 1 TO j IF aPicture[ t ] != NIL oBrw:aColumns[ t ]:cPicture := aPicture[ t ] ENDIF NEXT ENDIF ENDIF ENDIF IF ( nColums := Len( oBrw:aColumns ) ) > 0 /* BK 18.05.2015 */ IF ValType( readonly ) == 'A' // sets oCol:bWhen nLen := Min( Len( readonly ), nColums ) FOR i := 1 TO nLen IF ValType( READONLY[ i ] ) == 'B' oBrw:aColumns[ i ]:bWhen := READONLY[ i ] ELSEIF READONLY[ i ] == NIL .OR. Empty( READONLY[ i ] ) oBrw:aColumns[ i ]:bWhen := {|| .T. } oBrw:aColumns[ i ]:cWhen := '{||.T.}' ELSE oBrw:aColumns[ i ]:bWhen := {|| .F. } oBrw:aColumns[ i ]:cWhen := '{||.F.}' ENDIF NEXT ENDIF IF ValType( valid ) == 'A' // sets oCol:bValid nLen := Min( Len( valid ), nColums ) FOR i := 1 TO nLen IF ValType( VALID[ i ] ) == 'B' oBrw:aColumns[ i ]:bValid := VALID[ i ] ENDIF NEXT ENDIF ENDIF /* BK end */ ENDIF // BK n := nColums IF HB_ISARRAY(aNames) j := Min(Len(aNames), n) FOR t := 1 TO j IF ! empty(aNames[ t ]) .and. HB_ISCHAR(aNames[ t ]) oBrw:aColumns[ t ]:cName := aNames[ t ] ENDIF NEXT ENDIF IF HB_ISLOGICAL(aFooters) .and. aFooters aFooters := array( n ) aFill( aFooters, " " ) ENDIF IF HB_ISARRAY(aFooters) j := Min(Len(aFooters), n) FOR t := 1 TO j IF aFooters[ t ] != NIL IF HB_ISCHAR(aFooters[ t ]) .and. ! empty(aFooters[ t ]) IF ';' $ aFooters[ t ] aFooters[ t ] := StrTran(aFooters[ t ], ';', CRLF) ENDIF IF '\' $ aFooters[ t ] aFooters[ t ] := StrTran(aFooters[ t ], '\', CRLF) ENDIF ENDIF oBrw:aColumns[ t ]:cFooting := aFooters[ t ] ENDIF NEXT oBrw:lDrawFooters := .T. oBrw:lFooting := .T. oBrw:nHeightFoot := oBrw:nHeightCell ENDIF IF ! empty(lDblCursor) AEval( oBrw:aColumns, {| oCol| oCol:lFixLite := .T. } ) ENDIF nW := 0 IF nColNumber != NIL IF HB_ISLOGICAL(nColNumber) nColNumber := iif( nColNumber, 1, NIL ) ELSEIF HB_ISARRAY(nColNumber) IF Len(nColNumber) > 1 nW := nColNumber[2] nColNumber := nColNumber[1] ELSE nColNumber := 1 ENDIF ENDIF ENDIF IF HB_ISNUMERIC(nColNumber) .and. oBrw:lIsDbf nColNumber := iif( nColNumber > 0 .and. nColNumber <= n, nColNumber, 1 ) DEFINE COLUMN oCol DATA 'hb_ntos(iif( IndexOrd() > 0, ORDKEYNO(), RecNo() ))' ; HEADER '#' ; FOOTER ' ' ; ALIGN 1, 1, 1 ; WIDTH TxtWidth(6) ; PICTURE '9999997' ; MOVE 0 ; DBLCURSOR ; NAME ORDKEYNO oCol:cAlias := oBrw:cAlias oCol:cFooting := { |nc,ob| nc := ob:nLen, iif( Empty(nc), '', hb_ntos(nc) ) } oCol:lEmptyValToChar := .T. oCol:cData := 'hb_macroblock("'+oCol:cField+'")' oCol:bData := hb_macroblock( oCol:cField ) oCol:cFieldTyp := 'N' oCol:nFieldLen := 10 oCol:nFieldDec := 0 oBrw:InsColumn( nColNumber, oCol ) IF HB_ISNUMERIC(nW) .and. nW > 0 oBrw:GetColumn(nColNumber):nWidth := nW ENDIF ENDIF IF .NOT. _HMG_DialogInMemory IF _HMG_BeginTabActive AAdd ( _HMG_ActiveTabCurrentPageMap, Controlhandle ) ENDIF IF FontHandle != 0 _SetFontHandle( ControlHandle, FontHandle ) oBrw:hFont := FontHandle ELSE IF ValType( fontname ) == "U" FontName := _HMG_DefaultFontName ENDIF IF ValType( fontsize ) == "U" FontSize := _HMG_DefaultFontSize ENDIF oBrw:hFont := _SetFont ( ControlHandle, FontName, FontSize, bold, italic, underline, strikeout ) ENDIF ENDIF Public &mVar. := k _HMG_aControlType[ k ] := "TBROWSE" _HMG_aControlNames[ k ] := ControlName _HMG_aControlHandles[ k ] := ControlHandle _HMG_aControlParenthandles[ k ] := ParentFormHandle _HMG_aControlIds[ k ] := oBrw _HMG_aControlProcedures[ k ] := bDblclick _HMG_aControlPageMap[ k ] := aHeaders _HMG_aControlValue[ k ] := Value _HMG_aControlInputMask[ k ] := Lock _HMG_aControllostFocusProcedure[ k ] := lostfocus _HMG_aControlGotFocusProcedure[ k ] := gotfocus _HMG_aControlChangeProcedure[ k ] := change _HMG_aControlDeleted[ k ] := .F. _HMG_aControlBkColor[ k ] := aImages _HMG_aControlFontColor[ k ] := Nil _HMG_aControlDblClick[ k ] := bDblclick _HMG_aControlHeadClick[ k ] := aHeadClick _HMG_aControlRow[ k ] := nRow _HMG_aControlCol[ k ] := nCol _HMG_aControlWidth[ k ] := nWidth _HMG_aControlHeight[ k ] := nHeight _HMG_aControlSpacing[ k ] := uAlias _HMG_aControlContainerRow[ k ] := iif ( _HMG_FrameLevel > 0, _HMG_ActiveFrameRow[ _HMG_FrameLevel ], -1 ) _HMG_aControlContainerCol[ k ] := iif ( _HMG_FrameLevel > 0, _HMG_ActiveFrameCol[ _HMG_FrameLevel ], -1 ) _HMG_aControlPicture[ k ] := Delete _HMG_aControlContainerHandle[ k ] := 0 _HMG_aControlFontName[ k ] := fontname _HMG_aControlFontSize[ k ] := fontsize _HMG_aControlFontAttributes[ k ] := { bold, italic, underline, strikeout } _HMG_aControlToolTip[ k ] := tooltip _HMG_aControlRangeMin[ k ] := 0 _HMG_aControlRangeMax[ k ] := {} _HMG_aControlCaption[ k ] := aHeaders _HMG_aControlVisible[ k ] := .T. _HMG_aControlHelpId[ k ] := HelpId _HMG_aControlFontHandle[ k ] := oBrw:hFont _HMG_aControlBrushHandle[ k ] := 0 _HMG_aControlEnabled[ k ] := .T. _HMG_aControlMiscData1[ k ] := 0 _HMG_aControlMiscData2[ k ] := '' IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) #ifdef _OBJECT_ ow := _WindowObj ( ParentFormHandle ) oc := _ControlObj( ControlHandle ) #endif ENDIF Do_ControlEventProcedure ( bInit, k, oBrw, ow, oc ) RETURN oBrw ... [/pre2] Возможны ошибки, не собирал такой вариант. Новые строки идут под отметкой // BK Изменения и программа CBru тут https://TransFiles.ru/yk9nm

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