Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
gfilatov2002: Andrey пишет: для ТСБ пропадает суперхидер Благодарю за сообщение Я уже поправил эту недоработку Просто еще раз скачайте установщик версии 20.08 с исправлением
SergKis: gfilatov2002 Показалось интересным добавить все типы поле в FilterFTS() [pre2] METHOD FilterFTS( cFind, lUpper, lBottom, lFocus, lAll ) METHOD FilterFTS_Line( cFind, lUpper, lAll ) ... METHOD FilterFTS( cFind, lUpper, lBottom, lFocus, lAll ) CLASS TSBrowse ... DEFAULT lUpper := .T., lAll := .F. ... If ! Empty( cFind ) ( cAlias )->( DbSetFilter( {|| ob:FilterFTS_Line( cFind, lUpper, lAll, ob ) }, ; "ob:FilterFTS_Line( cFind, lUpper, lAll, ob )" ) ) Else ... METHOD FilterFTS_Line( cFind, lUpper, lAll ) CLASS TSBrowse ... DEFAULT lUpper := .T., lAll := .F. ... xVal := ::bDataEval( oCol, , nCol ) IF lAll .and. ! HB_ISCHAR( xVal ) xVal := cValToChar( xVal ) ENDIF If HB_ISCHAR( xVal ) ... [/pre2]
gfilatov2002: SergKis пишет: добавить все типы Добавил, конечно Благодарю за помощь
SergKis: gfilatov2002 Наверно, надо добавить для ToolTip тсб [pre2] CLASS TSBrowse FROM TControl ... DATA nToolTipRow AS NUMERIC INIT 0 DATA nToolTipLen AS NUMERIC INIT 512 // DATA nToolTipTime // in seconds ... METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ; ... SetToolTip( ::hWnd, cToolTip, hToolTip ) TTM_SetMaxTipWidth( hToolTip, ::nToolTipLen ) IF ISNUMERIC( ::nToolTipTime ) .and. ::nToolTipTime > 0 TTM_SetDelayTime( hToolTip, TTDT_AUTOPOP, ::nToolTipTime * 1000 ) ENDIF if nValue > 0 .and. nValue <= ::nLen ... [/pre2]
SergKis: PS Еще такое предложение для тсб (запоминать позицию строк на экране в некоторых случаях облегчает работу) [pre2] CLASS TSBrowse FROM TControl ... DATA aRowPosAtRec DATA lRowPosAtRec AS LOGICAL INIT .F. ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... l3DLook := iif( ::nPhantom == -1, ATail( ::aColumns ):l3DLook, .F. ) IF ::lRowPosAtRec IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() ::aRowPosAtRec := Array( ::nRowCount() ) AFILL( ::aRowPosAtRec, 0 ) ENDIF IF ::nLen == 0 ELSEIF ::lIsDbf ; ::aRowPosAtRec[ xRow ] := (::cAlias)->( RecNo() ) ELSEIF ::lIsArr ; ::aRowPosAtRec[ xRow ] := ::nAt ENDIF ENDIF If ::nLen > 0 ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... nBegin := Min( iif( ::nColPos <= ::nFreeze, ( ::nColPos := ::nFreeze + 1, ::nColPos - ::nFreeze ), ; ::nColPos - ::nFreeze ), nLastCol ) IF ::lRowPosAtRec IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() ::aRowPosAtRec := Array( ::nRowCount() ) AFILL( ::aRowPosAtRec, 0 ) ENDIF IF ::lIsDbf ; ::aRowPosAtRec[ xRow ] := (::cAlias)->( RecNo() ) ELSEIF ::lIsArr ; ::aRowPosAtRec[ xRow ] := ::nAt ENDIF ENDIF If ! ::lDrawLine ... тогда можно с ToolTip так делать :cToolTip := {|ob,x,y| // x -> Column, y -> Row Local cRet := "" Local cVal := "", nRec, nNew If ISNUMERIC(y) .and. ISNUMERIC(x) If y > 0 // .and. x == ob:nCell cRet :=" Row ="+str(y,3)+" Col ="+str(x,3)+" " nRec := (ob:cAlias)->( RecNo() ) nNew := ob:aRowPosAtRec[ y ] If nRec > 0 (ob:cAlias)->( dbGoto( nNew ) ) cVal := Trim(cValToChar(ob:GetValue( x ))) (ob:cAlias)->( dbGoto( nRec ) ) EndIf If ! empty(cVal) ; cRet += CRLF+cVal EndIf EndIf EndIf Return cRet } ... Memo поля неплохо отображаются (ловятся CRLF) [/pre2]
SergKis: PS2. Чуток ошибся не If nRec > 0 , а If nNew > 0 надо в блоке кода
SergKis: SergKis пишет METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ; ... SetToolTip( ::hWnd, cToolTip, hToolTip ) TTM_SetMaxTipWidth( hToolTip, ::nToolTipLen ) IF ISNUMERIC( ::nToolTipTime ) .and. ::nToolTipTime > 0 TTM_SetDelayTime( hToolTip, TTDT_AUTOPOP, ::nToolTipTime * 1000 ) ENDIF if nValue > 0 .and. nValue <= ::nLen Правильнее так сделать (зачеркнутое убрать и добавить метод)[pre2] METHOD ToolTipSet( nToolTipTime, nToolTipLen ) CLASS TSBrowse IF ISNUMERIC( nToolTipLen ) .and. nToolTipLen > 0 ::nToolTipLen := nToolTipLen TTM_SetMaxTipWidth( hToolTip, ::nToolTipLen ) ENDIF IF ISNUMERIC( nToolTipTime ) .and. nToolTipTime > 0 ::nToolTipTime := nToolTipTime TTM_SetDelayTime( hToolTip, TTDT_AUTOPOP, ::nToolTipTime * 1000 ) ENDIF RETURN Nil [/pre2]
gfilatov2002: SergKis пишет: Правильнее так сделать Добавил все эти исправления и дополнения Благодарю за помощь
SergKis: gfilatov2002 Небольшая правка к предыдущему (при первой прорисовке :nRowCount() еще может не определился правильно)[pre2] METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... IF ::lRowPosAtRec IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() ::aRowPosAtRec := Array( ::nRowCount() ) AFILL( ::aRowPosAtRec, 0 ) ENDIF IF ::nLen == 0 .or. xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) ELSEIF ::lIsDbf ; ::aRowPosAtRec[ xRow ] := (::cAlias)->( RecNo() ) ELSEIF ::lIsArr ; ::aRowPosAtRec[ xRow ] := ::nAt ENDIF ENDIF ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... IF ::lRowPosAtRec IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() ::aRowPosAtRec := Array( ::nRowCount() ) AFILL( ::aRowPosAtRec, 0 ) ENDIF IF xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) ELSEIF ::lIsDbf ; ::aRowPosAtRec[ xRow ] := (::cAlias)->( RecNo() ) ELSEIF ::lIsArr ; ::aRowPosAtRec[ xRow ] := ::nAt ENDIF ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: Небольшая правка к предыдущему Принято
SergKis: gfilatov2002 пишет Принято Использовать можно [pre2] DEFINE TBROWSE oBrw AT y,x WIDTH w HEIGHT h CELL ; ... - для массива :lRowPosAtRec := .T. :ToolTipSet(10, 1024) // 10 sek., 1024 buffer :cToolTip := {|ob,x,y| Local cRet := "", xVal, nOld, nNew If ! ISNUMERIC(y) .or. ! ISNUMERIC(x) ; Return cRet EndIf If y > 0 // .and. x == ob:nCell .and. y == ob:nRowPos nNew := ob:aRowPosAtRec[ y ] If nNew > 0 nOld := ob:nAt ob:nAt := nNew xVal := ob:GetValue( x ) ob:nAt := nOld If ISCHAR(xVal) cRet := Trim(xVal) If Len(cRet) < 50 cRet := "" EndIf EndIf EndIf EndIf Return cRet } ... - для dbf :lRowPosAtRec := .T. :ToolTipSet(7, 1024) // 7 sek., 1024 buffer :cToolTip := {|ob,x,y| Local cRet := "", xVal, nRec, nNew If ! ISNUMERIC(y) .or. ! ISNUMERIC(x) ; Return cRet EndIf If y > 0 //.and. x == ob:nCell nNew := ob:aRowPosAtRec[ y ] If nNew > 0 nRec := (ob:cAlias)->( RecNo() ) (ob:cAlias)->( dbGoto( nNew ) ) xVal := ob:GetValue( x ) (ob:cAlias)->( dbGoto( nRec ) ) If ISCHAR(xVal) cRet := Trim(xVal) If Len(cRet) < 50 cRet := "" EndIf EndIf EndIf EndIf Return cRet } ... [/pre2]
Andrey: SergKis пишет: Использовать можно А можно ли организовать таким же образом свой виртуальный массив допустим для цвета ячеек (фона/текст) ? Чтобы потом в ТСБ задавать раскраску каждой ячейки по этому массиву ?
SergKis: Andrey пишет А можно ли организовать таким же образом свой виртуальный массив допустим для цвета ячеек (фона/текст) ? Чтобы потом в ТСБ задавать раскраску каждой ячейки по этому массиву ? Так все в твоих руках[pre2] FOR EACH oCol IN :aColumns oCol:nClrBack := { |nr,nc,ob| Local nClr := CLR_WHITE ... Return nClr } oCol:nClrFore := { |nr,nc,ob| Local nClr := CLR_BLACK ... Return nClr } NEXT [/pre2] В примере с виртуальными колонками ты и делал массивы по строкам с цветами или 0, при 0 вкл. др. алгоритм опр. цвета
SergKis: gfilatov2002 Предложение по работе с memo полем [pre2] CLASS TControl ... DATA oBrw DATA oCol DATA nCol ... METHOD Save() VIRTUAL ... CLASS TSMulti FROM TControl ... METHOD Save() ... METHOD Save() CLASS TSMulti Local cText If ::bSetGet != Nil cText := ::GetText() If Right( cText, 2 ) == CRLF cText := SubStr( cText, 1, Len( cText ) - 2 ) EndIf Eval( ::bSetGet, cText ) If Empty( ::oCol:bEditEnd ) ::oBrw:PostEdit( cText, ::nCol ) EndIf EndIf RETURN Nil METHOD KeyDown( nKey, nFlags ) CLASS TSMulti //Local cText If _GetKeyState( VK_CONTROL ) nKey := If( Upper( Chr( nKey ) ) == "W" .or. nKey == VK_RETURN, VK_TAB, nKey ) EndIf ::nLastKey := nKey If nKey == VK_TAB .or. nKey == VK_ESCAPE If ::lValid() If nKey != VK_ESCAPE ::Save() /* If ::bSetGet != Nil cText := ::GetText() If Right( cText, 2 ) == CRLF cText := SubStr( cText, 1, Len( cText ) - 2 ) EndIf Eval( ::bSetGet, cText ) EndIf */ EndIf ::bLostFocus := Nil Eval( ::bKeyDown, nKey, nFlags, .T. ) EndIf Endif RETURN 0 ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse ... If oCol:oEdit != Nil oCol:oEdit:oBrw := Self oCol:oEdit:oCol := oCol oCol:oEdit:nCol := nCell oCol:oEdit:bLostFocus := { | nKey | ::EditExit( nCell, nKey, uValue, bValid, .F. ) } ... [/pre2] Тогда по Ctrl+W сохраняем в memo, в остальных случаях нет. Если на окне Ctrl+W задействована, то делаем так[pre2] ON KEY CONTROL+W ACTION {|| Local oBrw := This.oBrw.Object If oBrw:IsEdit // tsb field edit oBrw:aColumns[ oBrw:nCell ]:oEdit:Save() oBrw:SetFocus() Else // Window selected _wPost(7, oMain) EndIf Return Nil } [/pre2] Вопрос у меня возникает с If Empty( ::oCol:bEditEnd ) (в методе Save() выделен зеленым цветом), т.к. я не исп. memo поля. Сейчас заданием этого блока производим запись в dbf нового значения, я правильно понимаю ? Если да, то указанная в методе ветка, наверно, нужна. Если нет, то можно If Empty( ::oCol:bEditEnd ) опустить и делать сразу ::oBrw:PostEdit( cText, ::nCol )
SergKis: PS Тут пример https://TransFiles.ru/z8sx0 правда это Mdi интерфейс, но др. у меня нет для работы с memo полями
gfilatov2002: SergKis пишет: Предложение по работе с memo полем Принято с благодарностью SergKis пишет: Тут пример Пример отработал нормально после внесения предложенных изменений Завтра планирую подготовить следующий апдейт со всеми наработками...
gfilatov2002: Как и обещал, выложил 2-й апдейт для сборки 20.08. Благодарю за ваше внимание
Andrey: gfilatov2002 пишет: Как и обещал, выложил 2-й апдейт для сборки 20.08. * New: 'DBF to HTML Wizard' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> Неточность при выводе данных. ДБФ такой структуры: [pre2]{"ID", "+", 4, 0},; {"DT_MODIFY", "=", 8, 0},; {"DT_NEW", "@", 8, 0},; {"DT_DEL", "@", 8, 0},; {"DT_REST", "@", 8, 0},; {"EVENTS", "@", 8, 0},; {"DEVENTS", "D", 8, 0},; {"TEVENTS", "C", 8, 0},;[/pre2] А вывод в html такой : А так пример просто супер ! А другой пример на таком же файле вылетает: [pre2]Application: C:\MiniGUI\SAMPLES\Applications\DBF2XML\Dbf2Xml.exe Error BASE/1132 Bound error: array access Args: [1] = A { ... } length: 5 [2] = N 0 --------------------------------- Stack Trace --------------------------------- Called from GENXML(518) in module: Dbf2Xml.prg Called from (b)MAIN(313) in module: Dbf2Xml.prg Called from _DOCONTROLEVENTPROCEDURE(1901) in module: h_windows.prg Called from EVENTS(1839) in module: h_events.prg Called from DOMESSAGELOOP(0) Called from _ACTIVATEWINDOW(1514) in module: h_windows.prg Called from _ACTIVATEALLWINDOWS(1576) in module: h_windows.prg Called from MAIN(404) in module: Dbf2Xml.prg [/pre2]
SergKis: gfilatov2002 Можете объяснить код в тсб, я не понимаю смысла его [pre2] METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse ... If oCol:bPrevEdit != Nil If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) // append mode for arrays ElseIf nKey != VK_RETURN // GF 15-10-2015 uVar := Eval( oCol:bPrevEdit, uValue, Self, nCell, oCol ) If ValType( uVar ) == "L" .and. ! uVar nKey := VK_RETURN EndIf EndIf EndIf ... METHOD KeyDown( nKey, nFlags ) CLASS TSBrowse ... Case lEditable .and. ( nKey == VK_RETURN .or. nKey == nFireKey ) ... If ::lCellBrw .and. ::aColumns[ nCol ]:lEdit // JP v.1.1 ::Edit( uTemp, nCol, nKey, nFlags ) EndIf ... Пример Advanced\Tsb_array_2\demo.prg добавляем ... DEFINE TBROWSE oBrw ; ... IF oBrw:lEnum oBrw:nHeightSpecHd := oBrw:nHeightCell ENDIF :lNoKeyChar := .T. FOR EACH oCol IN :aColumns oCol:lEdit := .T. oCol:bPrevEdit := {|xv,ob,nc,oc| ? "PrevEdit", nc, oc:cName, xv Return .T. } oCol:bPostEdit := {|xv,ob| Local nc := ob:nCell Local oc := ob:GetColumn(nc) ? "PostEdit", nc, oc:cName, xv Return Nil } NEXT ... [/pre2] По Enter lEdit срабатывает, можем править, но уст. блоки кода игнорируются, т.к. стоит в :Edit() выделенное красным и в :KeyDown() срабатывает показанная ветка
gfilatov2002: SergKis пишет: Можете объяснить код в тсб Если я правильно припоминаю, эта правка блокировала изменение полей типа CheckBox при движении по строке путем нажатия клавиши Enter. В противном случае эти поля легко изменялись невнимательным пользователем, который многократно нажимал Enter. Но, конечно, если у Вас есть другое предложение, как это исправить, то я его с удовольствием использую...
полная версия страницы