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

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

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

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

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 полей

Haz: SergKis пишет: Вот что получилось Отлично. Погоня в понедельник. её

Alex_Cher: SergKis пишет: Пример demo5.prg и h_tbrowse.prg тут https://TransFiles.ru/zkhi1 Не открывается ...

Andrey: Alex_Cher пишет: Не открывается ... Только что скачал и открыл архив.

Haz: Вот что получилось hmg 20.04. Сергей, отлично работает Из предложений - разделить переменную на две - xMarginL и xMarginR, продублировать в колонках ( чтоб иметь независимый отступ по колонкам ). В целом отличное дополнение в TSB. ЗЫ не разбирался и к теме не относится , а чего навигация по массиву так тупит ? при перемещении вправо идет перерисовка всего бровса . Так и задумано ?

SergKis: Haz пишет .Из предложений - разделить переменную на две - xMarginL и xMarginR, продублировать в колонках ( чтоб иметь независимый отступ по колонкам ). Думал на эту тему, мне кажется, это лишнее в данном случае. Переменные нужны, если нет блока кода, но тогда надо заполнять переменные oCol:xMarginL и oCol:xMarginR в др. блоке oCol:bData, oCol:bValue, oCol:bDecode. Т.е. :nCellMarginLR := 1 и вычисляем, пишем в заменяющие значения в колонке в блоках выше. Или как сейчас :nCellMarginLR := {|nc,ob,oc,na,no| iif( na == DT_LEFT .and. oc:cName == 'GRNAME', (ob:cAlis)->NGRU, 1 ) } т.е. все прижатия влево, вправо сместятся на пробел от линии, а колонка GRNAME от значения индекса смещения в таблице не разбирался и к теме не относится , а чего навигация по массиву так тупит ? при перемещении вправо идет перерисовка всего бровса . Так и задумано ? То же обратил внимание, но не знаю почему.

SergKis: PS Прорисовка идет при работе с массивом, с dbf такого нет

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