Автор | Сообщение |
|
| |
Пост N: 1511
Зарегистрирован: 20.02.11
|
|
Отправлено: 06.02.20 17:17. Заголовок: Курсы ЦБ РФ на дату
потребовалось часто и быстро дергать курсы валют с ЦБ РФ , за пару часов написал функцию. Может кому сгодиться на оригинальность не претендую , но работает . Возвращает массив значений на дату . 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
| |
|
Ответов - 46
, стр:
1
2
3
All
[только новые]
|
|
|
| |
Пост N: 7162
Зарегистрирован: 17.05.05
|
|
Отправлено: 06.02.20 22:02. Заголовок: Haz :sm36:..
Haz
| |
|
|
| постоянный участник
|
Пост N: 6575
Зарегистрирован: 12.09.06
|
|
Отправлено: 07.02.20 07:31. Заголовок: Сделай этот пример д..
Сделай этот пример для МиниГуи ! Будет классно для всех.
| |
|
|
| |
Пост N: 1512
Зарегистрирован: 20.02.11
|
|
Отправлено: 07.02.20 08:14. Заголовок: Andrey пишет: Сдела..
Andrey пишет: цитата: | Сделай этот пример для МиниГуи ! |
|
Сделаю сегодня
| |
|
|
| |
Пост N: 217
Зарегистрирован: 05.11.05
|
|
Отправлено: 07.02.20 11:54. Заголовок: Я в свое время делал..
Я в свое время делал нечто подобное, поэтому могу оценить. Красиво!
| |
|
|
| |
Пост N: 1513
Зарегистрирован: 20.02.11
|
|
Отправлено: 07.02.20 13:08. Заголовок: rvu пишет: Сделай э..
Андрей: цитата: | Сделай этот пример для МиниГуи ! |
| где то так #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
| |
|
|
| |
Пост N: 218
Зарегистрирован: 05.11.05
|
|
Отправлено: 07.02.20 13:43. Заголовок: Надо, чтобы включили..
Надо, чтобы включили в примеры.
| |
|
|
| постоянный участник
|
Пост N: 3029
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.02.20 17:29. Заголовок: Игорь, пример оч. хо..
Игорь, пример оч. хороший ! СПАСИБО ! Перенес в свою версию на ура. Вот что получилось, в тек. версии hmg должно работать тоже, кроме ";" в HEADERS. Текст совсем короткий Скрытый текст
#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
|
| |
|
|
| |
Пост N: 1514
Зарегистрирован: 20.02.11
|
|
Отправлено: 07.02.20 18:11. Заголовок: SergKis пишет: Вот ..
SergKis пишет: Отлично оптимизировал Добавь к :GetColumn("Name"):nAlign := DT_LEFT :GetColumn("Name"):nWidth := 300 :GetColumn("Name"):cPicture := "@R " + Replicate("X", 50) именно @R c пробелом(иногда и по два и более делаю) , будет отступ от вертикальной линии ЗЫ я такими шаблонами вложенность строк в структурах показываю
| |
|
|
| постоянный участник
|
Пост N: 3030
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.02.20 19:46. Заголовок: Haz пишет я такими ш..
Haz пишет цитата: | я такими шаблонами вложенность строк в структурах показываю |
| И как ты это делаешь ? меняешь oCol:cPicture налету ? Я в :bDecode от кода строки (или еще от чего) добавляю определенное кол-во space(nN) для сдвига
| |
|
|
| |
Пост N: 1515
Зарегистрирован: 20.02.11
|
|
Отправлено: 07.02.20 20:09. Заголовок: SergKis пишет: И ка..
SergKis пишет: цитата: | И как ты это делаешь ? меняешь oCol:cPicture налету ? |
| Да, для показа шаблон со сдвигом, в :prevedit меняю на обычный, в :editexit восстанавливаю сдвиг. Сам сдвиг храниться в спец поле indent, количество пробелов в шаблоне равно indent*2 Сначала тоже дополнял само значение слева пробелами, но потом понял что менять значение не удобно тк в редактирование значение шло с телефона пробелами, а пользователь мог удалить, а мог и нет., и не понять что он ввел
| |
|
|
| постоянный участник
|
Пост N: 3031
Зарегистрирован: 17.02.12
|
|
Отправлено: 07.02.20 20:38. Заголовок: Haz пишет Да, для по..
Haz пишет цитата: | Да, для показа шаблон со сдвигом, в :prevedit меняю на обычный, в :editexit восстанавливаю сдвиг. Сам сдвиг храниться в спец поле indent, количество пробелов в шаблоне равно indent*2 |
| OK! Надо тоже переходить на такую схему
| |
|
|
|
| |
Пост N: 1516
Зарегистрирован: 20.02.11
|
|
Отправлено: 07.02.20 21:12. Заголовок: SergKis пишет: шло ..
SergKis пишет: цитата: | шло с телефона пробелами, а |
| Откуда тут с "телефона" не набирал точно, хотя набирал с телефона
| |
|
|
| Администратор
|
Пост N: 3917
Зарегистрирован: 23.05.05
|
|
Отправлено: 08.02.20 16:35. Заголовок: Мне время от времени..
Мне время от времени приходится выбирать информацию из формата xml, делаю это с помощью класса Александра Кресина. Он есть и в поставке hmg Разбор курсов валют ЦБР выглядел бы так: 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], "") cHtml - строка, полученная с сайта Центробанка в примере Игоря
| |
|
|
| постоянный участник
|
Пост N: 3032
Зарегистрирован: 17.02.12
|
|
Отправлено: 08.02.20 18:41. Заголовок: Pasha пишет Мне врем..
Pasha пишет цитата: | Мне время от времени приходится выбирать информацию из формата xml, делаю это с помощью класса Александра Кресина. Он есть и в поставке hmg |
| Тоже использую этот класс и подтверждаю работает предложенный вариант Вот, что получилось у меня (полностью перевел пример на свою lib), включат оба разбора cHtml Скрытый текст
#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], "")
|
| |
|
|
| постоянный участник
|
Пост N: 6579
Зарегистрирован: 12.09.06
|
|
Отправлено: 09.02.20 01:22. Заголовок: SergKis пишет: Вот,..
SergKis пишет: цитата: | Вот, что получилось у меня (полностью перевел пример на свою lib), включат оба разбора cHtml |
| Не собирается... Отправил проект к тебе Собирал через MiniGUI 20.01 (Update 3)
| |
|
|
| постоянный участник
|
Пост N: 3035
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.20 02:11. Заголовок: Andrey SergKis пише..
Andrey SergKis пишет: цитата: | полностью перевел пример на свою lib |
| hmg надо доводить, если надо, конечно ? Сам пример тут https://TransFiles.ru/oymu6
| |
|
|
| постоянный участник
|
Пост N: 6580
Зарегистрирован: 12.09.06
|
|
Отправлено: 09.02.20 14:40. Заголовок: SergKis пишет: hmg ..
SergKis пишет: цитата: | hmg надо доводить, если надо, конечно ? |
| Надо ! Обязательно ! Потом можно будет доводить этот пример для TsbrowseSaveDbf( oBrw, "fileBrw.obrw" ) TsbrowseRestoreDbf( "fileBrw.obrw", oBrw )
| |
|
|
| постоянный участник
|
Пост N: 3037
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.20 14:48. Заголовок: Andrey пишет Надо ! ..
Andrey пишет Тогда это самостоятельно, т.к. bcc 5.8 у меня не установлен (и не будет пока) Позже выложу изменения
| |
|
|
| постоянный участник
|
Пост N: 6581
Зарегистрирован: 12.09.06
|
|
Отправлено: 09.02.20 15:29. Заголовок: SergKis пишет: Тогд..
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.
| |
|
|
| постоянный участник
|
Пост N: 3038
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.20 16:51. Заголовок: SergKis пишет Позже ..
SergKis пишет Выкладываю, но надо иметь ввиду, что сделаны изменения под себя. Изменения ch файла показаны на версию Минигуи 2.07. prg файл взял от hmg 20.01 и наложил из своей версии Скрытый текст
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 ...
| Возможны ошибки, не собирал такой вариант. Новые строки идут под отметкой // BK Изменения и программа CBru тут https://TransFiles.ru/yk9nm
| |
|
|
| постоянный участник
|
Пост N: 3039
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.02.20 17:12. Заголовок: PS Потерял ф-ю *--..
PS Потерял ф-ю Скрытый текст
*----------------------------------------------------------------------------* 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 ...
|
| |
|
|
|
| постоянный участник
|
Пост N: 6582
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.02.20 09:56. Заголовок: SergKis пишет: Изме..
SergKis пишет: цитата: | Изменения ch файла показаны на версию Минигуи 2.07. prg файл взял от hmg 20.01 и наложил из своей версии |
| А почему эти изменения нельзя добавить в основную версию МиниГуи ? Это же всем тоже будет удобно.
| |
|
|
| постоянный участник
|
Пост N: 3043
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.02.20 11:49. Заголовок: Andrey пишет А почем..
Andrey пишет цитата: | А почему эти изменения нельзя добавить в основную версию МиниГуи ? |
| Повторю, у меня нет и не будет bcc 5.8, потому последние hmg только скачиваю. Могу сделать, отладить в версию hmg 19.09 вместе с примером
| |
|
|
| постоянный участник
|
Пост N: 3045
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.02.20 12:57. Заголовок: SergKis пишет Могу с..
SergKis пишет цитата: | Могу сделать, отладить в версию hmg 19.09 вместе с примером |
| Тут для hmg 19.09, если интересно https://TransFiles.ru/ff1ig
| |
|
|
| постоянный участник
|
Пост N: 3046
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.02.20 14:01. Заголовок: PS В CBru.prg надо п..
PS В CBru.prg надо поправить (в моей версии объект дает :ClientHeight уже без :StatusBar:Height) nW := oWnd:ClientWidth - nX * 2 nH := oWnd:ClientHeight - nY - oWnd:StatusBar:Height ...
| |
|
|
| постоянный участник
|
Пост N: 6584
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.02.20 15:59. Заголовок: SergKis пишет: Повт..
SergKis пишет: цитата: | Повторю, у меня нет и не будет bcc 5.8, потому последние hmg только скачиваю. Могу сделать, отладить в версию hmg 19.09 вместе с примером |
| Так я беру и правлю пути под BCC 5.5.1, и всех делов то... Под bcc 5.8 у меня тоже не всё компилирует, сборщик ресурсов глючит. SergKis пишет: цитата: | Тут для hmg 19.09, если интересно |
| Конечно интересно. Странно, под 20.01 (Update 3) не работает... Собрал и вылет с ошибкой: 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 А понял в чём ошибка. Добавил в проект h_tbrowse.prg и всё заработало... А в стандартный МиниГуи добавить нельзя эти изменения из h_tbrowse.prg ? Григорий, посмотри пожалуйста разницу в h_tbrowse.prg !
| |
|
|
| moderator
|
Пост N: 1652
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.02.20 17:48. Заголовок: Andrey пишет: в ста..
Andrey пишет: цитата: | в стандартный МиниГуи добавить нельзя эти изменения из h_tbrowse.prg ? |
| Добавил эти изменения, за исключением обработки символов ";" и "\" в заголовках и персональных установок для Tbrowse, которые есть в коде. Собрал этот пример - работает (и выглядит) идентично оригиналу.
| |
|
|
| постоянный участник
|
Пост N: 3047
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.02.20 18:53. Заголовок: gfilatov2002 пишет Д..
gfilatov2002 пишет Поправить надо 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 ...
| |
|
|
| moderator
|
Пост N: 1653
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.02.20 22:09. Заголовок: SergKis пишет: Попр..
SergKis пишет: Поправил. Благодарю за помощь
| |
|
|
| постоянный участник
|
Пост N: 6585
Зарегистрирован: 12.09.06
|
|
Отправлено: 10.02.20 22:52. Заголовок: gfilatov2002 пишет: ..
gfilatov2002 пишет: цитата: | Собрал этот пример - работает (и выглядит) идентично оригиналу. |
| Классно ! Ждем с нетерпением новую версию !
| |
|
|
| постоянный участник
|
Пост N: 3153
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.05.20 20:08. Заголовок: Haz пишет Добавь к ..
Haz пишет цитата: | Добавь к :GetColumn("Name"):cPicture := "@R " + Replicate("X", 50) именно @R c пробелом(иногда и по два и более делаю) , будет отступ от вертикальной линии ЗЫ я такими шаблонами вложенность строк в структурах показываю ... для показа шаблон со сдвигом, в :prevedit меняю на обычный, в :editexit восстанавливаю сдвиг. Сам сдвиг храниться в спец поле indent, количество пробелов в шаблоне равно indent*2 |
| Попробовал использовать Picture "@R " + Replicate("X", 50) с заменой, как то не зашло, т.к. picture почти нигде не задаю (на default упор) Вернулся к реализации с пробелами, но залез в CLASS TsBrowse, ввел переменную, поправил методы Скрытый текст
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 ...
| Если :nCellMarginLR задан блоком кода, то передаются параметры в него - номер колонки - объект тсб oBrw - объект колонки - и тип вызова 0 - линия тсб ( :DrawLine(), :DrawSelect() ) 1 - Header ( :DrawHeader() ) 2 - Footer ( :DrawFooter() ) Eval( ::nCellMarginLR, nJ, Self, oColumn, nAlign, 0 ) Если возвращает число пробелов > 0, то делается margin Left or Right Попробовал в простом примере, без блока - работает и по мне, удобно в использовании.
| |
|
|
|
| постоянный участник
|
Пост N: 3154
Зарегистрирован: 17.02.12
|
|
Отправлено: 02.05.20 20:15. Заголовок: PS В предпросмотре р..
PS В предпросмотре ровненько показывает, как и в редакторе, а включение в тему и текст прыгает тудой-сюдой.
| |
|
|
| |
Пост N: 1544
Зарегистрирован: 20.02.11
|
|
Отправлено: 02.05.20 23:26. Заголовок: SergKis пишет: зале..
SergKis пишет: цитата: | залез в CLASS TsBrowse, ввел переменную, поправил методы |
| Сергей. Давно тоже хотел зашить в методы колонки. Правда реализация через блоки показалась слишком сложной. Пошёл по пути пикчи на основании значения спец поля. Если и вводить переменную то в клас колонки, при этом учитывая что тип может быть не только символьный. А тут кроме пикчи в голову ничего не приходит Ps. Кстати не нравится что значения числовых полей прилипают вплотную к правой линии.... И тут тоже пикчей дополняют пробелы
| |
|
|
| постоянный участник
|
Пост N: 3155
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.05.20 07:11. Заголовок: Haz пишет Кстати не ..
Haz пишет цитата: | Кстати не нравится что значения числовых полей прилипают вплотную к правой линии.... |
| Игорь, мне тоже не нравится такое прилипание еще и символьных (другие тоже) полей вплотную к левой линии. Сделанная переменная на класс это, в первую очередь, исправить прижимание к границе\линии, задав 1 или 2 получается приличный вид всех колонок с DT_LEFT, DT_RIGHT. Особенно это заметно при задании цвета отрицательным значением, т.е. обводка ячеек линией. Пока такой пример Tsb_array_2\demo3.prg и пробовал. цитата: | Если и вводить переменную то в клас колонки, при этом учитывая что тип может быть не только символьный |
| Тоже была такая мысль, но решил ограничится, пока, переменной класса, передавая в блок параметры oColumn, nAlign и тип вызова ( 0 для строки, 1 header, 2 footer ). Т.е. для колонки с опред. именем и nAlign можно вернуть числовое нужное смещение, для всех других, к примеру 1 для отступа от линии.
| |
|
|
| постоянный участник
|
Пост N: 3156
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.05.20 10:32. Заголовок: PS Сделал эти измене..
PS Сделал эти изменения только в своей версии. Надо такое в hmg или усиливать по колонкам, а может, вообще, лишнее ?
| |
|
|
| |
Пост N: 1545
Зарегистрирован: 20.02.11
|
|
Отправлено: 03.05.20 12:15. Заголовок: SergKis пишет: Надо..
SergKis пишет: цитата: | Надо такое в hmg или усиливать по колонкам, а может, вообще, лишнее ? |
| По колонками может пригодиться. С мультилайном мысль интересная, её шаблоном не сделать. И может слева и права иметь возможность дополнять не только пробелами, можно использовать псевдографику для рисования псевдо дерева к примеру. То есть блок выдает не число, а строку. Я не занимался этим вопросом серьёзно, для решения локальной задачи играл с шаблонами т. к. они независимы от типа данных. Была даже мысль добавить переменные cLPicture и cRPicture, для добавления стандартного слева справа перед применением. Потом компания купила Битрикс и пришлось с головой уйти в синхронизацию данных с этой витриной посредством rest запросов и написанием своего вэб сервера. Поэтому бросил. Может тут все выскажут свое мнение? Мне все же как-то с шаблонами справа и слева через блоки больше нравится, универсальное, но и твоё предложение тоже полезно
| |
|
|
| постоянный участник
|
Пост N: 3157
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.05.20 12:39. Заголовок: Haz пишет И может сл..
Haz пишет цитата: | И может слева и права иметь возможность дополнять не только пробелами, можно использовать псевдографику для рисования псевдо дерева к примеру. |
| Добавить проверку возврата на строку и добавлять ее, это реально и просто. Делать переменные в класс колонки, пока не знаю, может в будущем. Тогда переменная из tsbrowse класса определяет глобальную установку отступа колонок DT_LEFT, DT_RIGHT, если задано в классе колонки, то подменять общее значение на значение полученное из колонки. Но, думается, решить это можно для колонки и от переменной из tsbrowse класса
| |
|
|
| |
Пост N: 1546
Зарегистрирован: 20.02.11
|
|
Отправлено: 03.05.20 17:07. Заголовок: SergKis пишет: Но, ..
SergKis пишет: цитата: | Но, думается, решить это можно для колонки и от переменной из tsbrowse класса |
| Да, согласен. Можно так для строкового значения сделать. В процессе использования придёт понимание чего не хватает
| |
|
|
| постоянный участник
|
Пост N: 3162
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.05.20 18:56. Заголовок: Haz Вот что получил..
Haz Вот что получилось hmg 20.04. Изменения тсб Скрытый текст
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
| Пример demo5.prg и h_tbrowse.prg тут https://TransFiles.ru/zkhi1
| |
|
|
| постоянный участник
|
Пост N: 3163
Зарегистрирован: 17.02.12
|
|
Отправлено: 03.05.20 19:00. Заголовок: PS Запуск demo5.exe..
PS Запуск demo5.exe без параметров - работа с массивом demo5.exe * работа с dbf demo5.exe * 7 работа с dbf только 7 полей
| |
|
|
| |
Пост N: 1547
Зарегистрирован: 20.02.11
|
|
Отправлено: 03.05.20 20:51. Заголовок: SergKis пишет: Вот ..
SergKis пишет: Отлично. Погоня в понедельник. её
| |
|
|
|
| |
Пост N: 78
Зарегистрирован: 18.06.15
|
|
Отправлено: 04.05.20 07:27. Заголовок: SergKis пишет: Прим..
SergKis пишет: Не открывается ...
| |
|
|
| постоянный участник
|
Пост N: 6647
Зарегистрирован: 12.09.06
|
|
Отправлено: 04.05.20 08:01. Заголовок: Alex_Cher пишет: Не..
Alex_Cher пишет: Только что скачал и открыл архив.
| |
|
|
| |
Пост N: 1548
Зарегистрирован: 20.02.11
|
|
Отправлено: 04.05.20 15:56. Заголовок: Вот что получилось h..
цитата: | Вот что получилось hmg 20.04. |
| Сергей, отлично работает Из предложений - разделить переменную на две - xMarginL и xMarginR, продублировать в колонках ( чтоб иметь независимый отступ по колонкам ). В целом отличное дополнение в TSB. ЗЫ не разбирался и к теме не относится , а чего навигация по массиву так тупит ? при перемещении вправо идет перерисовка всего бровса . Так и задумано ?
| |
|
|
| постоянный участник
|
Пост N: 3165
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.05.20 16:39. Заголовок: Haz пишет .Из предло..
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 от значения индекса смещения в таблице цитата: | не разбирался и к теме не относится , а чего навигация по массиву так тупит ? при перемещении вправо идет перерисовка всего бровса . Так и задумано ? |
| То же обратил внимание, но не знаю почему.
| |
|
|
| постоянный участник
|
Пост N: 3166
Зарегистрирован: 17.02.12
|
|
Отправлено: 04.05.20 17:05. Заголовок: PS Прорисовка идет п..
PS Прорисовка идет при работе с массивом, с dbf такого нет
| |
|
Ответов - 46
, стр:
1
2
3
All
[только новые]
|
|
|