Форум » 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. Но, конечно, если у Вас есть другое предложение, как это исправить, то я его с удовольствием использую...
SergKis: gfilatov2002 пишет если у Вас есть другое предложение, как это исправить, то я его с удовольствием использую... Пока не разобрался. В массивах не исп. oCol:bPrevEdit и :bPostEdit до сих пор. Но добавил такое [pre2] CLASS TSColumn ... DATA lEditBox AS LOGICAL INIT .F. // Edit with editbox ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse ... ElseIf ( cType == "C" .and. Chr( 13 ) $ uValue ) .or. cType == "M" .or. oCol:lEditBox IF oCol:lEditBox .and. ! Chr( 13 ) $ uValue uValue := trim( uValue ) ENDIF Default uValue := "" // ЭТО ЛИШНЕЕ т.к. делали Chr( 13 ) $ uValue If ::nMemoHE == Nil ... на dbf отработало нормально Ctlr+W и Esc, а с массивом только в таком варианте (тот же пример) ... 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 oCol := :GetColumn(5) oCol:lEditBox := .T. ON KEY CONTROL+W ACTION {|| Local oBrw := This.oBrw.Object If oBrw:IsEdit // tsb field edit oBrw:aColumns[ oBrw:nCell ]:oEdit:Save() EndIf oBrw:SetFocus() Return Nil } ON KEY ESCAPE ACTION {|| Local oBrw := This.oBrw.Object If oBrw:IsEdit // tsb field edit oBrw:SetFocus() Else ThisWindow.Release EndIf Return Nil } ... [/pre2] Хотел в bPrevEdit и в bPostEdit добавить обработку строки для кол. 5, но блоки не вызвались и первое что увидел блокировка вызова bPrevEdit
gfilatov2002: SergKis пишет: блоки не вызвались и первое что увидел блокировка вызова bPrevEdit Проверил еще раз без этой правки ElseIf nKey != VK_RETURN // GF 15-10-2015 блок bPrevEdit вызывается ДВАЖДЫ
SergKis: gfilatov2002 пишет блок bPrevEdit вызывается ДВАЖДЫ Виноват, не поставил команду в самом начале #define _HMG_OUTLOG потому вывода из блока кода по ? ... и не было блоки кода сработали нормально
SergKis: gfilatov2002 Предлагаю такую работу с memo полями и полями "C" но длинными, не полностью входящие в показ колонки, т.е. поле длинной 200, а показ в 50 символов. Изменения [pre2] CLASS TSColumn ... DATA cEditBoxSep AS STRING INIT "" // editing EditBox line separator DATA nEditBoxWrap AS NUMERIC INIT 0 // editing EditBox line len wrap DATA lEditBoxROnly AS LOGICAL INIT .F. // no editing EditBox - ReadOnly DATA lEditBox AS LOGICAL INIT .F. // editing with editbox ... METHOD Save() CLASS TSMulti LOCAL cText IF ::bSetGet != NIL cText := ::GetText() IF Right( cText, 2 ) == CRLF cText := SubStr( cText, 1, Len( cText ) - 2 ) ENDIF IF ::oCol:lEditBox .and. ! Empty( cText ) .and. CRLF $ cText IF Len( ::oCol:cEditBoxSep ) > 0 cText := StrTran( cText, CRLF, ::oCol:cEditBoxSep ) ELSEIF ::oCol:nEditBoxWrap > 0 cText := StrTran( cText, CRLF, " " ) ENDIF ENDIF Eval( ::bSetGet, cText ) IF Empty( ::oCol:bEditEnd ) ::oBrw:PostEdit( cText, ::nCol ) ENDIF ENDIF RETURN NIL ... METHOD Edit( uVar, nCell, nKey, nKeyFlags, cPicture, bValid, nClrFore, nClrBack ) CLASS TSBrowse ... ElseIf ( cType == "C" .and. Chr( 13 ) $ uValue ) .or. cType == "M" .or. oCol:lEditBox IF oCol:lEditBox .and. ! Empty( uValue := trim( uValue ) ) IF Len( oCol:cEditBoxSep ) > 0 .and. oCol:cEditBoxSep != CRLF ; .and. oCol:cEditBoxSep $ uValue uValue := StrTran( uValue, oCol:cEditBoxSep, CRLF ) ENDIF IF oCol:nEditBoxWrap > 0 cTmp := uValue nK := MLCOUNT( cTmp, oCol:nEditBoxWrap, , .T. ) uValue := "" FOR nI := 1 TO nK uValue += Trim( MEMOLINE( cTmp, oCol:nEditBoxWrap, nI, , .T. ) ) IF nI != nK ; uValue += CRLF ENDIF NEXT ENDIF ENDIF If ::nMemoHE == Nil ... oCol:oEdit := TSMulti():New( nRow, nCol, bSETGET( uValue ), Self, nWidth, nHeight, ; hFont, nClrFore, nClrBack, ::cChildControl, cWnd ) oCol:oEdit:bGotFocus := { || oCol:oEdit:HideSel(), oCol:oEdit:SetPos( 0 ) } lMulti := .T. IF oCol:lEditBoxROnly oCol:oEdit:SendMsg( EM_SETREADONLY, 1, 0 ) ENDIF oCol:oEdit:Hide() ... [/pre2] Пример тут https://TransFiles.ru/vw1pc Открываем файл userlog.dbf в режимах Edit - Yes или No, Смотрим последнюю запись в файле и две последних колонки при нажатии Enter
SergKis: PS В h_tbrowse.prg добавить #define EM_SETREADONLY 207
SergKis: PS2 в примере это строки [pre2] STATIC FUNCTION MdiChildOpen() ... DEFINE TBROWSE oBrw AT y,x WIDTH w HEIGHT h CELL ; ... :Cargo:nMaxMemoCnt := 0 // Max count field memo :Cargo:nMaxCharCol := 50 // Max len char column :Cargo:nMaxLineMem := 10 // Max line for memo edit :Cargo:lEdit := oMain:Cargo:lEdit ... ELSEIF o:cFieldTyp $ "CM" IF o:cFieldTyp == "M" .or. o:nFieldLen > :Cargo:nMaxCharCol o:lEditBox := .T. IF o:cFieldTyp == "M" :nMemoHE := :Cargo:nMaxLineMem :Cargo:nMaxMemoCnt += 1 ELSE o:nEditBoxWrap := :Cargo:nMaxCharCol ENDIF o:nWidth := o:ToWidth( :Cargo:nMaxCharCol ) :Cargo:lToolTipCol := .T. IF ! :Cargo:lEdit o:lEditBoxROnly := .T. o:lEdit := .T. ENDIF ELSE o:nWidth += GetFontWidth("Normal", 1) ENDIF ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: Предлагаю такую работу с memo полями Все изменения приняты. SergKis пишет: Открываем файл userlog.dbf в режимах Edit - Yes или No, Смотрим последнюю запись в файле и две последних колонки при нажатии Enter Пример проверил, работает. Благодарю за помощь
Andrey: SergKis пишет: Открываем файл userlog.dbf в режимах Edit - Yes или No, Смотрим последнюю запись в файле и две последних колонки при нажатии Enter А в карточке редактировать тоже нужно !
SergKis: Andrey пишет А в карточке редактировать тоже нужно ! К тсб, редактирование в карточке полей memo и "длинных" полей "C", не имеет отношения. Надо сделать отдельное MdiChild окно для редактирования с контролом EDITBOX. Изменения выше относятся именно к работе на тсб таблице
gfilatov2002: Выпустил 3-е обновление сборки 20.08 Что нового (на языке оригинала): [pre2] * Fixed: The initial display of the window with a TAB control is not correct if you place a WINDOW PANEL on the second page of the TAB control. That's exists in the official version too. Bug was reported by Hans Marc. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\CONTAINERS\Panel) * New: Added the useful function HMG_DbfStruct(). Syntax: HMG_DbfStruct( cDbfName ) --> aStruct where aStruct is a multidimensional array with database fields structure, which is similar to the output from dbStruct(), but without the need to use the USE command. (see demo in folder \samples\Advanced\Tsb_MoreFields) * Updated: Minor modifications in the MiniGUI core for compatibility with the new Pelles C 10.0 (64-bit) and Harbour 3.2.0dev. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new variables :cEditBoxSep, :nEditBoxWrap, :lEditBoxROnly and :lEditBox in the TSColumn class. Contributed by Sergej Kiselev (see demo in folder \samples\Advanced\Tsb_DemoMDI) * New: 'Charts SQLITE3' sample is based on using of the SQLite ODBC Driver from http://www.ch-werner.de/sqliteodbc/. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\Charts_4) * New: 'Test Directory List with System Icons' sample. Based upon a contribution of HMG user Jimmy. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\FILEICON) * New: 'TBrowse speed test with multiple fields' samples. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Advanced\Tsb_MoreFields) * Updated: 'DBF to HTML Wizard' sample: - added using of Bootstrap and jQuery frameworks. Contributed by Marcos Jarrin Pita (see in folder \samples\Applications\Dbf2Html) [/pre2] Благодарю всех, кто поддерживал и поддерживает этот проект "на плаву"
Andrey: gfilatov2002 пишет: Выпустил 3-е обновление сборки 20.08 Что то пример SAMPLES\Advanced\FILEICON не собирается... [pre2]Harbour 3.2.0dev (r2008190002) Copyright (c) 1999-2020, https://harbour.github.io/ C:\Users\Andrey\AppData\Local\Temp\hbmk_vzy17f.dir\FILEICON.c: C:\Users\Andrey\AppData\Local\Temp\hbmk_vzy17f.dir\HB_FUNC.c: Error E2209 HB_FUNC.PRG 4: Unable to open include file 'ShObjIdl.h' Error E2451 HB_FUNC.PRG 11: Undefined symbol 'SHFILEINFO' in function HB_FUN_GETICOINDEX Error E2379 HB_FUNC.PRG 11: Statement missing ; in function HB_FUN_GETICOINDEX Error E2451 HB_FUNC.PRG 13: Undefined symbol 'sfi' in function HB_FUN_GETICOINDEX Error E2109 HB_FUNC.PRG 13: Not an allowed type in function HB_FUN_GETICOINDEX Error E2451 HB_FUNC.PRG 13: Undefined symbol 'SHGFI_ICON' in function HB_FUN_GETICOINDEX Warning W8065 HB_FUNC.PRG 13: Call to function 'SHGetFileInfo' with no prototype in function HB_FUN_GETICOINDEX Warning W8004 HB_FUNC.PRG 16: 'nSize' is assigned a value that is never used in function HB_FUN_GETICOINDEX Error E2147 HB_FUNC.PRG 56: 'HIMAGELIST' cannot start a parameter declaration Error E2303 HB_FUNC.PRG 56: Type name expected *** 8 errors in Compile *** C:\Users\Andrey\AppData\Local\Temp\hbmk_ir7be9.c: hbmk2[FILEICON]: Error: Running C/C++ compiler. 1[/pre2] Может из за того что сижу на BCC 5.5.1 ?
gfilatov2002: Выпустил 4-е обновление сборки 20.08 Что нового (на языке оригинала): [pre2] * Fixed: The default backcolor of Label, CheckBox and RadioGroup controls is not correct if you place a WINDOW PANEL into the TAB control. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\CONTAINERS\Panel) * Fixed: Wrong GETBOX update behavior when user entered an invalid date value (there is no way to correct it via program action). Bug was reported by Pierpaolo Martinello. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Enhanced: The DATEPICKER supports the colors definition for a dropdown MonthCalendar in the THEMED Operating Systems. It was a postponed user's request. Based upon a contribution of HMG user Jimmy. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\DatePicker) * Enhanced: The MONTHCAL control allows the display of days in BOLD. There are three auxiliary functions for above feature handling: - AddMonthCalBoldDay( ControlName, ParentName, dDate ); - DelMonthCalBoldDay( ControlName, ParentName, dDate ); - IsMonthCalBoldDay( ControlName, ParentName, dDate ). Based upon a code borrowed from OOHG. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see month.prg in folder \samples\Basic\MONTHCAL) * New: 'Testing columns in Tsbrowse for DBF file' sample. Contributed by Sergej Kiselev and Verchenko Andrey (see in folder \samples\Advanced\Tsb_2tables) * New: 'Virtual columns in Tsbrowse for DBF file' sample. Contributed by Sergej Kiselev and Verchenko Andrey (see in folder \samples\Advanced\Tsb_VirtualColumn) * Updated: 'Month calendar control test' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo.prg in folder \samples\Basic\MONTHCAL) There is a "last-minute" improvement also: * Enhanced: The MONTHCAL control will be adjusted correctly by width and height after assigning a FontName and/or FontSize at runtime. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see month.prg in folder \samples\Basic\MONTHCAL) [/pre2]
Haz: gfilatov2002 пишет: Выпустил 4-е обновление сборки 20.08 Что нового (на языке оригинала): На языке оригинала язык не поворачивается сказать Давно не обновлял, в начале недели обновил на одну из последних сборок и началось .... Проблема в слетевших ::cPicture по умолчанию , все строковые колонки во всех TSB были обрезаны и если пользователь их начал редактировать - резались данные. Для начала в спешке прописал ::cPicture по всему коду, где не указано явно. Затем выдохнул и принялся изучать причину, а она простая: у меня базы в ADT формате (ADS), этот формат проходит проверку IsDbf(), но типы символьных полей вариативны ( не тупо равно "C"). В новых сборках пикча назначается в ::LoadFields() как [pre2] ... aStru := ( cAlias )->( DbStruct() ) ... cType := aStru[ nE, 2 ] If cType == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType == "N" ... [/pre2] и поскольку в качестве типа символьного поля я использую "CICHARACTER" , а типа "C" в ADS просто нет, то поимел танцы. почему бы при формировании пикчи вместо cType := aStru[ nE, 2 ] не использовать значение из поля а не из структуры примерно так cType := ValType( (cAlias)->&(aStru[ nE, 1 ])) или cType := ValType( (cAlias)->(FieldGet(nE)) ?
SergKis: Haz пишет В новых сборках пикча назначается в ::LoadFields() как ... aStru := ( cAlias )->( DbStruct() ) ... cType := aStru[ nE, 2 ] If cType == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType == "N" ... смотрю версию 2.07 от 2012 года там в LoadFields aStru := ( cAlias )->( DbStruct() ) и cType := aStru[ nE, 2 ] If cType == "C" cPicture := "@K "+Replicate('X', aStru[ nE, 3 ] ) ElseIf cType == "N" ... т.е. это историческая данность, а valtype не везде даст то что надо с новыми типами полей, наверно, надо усложнять проверку, но инициатива от тебя, т.к. я не работаю с ADS
gfilatov2002: Haz пишет: почему бы при формировании пикчи вместо cType := aStru[ nE, 2 ] не использовать значение из поля а не из структуры примерно так cType := ValType( (cAlias)->&(aStru[ nE, 1 ])) или cType := ValType( (cAlias)->(FieldGet(nE)) ? Благодарю за предложение Поправил, конечно Обидно, что именно так сделано в методе :LoadRelated(), а в методе :LoadFields() тип берется из массива aStru у оригинального автора библиотеки
Haz: gfilatov2002 пишет: Поправил, конечно Там ниже на пару строк в исходнике тоже из структуры, может и там поправить ? Странно что до последних обновлений все работало корректно, если это от автора изменения .
Haz: gfilatov2002 пишет: Поправил, конечно Там ниже на пару строк в исходнике тоже из структуры, может и там поправить ? Странно что до последних обновлений все работало корректно, если это от автора изменения .
gfilatov2002: Haz пишет: может и там поправить ? Привожу полный текст исправленного метода для проверки: [pre]* ============================================================================ * METHOD TSBrowse:LoadFields() Version 9.0 Nov/30/2009 // modified by SergKis * ============================================================================ METHOD LoadFields( lEditable, aColSel, cAlsSel, aNameSel, aHeadSel ) CLASS TSBrowse Local n, nE, cHeading, nAlign, nSize, cData, cType, nDec, hFont, cPicture, ; cBlock, nCols, aNames, cKey, ; aColSizes := ::aColSizes, ; cOrder, nEle, ; cAlias, cName, aStru, ; aAlign := { "LEFT", "CENTER", "RIGHT", "VERT" } Local cTmp, cHead, hFontH Default lEditable := ::lEditable, ; aColSizes := {} cAlias := iif( HB_ISCHAR( cAlsSel ), cAlsSel, ::cAlias ) aStru := ( cAlias )->( DbStruct() ) aNames := iif( HB_ISARRAY( aColSel ), aColSel, ::aColSel ) nCols := iif( aNames == Nil, ( cAlias )->( FCount() ), Len( aNames ) ) aColSizes := iif( Len( ::aColumns ) == Len( aColSizes ), Nil, aColSizes ) For n := 1 To nCols nE := iif( aNames == Nil, n, ( cAlias )->( FieldPos( aNames[ n ] ) ) ) If ValType( ::aHeaders ) == "A" .and. ! Empty( ::aHeaders ) .and. n <= Len( ::aHeaders ) cHeading := ::aHeaders[ n ] cHead := cHeading Else cHeading := ::Proper( ( cAlias )->( Field( nE ) ) ) EndIf If HB_ISARRAY( aHeadSel ) .and. Len( aHeadSel ) > 0 .and. n <= Len( aHeadSel ) .and. aHeadSel[ n ] != Nil cHeading := aHeadSel[ n ] cHead := cHeading EndIf If CRLF $ cHeading cData := "" FOR EACH cTmp IN hb_ATokens( cHeading, CRLF ) IF Len( cTmp ) > Len( cData ) cData := cTmp EndIf NEXT cHeading := cData cData := NIL EndIf If ( nEle := AScan( ::aTags, {|e| Upper( cHeading ) $ Upper( e[ 2 ] ) } ) ) > 0 cOrder := ::aTags[ nEle, 1 ] cKey := ( cAlias )->( OrdKey() ) If Upper( cHeading ) $ Upper( cKey ) ::nColOrder := iif( Empty( ::nColOrder ), Len( ::aColumns ) + 1, ::nColOrder ) EndIf Else cOrder := "" EndIf nAlign := iif( ::aJustify != Nil .and. Len( ::aJustify ) >= nE, ::aJustify[ nE ], ; iif( ( cAlias )->( ValType( FieldGet( nE ) ) ) == "N", 2, ; iif( ( cAlias )->( ValType( FieldGet( nE ) ) ) $ "DL", 1, 0 ) ) ) nAlign := iif( ValType( nAlign ) == "L", iif( nAlign, 2, 0 ), ; iif( ValType( nAlign ) == "C", AScan( aAlign, nAlign ) - 1, nAlign ) ) nSize := iif( ! aColSizes == Nil .and. Len( aColsizes ) >= nE, aColSizes[ nE ], Nil ) cData := ( cAlias )->( FieldGet( nE ) ) cType := ValType( cData ) If cType == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType == "N" cPicture := Replicate( '9', aStru[ nE, 3 ] ) If aStru[ nE, 4 ] > 0 cPicture := SubStr( cPicture, 1, aStru[ nE, 3 ]-aStru[ nE, 4 ] - 1 ) + '.' + Replicate( '9', aStru[ nE, 4 ] ) EndIf cPicture := "@K " + cPicture ElseIf cType $ "^+" cPicture := Replicate( '9', 10 ) EndIf If nSize == Nil nSize := aStru[ nE, 3 ] nDec := aStru[ nE, 4 ] hFont := iif( ::hFont != Nil, ::hFont, 0 ) hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) If cType == "C" cData := PadR( Trim( cData ), nSize, "B" ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "N" cData := StrZero( cData, nSize, nDec ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "D" cData := cValToChar( iif( Empty( cData ), Date(), cData ) ) nSize := Int( GetTextWidth( 0, cData + "BB", hFont ) ) + iif( lEditable, 30, 0 ) ElseIf cType == "M" nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) ElseIf cType $ "=@T" nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) ElseIf cType $ "^+" nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) Else cData := cValToChar( cData ) nSize := GetTextWidth( 0, cData, hFont ) EndIf nSize := Max( GetTextWidth( 0, Replicate( "B", Len( cHeading ) + 1 ), hFontH ), nSize ) nSize += iif( ! Empty( cOrder ), 14, 0 ) ElseIf ValType( ::aColSizes ) == "A" .and. ! Empty( ::aColSizes ) .and. n <= Len( ::aColSizes ) nSize := ::aColSizes[ n ] EndIf If ValType( ::aColSizes ) == "A" .and. n <= Len( ::aColSizes ) .and. Empty( ::aColSizes[ n ] ) ::aColSizes[ n ] := nSize EndIf If ValType( ::aFormatPic ) == "A" .and. ! Empty( ::aFormatPic ) .and. n <= Len( ::aFormatPic ) cPicture := ::aFormatPic[ n ] EndIf If HB_ISCHAR( cHead ) cHeading := cHead EndIf cBlock := 'FieldWBlock("' + aStru[ nE, 1 ] + '",Select("' + cAlias + '"))' ::AddColumn( TSColumn():New( cHeading, FieldWBlock( aStru[ nE, 1 ], Select( cAlias ) ),cPicture, ; { ::nClrText, ::nClrPane }, { nAlign, DT_CENTER }, nSize,, lEditable,,, cOrder,,,, ; 5,,,, Self, cBlock ) ) cName := ( cAlias )->( FieldName( nE ) ) ATail( ::aColumns ):cData := cAlias + "->" + FieldName( nE ) ATail( ::aColumns ):cArea := cAlias // 06.08.2019 ATail( ::aColumns ):cField := ( cAlias )->( FieldName( nE ) ) // 08.06.2018 ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ] // 18.07.2018 ATail( ::aColumns ):nFieldLen := aStru[ nE, 3 ] // 18.07.2018 ATail( ::aColumns ):nFieldDec := aStru[ nE, 4 ] // 18.07.2018 If HB_ISARRAY( aNameSel ) .and. Len( aNameSel ) > 0 .and. n <= Len( aNameSel ) If HB_ISCHAR( aNameSel[ n ] ) .and. ! Empty( aNameSel[ n ] ) cName := aNameSel[ n ] EndIf EndIf ATail( ::aColumns ):cName := cName If cType == "L" ATail( ::aColumns ):lCheckBox := .T. EndIf If ! Empty( cOrder ) ATail( ::aColumns ):lIndexCol := .T. EndIf Next If ::nLen == 0 cAlias := ::cAlias ::nLen := iif( ::bLogicLen == Nil, Eval( ::bLogicLen := {||( cAlias )->( LastRec() ) } ), Eval( ::bLogicLen ) ) EndIf Return Self [/pre]
Haz: gfilatov2002 пишет: Привожу полный текст исправленного метода для проверки: Все отлично единственное под сомнением это [ ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ]
SergKis: Haz пишет единственное под сомнением это [ ATail( ::aColumns ):cFieldTyp := aStru[ nE, 2 ] Это не должно вызывать сомнения, т.к. это для customer использования, т.е. привязка к реальному типу поля Сомнения вызывают Valtype(от полей ^+) они дадут "N" ((возможно еще есть какие варианты, не помню) и это надо учитывать тут [pre2] If cType == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType == "N" .and. aStru[ nE, 2 ] $ "^+" cPicture := Replicate( '9', 10 ) ElseIf cType == "N" cPicture := Replicate( '9', aStru[ nE, 3 ] ) If aStru[ nE, 4 ] > 0 cPicture := SubStr( cPicture, 1, aStru[ nE, 3 ]-aStru[ nE, 4 ] - 1 ) + '.' + Replicate( '9', aStru[ nE, 4 ] ) EndIf cPicture := "@K " + cPicture EndIf [/pre2]
gfilatov2002: SergKis пишет: это надо учитывать Поправил этот код. Благодарю за помощь
SergKis: PS Для поля "M" получим valtype() -> "C" и не попадем на веточку [pre2] ElseIf cType == "M" nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) [/pre2], для "=@" получим "T", но это, наверно, нормально веточка сработает[pre2] ElseIf cType $ "=@T" nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) а ElseIf cType $ "^+" nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) не сработает [/pre2] т.е. в целом нужна большая переработка, но можно пойти др. путем Игорь, какой тип получаем в структуре aStru[ nE, 2 ] для поля "CICHARACTER" U или пусто ? Может Valtype делать для таких полей (с неопределенной структурой) и для них делать Valtype() и результат заносить в aStru[ nE, 2 ], тогда метод не меняется практически
SergKis: PS тогда, наверно, придется определять и aStru[ nE, 3 ] и aStru[ nE, 4 ], но в методе дальше ничего не меняется
SergKis: PS2 Как то так получится [pre2] cType := aStru[ nE, 2 ] IF Empty(cType) .or. cType == "U" cData := ( cAlias )->( FieldGet( nE ) ) aStru[ nE, 2 ] := Valtype( cData ) cType := aStru[ nE, 2 ] IF cType == "C" aStru[ nE, 3 ] := Len( cData ) aStru[ nE, 4 ] := 0 ELSE // тут смотреть твои (ADS) варианты и добавить ENDIF ENDIF [/pre2]
Haz: SergKis пишет: какой тип получаем в структуре aStru[ nE, 2 ] для поля "CICHARACTER" Dbstruct() возвратит именно CICHARACTER , valtype() вернет С. В ADS есть и другие символьные поля это просто CHAR и VARCHAR! но valtype() справедливо вернет С. Тоже касается поля с автоинкрементом в ADS это AUTUINC , valtype вернет N, есть поле дата время TIMESTAMP , valtype его вернет как T (тут надо проверить ) Могу прописать по аналогии с dbf кусок кода для ADS с особенностями его типов полей. Вроде это пока единственный rdd выбивающийся из структуры классического dbf. Но с другой стороны логичнее все же привязываться к типам данных которые знает харбур , а не дергать их из структуры. То есть, valtype будет универсальнее чем dbsruct()
SergKis: Haz пишет Могу прописать по аналогии с dbf кусок кода для ADS с особенностями его типов полей. Вроде это пока единственный rdd выбивающийся из структуры классического dbf. Но с другой стороны логичнее все же привязываться к типам данных которые знает харбур , а не дергать их из структуры. То есть, valtype будет универсальнее чем dbsruct() Думаю, надо прописать (или определять весь список полей dbf), будет правильнее, т.к. лучше понимать ситуацию. Можно даже завести переменную hash в классе для такого списка с "правильной" перекодировкой. Ведь надо еще правильно формировать aStru[ nE, 3\4 ]. От полученного значения (cAlias)->(FieldGet(nE)) может возникать вариантность этих значений. ADS все таки RDD и сделать такую штуку, включив в тсб - нормальное решение
SergKis: Haz пишет То есть, valtype будет универсальнее чем dbsruct() Так и будем прыгать сначала от valtype, но для определения cType и nLen, nDec для работы метода. Если dbStruct() дает правильные типы в aStru, то их можно оставлять для :cFieldTyp, :cFieldLen, :cFieldDec для правильной привязки к полю.
Haz: SergKis пишет: надо прописать (или определять весь список полей dbf), будет правильнее в понедельник с работы пропишу
Haz: SergKis пишет: смотрю версию 2.07 от 2012 года там в LoadFields aStru := ( cAlias )->( DbStruct() ) и Тогда не пойму в чем дело. Последний раз обновлял сборку примерно полгода-год назад. Все строковые данные отображались корректно по колонкам где пикчи не было. Пару дней назад перешёл на последнюю сборку, записал проект в работу и посыпались жалобы. По коду только на loadfilds похоже, что еще может быть не пойму. В проекте после примерно 50 правок явного указания пикчи устал и просто в функцию создающую tsb после определения бровса добавил код который указал выше для символьных полей. Все заработало. Но вот если это тянется с 2012 года, я реально не понимаю что случилось
gfilatov2002: SergKis пишет: Так и будем прыгать сначала от valtype, но для определения cType и nLen, nDec для работы метода. Для того, чтобы сделать этот код универсальным, записал в методе так: [pre2] cData := ( cAlias )->( FieldGet( nE ) ) cType := ValType( cData ) If cType == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType == "N" .and. aStru[ nE, 2 ] $ "^+" cPicture := Replicate( '9', 10 ) ElseIf cType == "N" cPicture := Replicate( '9', aStru[ nE, 3 ] ) If aStru[ nE, 4 ] > 0 cPicture := SubStr( cPicture, 1, aStru[ nE, 3 ]-aStru[ nE, 4 ] - 1 ) + '.' + Replicate( '9', aStru[ nE, 4 ] ) EndIf cPicture := "@K " + cPicture EndIf If nSize == Nil cType := aStru[ nE, 2 ] nSize := aStru[ nE, 3 ] nDec := aStru[ nE, 4 ] hFont := iif( ::hFont != Nil, ::hFont, 0 ) hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) If cType == "C" cData := PadR( Trim( cData ), nSize, "B" ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "N" cData := StrZero( cData, nSize, nDec ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "D" cData := cValToChar( iif( Empty( cData ), Date(), cData ) ) nSize := Int( GetTextWidth( 0, cData + "BB", hFont ) ) + iif( lEditable, 30, 0 ) ElseIf cType == "M" nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) ElseIf cType $ "=@T" nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) ElseIf cType $ "^+" nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) Else cData := cValToChar( cData ) nSize := GetTextWidth( 0, cData, hFont ) EndIf ... [/pre2]
Haz: Григорий, видимо для универсальности нужно будет явно прописать типы ads. Их там гораздо больше чем в dbf. http://devzone.advantagedatabase.com/dz/webhelp/advantage7.1/server1/adt_field_types_and_specifications.htm В понедельник пришлю правку подних (дома нет компа ). За основу возьму код последним выложенный здесь . Заодно попрошу обновить библиотеку ads, в поставке она устарела . последняя версия ads v12 . именно на ней sap похоронил этот продукт после покупки. Библиотеку под 12 для bcc тоже вышлю
SergKis: gfilatov2002 пишет [pre2] cData := ( cAlias )->( FieldGet( nE ) ) cType := ValType( cData ) If cType == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType == "N" .and. aStru[ nE, 2 ] $ "^+" cPicture := Replicate( '9', 10 ) ElseIf cType == "N" cPicture := Replicate( '9', aStru[ nE, 3 ] ) If aStru[ nE, 4 ] > 0 cPicture := SubStr( cPicture, 1, aStru[ nE, 3 ]-aStru[ nE, 4 ] - 1 ) + '.' + Replicate( '9', aStru[ nE, 4 ] ) EndIf cPicture := "@K " + cPicture EndIf If nSize == Nil cType := aStru[ nE, 2 ] nSize := aStru[ nE, 3 ] nDec := aStru[ nE, 4 ] hFont := iif( ::hFont != Nil, ::hFont, 0 ) hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) If cType == "C" cData := PadR( Trim( cData ), nSize, "B" ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "N" ... [/pre2] 1. Предлагаю убрать выделенное синим цветом, т.к. если задан массив размеров, то из него не правильно берется размер, для всех колонок и тогда всегда надо делать переустановку. Если убрать, то формируются данные из структуры dbf и это более точно получается, но поправить потом можно. У себя убрал это давно 2. Предложенное не подойдет, т.к. CICHARACTER в cType := aStru[ nE, 2 ] после If nSize == Nil не сработает If cType == "C" На мой взгляд надо, сто то такое[pre2] cType := aStru[ nE, 2 ] If Len(cType) > 1 If cType == ""AUTOINC cType := "^" Else cType := Valtype( (cAlias)->(FieldGet(nE)) ) EndIf // может еще варианты, Игорь должен подсказать EndIf [/pre2] Тогда в aStru[ nE, 2 ] будет реальный тип и попадет в :cFieldTyp, а логика отработает в методе нормально. Надо посмотреть на Len и Dec в aStru, если они нормальные, то они отработают ок
SergKis: Haz пишет За основу возьму код последним выложенный здесь Надо брать код из либы последней, выложенный на основе valtype будет работать неверно
Haz: SergKis пишет: Надо брать код из либы последней, Договорились.
Haz: SergKis пишет: Надо брать код из либы последней, выложенный на основе valtype будет работать неверно Примерно так получилось, можно было на хеш массиве сделать , но выигрыша в скорости на таком коротком не будет Далее по коду ищется в массиве aType значение из dbstruct, а возвращается соответствующее valtype [pre2] local aType := {} aType := {} aAdd( aType, {"CICHARACTER", "C"} ) // CiCharacter aAdd( aType, {"C", "C"} ) // Character aAdd( aType, {"C:U", "C"} ) // nChar aAdd( aType, {"C:B", "C"} ) // Raw aAdd( aType, {"Q", "C"} ) // VarCharFox aAdd( aType, {"Q:U", "C"} ) // nVarChar aAdd( aType, {"Q:B", "C"} ) // VarBinaryFox aAdd( aType, {"D", "D"} ) // Date aAdd( aType, {"T", "T"} ) // Time aAdd( aType, {"@", "T"} ) // TimeStamp aAdd( aType, {"=", "T"} ) // ModTime aAdd( aType, {"I", "N"} ) // Integer, ShortInt, LongInt aAdd( aType, {"B", "N"} ) // Double aAdd( aType, {"+", "N"} ) // Autoinc aAdd( aType, {"N", "N"} ) // Numeric aAdd( aType, {"Y", "N"} ) // Money aAdd( aType, {"Z", "N"} ) // Curdouble aAdd( aType, {"^", "N"} ) // RowVersion aAdd( aType, {"M", "M"} ) // Memo aAdd( aType, {"M:U", "M"} ) // nMemo aAdd( aType, {"W", "M"} ) // Binary aAdd( aType, {"P", "M"} ) // Image aAdd( aType, {"L", "L"} ) // If aType[Ascan( aType, {|e| e[1] == cType })][2] == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] == "N" cPicture := Replicate( '9', aStru[ nE, 3 ] ) If aStru[ nE, 4 ] > 0 cPicture := SubStr( cPicture, 1, aStru[ nE, 3 ]-aStru[ nE, 4 ] - 1 ) + '.' + Replicate( '9', aStru[ nE, 4 ] ) EndIf cPicture := "@K " + cPicture ElseIf cType $ "^+" cPicture := Replicate( '9', 10 ) EndIf If nSize == Nil cData := ( cAlias )->( FieldGet( nE ) ) cType := aStru[ nE, 2 ] nSize := aStru[ nE, 3 ] nDec := aStru[ nE, 4 ] hFont := iif( ::hFont != Nil, ::hFont, 0 ) hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) If aType[Ascan( aType, {|e| e[1] == cType })][2] == "C" cData := PadR( Trim( cData ), nSize, "B" ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] == "N" cData := StrZero( cData, nSize, nDec ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] == "D" cData := cValToChar( iif( Empty( cData ), Date(), cData ) ) nSize := Int( GetTextWidth( 0, cData + "BB", hFont ) ) + iif( lEditable, 30, 0 ) ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] == "M" nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) ElseIf aType[Ascan( aType, {|e| e[1] == cType })][2] == "T" nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) ElseIf cType $ "^+" nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) Else cData := cValToChar( cData ) nSize := GetTextWidth( 0, cData, hFont ) EndIf nSize := Max( GetTextWidth( 0, Replicate( "B", Len( cHeading ) + 1 ), hFontH ), nSize ) nSize += iif( ! Empty( cOrder ), 14, 0 ) ElseIf ValType( ::aColSizes ) == "A" .and. ! Empty( ::aColSizes ) .and. n <= Len( ::aColSizes ) nSize := ::aColSizes[ n ] EndIf [/pre2]
Haz: Haz пишет: aType[Ascan( aType, {|e| e[1] == cType })][2] Думаю этот код нужно выполнить до сравнения один раз с проверкой на возврат нуля, иначе будет вылет если dbstruct вернет не прописанный в массиве тип
gfilatov2002: Haz пишет: Примерно так получилось Вынес поиск в массиве в статическую функцию GetDbfFieldType() и записал этот фрагмент таким образом: [pre2] cType := aStru[ nE, 2 ] If GetDbfFieldType( cType ) == "C" cPicture := "@K " + Replicate( 'X', aStru[ nE, 3 ] ) ElseIf cType $ "^+" cPicture := Replicate( '9', 10 ) ElseIf GetDbfFieldType( cType ) == "N" cPicture := Replicate( '9', aStru[ nE, 3 ] ) If aStru[ nE, 4 ] > 0 cPicture := SubStr( cPicture, 1, aStru[ nE, 3 ]-aStru[ nE, 4 ] - 1 ) + '.' + Replicate( '9', aStru[ nE, 4 ] ) EndIf cPicture := "@K " + cPicture EndIf If nSize == Nil cData := ( cAlias )->( FieldGet( nE ) ) cType := GetDbfFieldType( aStru[ nE, 2 ] ) nSize := aStru[ nE, 3 ] nDec := aStru[ nE, 4 ] hFont := iif( ::hFont != Nil, ::hFont, 0 ) hFontH := iif( ::hFontHead != Nil, ::hFontHead, ::hFont ) If cType == "C" cData := PadR( Trim( cData ), nSize, "B" ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf aStru[ nE, 2 ] $ "^+" nSize := GetTextWidth( 0, Replicate( "9", 10 ), hFont ) ElseIf cType == "N" cData := StrZero( cData, nSize, nDec ) nSize := GetTextWidth( 0, cData, hFont ) ElseIf cType == "D" cData := cValToChar( iif( Empty( cData ), Date(), cData ) ) nSize := Int( GetTextWidth( 0, cData + "BB", hFont ) ) + iif( lEditable, 30, 0 ) ElseIf cType == "M" nSize := iif( ::nMemoWV == Nil, 200, ::nMemoWV ) ElseIf cType == "T" nSize := GetTextWidth( 0, Replicate( "9", 24 ), hFont ) Else cData := cValToChar( cData ) nSize := GetTextWidth( 0, cData, hFont ) EndIf nSize := Max( GetTextWidth( 0, Replicate( "B", Len( cHeading ) + 1 ), hFontH ), nSize ) nSize += iif( ! Empty( cOrder ), 14, 0 ) ElseIf ValType( ::aColSizes ) == "A" .and. ! Empty( ::aColSizes ) .and. n <= Len( ::aColSizes ) nSize := ::aColSizes[ n ] EndIf [/pre2]Благодарю за помощь
SergKis: Haz пишет код нужно выполнить до сравнения один раз с проверкой на возврат нуля, иначе будет вылет если dbstruct вернет не прописанный в массиве тип Предлагаю так (можно будет расширять список, если что)[pre2] DATA aFieldTypes AS ARRAY INIT { ; {"CICHARACTER", "C"}, ; // CiCharacter {"C", "C"}, ; // Character {"C:U", "C"}, ; // nChar {"C:B", "C"}, ; // Raw {"Q", "C"}, ; // VarCharFox {"Q:U", "C"}, ; // nVarChar {"Q:B", "C"}, ; // VarBinaryFox {"D", "D"}, ; // Date {"T", "T"}, ; // Time {"@", "T"}, ; // TimeStamp {"=", "T"}, ; // ModTime {"I", "N"}, ; // Integer, ShortInt, LongInt {"B", "N"}, ; // Double {"+", "N"}, ; // Autoinc {"N", "N"}, ; // Numeric {"Y", "N"}, ; // Money {"Z", "N"}, ; // Curdouble {"^", "N"}, ; // RowVersion {"M", "M"}, ; // Memo {"M:U", "M"}, ; // nMemo {"W", "M"}, ; // Binary {"P", "M"}, ; // Image {"L", "L"} ; // } Local aType := ::aFieldTypes, nType ... cType := aStru[ nE, 2 ] IF ( nType := Ascan( aType, {|e| e[1] == cType }) ) > 0 cType := aType[nType ][2] ENDIF ... Далее по тексту метода, как был [/pre2]
Haz: SergKis пишет: Предлагаю так (можно будет расширять список, если что) Согласен, погоняю еще позже отпишусь . Сейчас занят очень
gfilatov2002: SergKis пишет: Предлагаю так Принято, тестовый пример отработал нормально Благодарю за помощь
Haz: SergKis пишет: IF ( nType := Ascan( aType, {|e| e[1] == cType }) ) > 0 cType := aType[nType ][2] ENDIF Сергей, тогда потеряется это [pre2] ElseIf cType $ "^+" cPicture := Replicate( '9', 10 ) EndIf [/pre2]
SergKis: Haz пишет тогда потеряется это По правильному, надо выкинуть из массива стандартные значения, т.е. {"C", "C"}, ; // Character {"D", "D"}, ; // Date {"T", "T"}, ; // Time {"@", "T"}, ; // TimeStamp {"=", "T"}, ; // ModTime {"+", "N"}, ; // Autoinc {"^", "N"}, ; // RowVersion {"M", "M"}, ; // Memo {"L", "L"} ; // т.к. они будут браться из aStru[ nE, 2 ], не дали дописать, отвлекли
Haz: SergKis пишет: надо выкинуть из массива стандартные значения Сергей я бы оставил. Так как в этом массиве? Будет ещё и тип valtype. Может пригодиться
SergKis: Haz пишет Сергей я бы оставил. Так как в этом массиве? Будет ещё и тип valtype. Может пригодиться Мне кажется это лишнее оставлять. Если убрать, то не теряются += и т.д., но если самому поставить свое значение, то оно сработает перекодировкой вместо стандартного. Т.е. мы ничего не теляем В каком виде будет valtype ? Если в виде массива (второй элемент), то тогда наверно надо идти путем бока кода второй элемент и анализ возврата, если это массив, то возвращается Type и Valtype ..., хотя не знаю надо ли ?
SergKis: PS С Valtype можно попробовать следующее [pre2] If nSize == Nil cData := ( cAlias )->( FieldGet( nE ) ) // убрать совсем cType := aStru[ nE, 2 ] IF cType != Valtype( cData ) .and. nType > 0 cType := Valtype( cData ) ENDIF nSize := aStru[ nE, 3 ] nDec := aStru[ nE, 4 ] ... [/pre2]
Haz: SergKis пишет: В каком виде будет valtype пока тоже не уверен как можно использовать. Просто в одном массиве соответствие всех типов для dbstruct и valtype
gfilatov2002: SergKis пишет: // убрать совсем cType := aStru[ nE, 2 ] IF cType != Valtype( cData ) .and. nType > 0 cType := Valtype( cData ) ENDIF Ok, так и сделал
Haz: Григорий, Можно в сборке обновить rddads.lib до версии 12 Собрано под bcc82 https://drive.google.com/file/d/1TKuIGuCBsMjVe1b57IOipY8IJs9m1SYX/view?usp=sharing
gfilatov2002: Haz пишет: обновить rddads.lib до версии 12 Сделаю, конечно Благодарю за помощь
gfilatov2002: Выпустил 5-е обновление сборки 20.08 со всеми последними наработками
Haz: Предлагаю еще одну проблемку обсудить. Суть в том то TSBrowse прорисовывается 2 раза Первый раз тут [pre2] FUNCTION _EndTBrowse( bEnd ) *-----------------------------------------------------------------------------* LOCAL i, oBrw LOCAL oc := NIL, ow := NIL #ifdef _OBJECT_ ow := oDlu2Pixel() #endif IF _HMG_BeginTBrowseActive i := AScan( _HMG_aControlHandles, _HMG_ActiveTBrowseHandle ) IF i > 0 oBrw := _HMG_aControlIds[ i ] oBrw:lRePaint := .T. oBrw:Display() _HMG_ActiveTBrowseName := "" _HMG_ActiveTBrowseHandle := 0 _HMG_BeginTBrowseActive := .F. #ifdef _OBJECT_ IF _HMG_lOOPEnabled ow := _WindowObj( _HMG_aControlParenthandles[ i ] ) oc := _ControlObj( _HMG_aControlHandles [ i ] ) ENDIF #endif Do_ControlEventProcedure( bEnd, i, oBrw, ow, oc ) ENDIF ENDIF RETURN NIL [/pre2] Второй раз из hantleevent по событию UPDATEWINDOW чтобы это увидеть достаточно добавить в TSBrowse:DrawLine() [pre2] Default xRow := iif( ::lDrawHeaders, Max( 1, nRowPos ), nRowPos ), lDrawCell := ::lDrawLine StrFile( hb_ntoc(++ nCount) + Chr(9) + hb_ntoc(xRow) + chr(9) + Procname(0) + hb_ntoc(ProcLine(0)) + chr(9) + Procname(1) + hb_ntoc(ProcLine(1)) + chr(9) + Procname(2) + hb_ntoc(ProcLine(2)) + chr(9) + Procname(3) + hb_ntoc(ProcLine(3)) + chr(9) + Procname(4) + hb_ntoc(ProcLine(4)) + chr(9) + Procname(5) + hb_ntoc(ProcLine(5)) + chr(9) + hb_eol(), "_DrawLine", .t. ) [/pre2] и посмотреть лог Если на экране не один бровс и выборка данных для него не быстрая - начинает напрягать. Собственно вопрос насколько нужна прорисовка в _EndTBrowse (где первый раз) , если через евенты по любому нарисуем снова. Тупое комментирование выделенных строк в _EndTBrowse на результат не повлияло, но прорисовка выполнилась один раз
SergKis: Haz пишет Тупое комментирование выделенных строк в _EndTBrowse на результат не повлияло, но прорисовка выполнилась один раз Не все так просто с этим. Тоже смотре на это место, бывает даже с двойной прорисовкой получается ерунда в отображении, т.е. сетка строк сбита (внизу дыра чуть ли не 2-3 строки, курсорная строка прорисована в 2х местах), добавляю в END TBROWSE ON END {|obr| ..., obr:Refresh() } и только тогда получается правильная прорисовка всей сетки тсб. Если использовать :aRowPosAtRec[ xRow ], то приходится проверять соответствие тек. строки массива ( RecNo() ) и тек. RecNo() базы, сталкивался не только с несовпадением, но и со значением Nil, т.е. ощущение что :DrawLine() перепрыгнула запись в файле. Но пробовать можно ускорять, добавив переменную типа DATA lSpeedDraw AS LOGICAL INIT .T. и проверять в END TBROWSE
SergKis: PS :DrawLine() еще присутствует во всех :Go...() методах, т.е. одного END TBROWSE "маловато будет"
Haz: SergKis пишет: т.е. одного END TBROWSE "маловато будет да, заметил такое. Не дошел вчера. Иногда в проекте у себя вижу по 4 раза рисует. ::lSpedDraw действительно можно завести, чтобы тестировать оптимизацию прорисовки
SergKis: Haz пишет ::lSpedDraw действительно можно завести, чтобы тестировать оптимизацию прорисовки Сейчас прорисовка осуществляется примерно так, от текущей записи (если курсор в середине окна тсб лучше видно) к началу и потом от текущей к концу списка рисуемых строк. На мой взгляд это надо бы поменять, рисуя от первой строки и до конца списка рисуемых строк (:nRowCount()). Тогда управлять проще, для этого и отладки вводил массив :aRowPosAtRec, Tooltip на нем это побочное явление, но пока остановился на этом (упростить не получается), слишком много прорисовки вызовов разбросано по тексту
Haz: SergKis пишет: Сейчас прорисовка осуществляется примерно так, от текущей записи (если курсор в середине окна тсб лучше видно) к началу и потом от текущей к концу списка рисуемых строк Это точно? не нашел в коде такого алгоритма Зато нашел лишнее [pre2] METHOD GoRight() CLASS TSBrowse 7884: Local nTxtWid, nWidth, nCell, nSkip, lRefresh := .F. добавить инициализацию .F. 7949: lRefresh := ( ::lCanAppend .or. ::lIsArr ) Лишняя строка , вызывает лишнюю прорисовку при работе метода METHOD TSBrowse:PostEdit() 11552: SysRefresh() - тоже вроде как для подстраховки и вызывает прорисовку потестил без него - разницу не унюхал [/pre2]
SergKis: Haz пишет Это точно? не нашел в коде такого алгоритма Ты прав, нет такого, визуально показалось, т.к. сначала перепоказ идет текущей строки, потом переход на первую на экране и рисование до нижней, тек. уже нарисована и не меняется. 11552: SysRefresh() - тоже вроде как для подстраховки и вызывает прорисовку потестил без него - разницу не унюхал Это скорее перепоказ изменившихся др. строк в общем доступе Поправил в методе DrawLine[pre2] METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... If ::bOnDrawLine != Nil Eval( ::bOnDrawLine, Self, xRow ) EndIf ... [/pre2] Взял пример Tsb_MoreFields\demo.prg и добавил [pre2] #define _HMG_OUTLOG #include "hmg.ch" #include "TSBrowse.ch" REQUEST DBFCDX FUNCTION Main() ... ON INIT {| ob | TsbCreate( ob, .T. ) } :Cargo := oKeyData() :lRowPosAtRec := .T. :bTSDrawCell := {|ob,oc| If oc:nDrawType == 0 ? procname(1),procline(1),procname(2),procline(2),procname(3),procline(3),procname(4),procline(4),procname(5),procline(5) ?? " Col =",oc:nCell EndIf Return Nil } :bOnDrawLine := {|ob,xrow| Local nRow := ob:nRowPos Local nPos := ob:nCell Local nLen := Len(ob:aRowPosAtRec) // ? procname(1),procline(1),procname(2),procline(2),procname(3),procline(3),procname(4),procline(4),procname(5),procline(5) ? "xRow =",xrow,"nRowCount =",nLen,"nCell =",nPos,"nTek =",nRow,"RecNo =" If nRow > 0 .and. nRow <= nLen ?? ob:aRowPosAtRec[ nRow ] Else ?? "Error", nRow EndIf Return Nil } END TBROWSE ON END {| ob | TsbCreate( ob, .F. ) } ... [/pre2] смотрю лог и в целом выглядит логично по отображению
Haz: SergKis пишет: смотрю лог и в целом выглядит логично по отображению завтра погоняю твой пример
SergKis: Haz пишет погоняю твой пример Поправь еще в методе :DrawSelect() [pre2] METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... ENDIF If ::bOnDrawLine != Nil Eval( ::bOnDrawLine, Self, xRow ) EndIf If ! ::lDrawLine nBegin := 1 nLastCol := ::nColCount() EndIf ... В примере добавь STATIC FUNC myProc( n ) RETURN StrTran(Procname(n), "TSBROWSE:", ":") и :bTSDrawCell := {|ob,oc,ok| If oc:nDrawType == 0 ? myproc(1),procline(1),myproc(2),procline(2),myproc(3),procline(3),myproc(4),procline(4),myproc(5),procline(5) ?? oc:lDrawLine,"Col =",oc:nCell, ok:cName EndIf Return Nil } удобней смотреть будет [/pre2]
SergKis: PS[pre2] :bOnDrawLine := {|ob,xrow| Local nRow := ob:nRowPos Local nPos := ob:nCell Local nLen := Len(ob:aRowPosAtRec) // ? procname(1),procline(1),procname(2),procline(2),procname(3),procline(3),procname(4),procline(4),procname(5),procline(5) ? "xRow =",xrow,"nRowCount =",nLen,"nCell =",nPos,"nTek =",nRow,"RecNo =" If nRow > 0 .and. nRow <= nLen ?? ob:aRowPosAtRec[ nRow ] Else ?? "Error nRow", nRow EndIf If xrow > 0 .and. xrow <= nLen ?? ob:aRowPosAtRec[ xrow ] Else ?? "Error xrow", xrow EndIf Return Nil } [/pre2]
SergKis: Игорь Мне думается, что дело не в скорости прорисовки строк тсб, а в скорости выполнения перемещений по базе и заполнения буферов записи rdd, т.е. много dbSkip() подводов вперед-назад. Если прочитать записи отображения 1 раз в буфер-массив и потом отображаить\рисовать их, то скорость работы тсб увеличится, даже при 4х кратной прорисовке окна тсб
kkg: коллеги, лишние прорисовки видны: при движении курсора в видимой области влево вправо когда прорисовывается вся строка вместо 2 ячеек аналогично лишняя прорисовка зоны nFreeze при прокрутке страницы но мне кажется максимальный эффект можно получить если не прорисовывать весь грид, а скопировать видимую неизменяемую часть экрана а потом стандартно прорисовать только одну стоку или столбец которых не хватает.
SergKis: kkg Вы почти правы, если отбросить 20 элементов обработки цветов в колонках. Если повторите мои исправления в тсб и пример, то увидите, что придраться к отработке событий прорисовки в логе почти не к чему. Основной тормоз это перемещения по файлу, осуществляемое при каждой прорисовке, сначала от текущей записи к первой потом от нее к последней, потом опять на текущую, с учетом событий got\lost focus как записи так и колонки
kkg: SergKis я бы согласился, но тормоза присутствуют и на массивах (кстати файлы тоже кешированны)
SergKis: kkg пишет я бы согласился, но тормоза присутствуют и на массивах (кстати файлы тоже кешированны) Работа блоков кода на колонках по преобразованию данных (цветов ...) не убирается, создайте массив строковый сразу - будет чуть лучше. А создайте массив сразу с объектами oTScell будет совсем хорошо.
kkg: SergKis Вы не поняли, я и предложил не создавать каждый раз, а использовать цвет пикселей экрана (прямоугольник) который уже просчитан и на экране, просто эту область переместить на нужные координаты и дорисовать строку или колонку которой не хватает
SergKis: kkg пишет просто эту область переместить на нужные координаты и дорисовать строку или колонку которой не хватает Я все понял. Сейчас тсб переотображая страницу покажет и изменившиеся значения в др. колонках при общем доступе с учетом цветов bmp и т.д. Ваш этого не учтет. В некоторых вариантах это необходимо, конечно. Но ... Вы предлагайте конкретно по тексту, берем тут, правим так или так. Игорь, как раз и смотрит, где можно что отсечь, к примеру с помощью доп. переменной. Меня лично скорость тсб устраивает, т.к. нет у меня MoreFields, практически все колонки помещаю на один экран (методика в примере Tsb_MoreFields\demo.prg) + выборки из базы (letodb) короткие только нужные колонки (для связи на letodb и доп. тек. индексов) и т.д.
gfilatov2002: SergKis пишет: Игорь, как раз и смотрит, где можно что отсечь, к примеру с помощью доп. переменной. Для этих целей добавил в класс TSBrowse переменную lFastDraw DATA lFastDraw AS LOGICAL INIT .F. Пример использования в методе GoRight(): [pre2] If ! ::lFastDraw lRefresh := ( ::lCanAppend .or. ::lIsArr ) EndIf [/pre2]
Haz: gfilatov2002 пишет: Пример использования в методе GoRight(): Григорий, тут эта строка лишняя на все 100. В goleft(), к примеру, нет подобного. К сожалению сегодня не удалось дальше поразбираться, но продолжу. О результатах буду писать здесь. Переменная нужна, она позволит оценить разницу в прорисовке не затрагивая стабильность работы.
Haz: SergKis пишет: Мне думается, что дело не в скорости прорисовки строк тсб, а в скорости выполнения перемещений по базе и заполнения безусловно, но тормоза в прорисовке тоже большие. У меня в тестовом проекте значения для показа в ячейке берутся из справочника по ID, после первого показа уже из hash. Скорость возрастает в разы! Словно режим турбо включили, но когда на экране более 5 связных бровсов , тот тут только прорисовка и даже видно как все происходит. Сначала один бровс, потом остальные. Вот и хочу понять где.
Haz: SergKis пишет: Меня лично скорость тсб устраивает, т.к. нет у меня MoreFields, в понедельник постараюсь накидать пример из нескольких бровсов. Уверен проблема обозначиться яснее. Суть в подчиненности таблиц, в зависимости от стройки в первой имеем выборку во второй ... и так далее. Прорисовка на экране идет волной более чем заметной. Возможно это тормозит метод :reset(). Вобщем постараюсь... накидать если по работе без форс мажора будет
Haz: kkg пишет: мне кажется максимальный эффект можно получить если не прорисовывать весь грид, а скопировать видимую неизменяемую часть экрана а потом стандартно прорисовать только одну стоку или столбец которых не хватает. Нужно переделывать сдвиги в сторону на скролл окна, как при движении вверх или вниз. Текущий алгоритм унаследован со времен клиппер. Скорость прорисовки возрастет кратно, но не отобразит на скроллируемом куске изменения данных другими пользователями ( так и есть при вверх вниз) и думаю это нормально. Сергей реализовал класс cell, на основe которого можно сделать :refreshscreen() который будет перерисовывать изменившиеся ячейки видимой части бровсв.
SergKis: Haz пишет класс cell, на основe которого можно сделать :refreshscreen() который будет перерисовывать изменившиеся ячейки видимой части бровсв. Это будет давать эффект, если иметь массив таких TSBcell объектов для всех строк экрана\окна тсб, для одной, как сейчас ничего не решит. Т.е. рисуем запоминаем объекты TSBcell, потом используем при повторных прорисовках
SergKis: Haz пишет но когда на экране более 5 связных бровсов , тот тут только прорисовка и даже видно как все происходит. Сначала один бровс, потом остальные. Вот и хочу понять где. Посмотрев лог примера выше, скажу так, если тсб на окне несколько, то на каждом срабатывает прорисовка от обычного режима +2, т.е. добавляются прорисовки GotFocus, LostFocus. Вот пример лога вход тсб + 2 раза pgdn и переключение на Far и обратно и выход [pre2] xRow = 1 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 1 1 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 3421 :DISPLAY 654 .F. Col = 1 SELECTOR 0.00 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 3421 :DISPLAY 654 .F. Col = 2 ID 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 3421 :DISPLAY 654 .F. Col = 3 FIRST 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 3421 :DISPLAY 654 .F. Col = 4 LAST 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 3421 :DISPLAY 654 .F. Col = 5 STREET 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 3421 :DISPLAY 654 .F. Col = 6 CITY 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 3421 :DISPLAY 654 .F. Col = 7 STATE 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 3421 :DISPLAY 654 .F. Col = 8 ZIP 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 3421 :DISPLAY 654 .F. Col = 9 HIREDATE 0.02 xRow = 2 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 1 2 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 3421 :DISPLAY 654 .T. Col = 1 SELECTOR 0.00 ... xRow = 1 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 1 1 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10800 :PAINT 3421 :DISPLAY 13994 .F. Col = 1 SELECTOR 0.00 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10800 :PAINT 3421 :DISPLAY 13994 .F. Col = 2 ID 0.00 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10800 :PAINT 3421 :DISPLAY 13994 .F. Col = 3 FIRST 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10800 :PAINT 3421 :DISPLAY 13994 .F. Col = 4 LAST 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10800 :PAINT 3421 :DISPLAY 13994 .F. Col = 5 STREET 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10800 :PAINT 3421 :DISPLAY 13994 .F. Col = 6 CITY 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10800 :PAINT 3421 :DISPLAY 13994 .F. Col = 7 STATE 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10800 :PAINT 3421 :DISPLAY 13994 .F. Col = 8 ZIP 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10800 :PAINT 3421 :DISPLAY 13994 .F. Col = 9 HIREDATE 0.02 xRow = 1 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 1 1 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 1 SELECTOR 0.00 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 2 ID 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 3 FIRST 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 4 LAST 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 5 STREET 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 6 CITY 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 7 STATE 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 8 ZIP 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 9 HIREDATE 0.02 xRow = 1 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 1 1 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10903 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .F. Col = 1 SELECTOR 0.00 ... xRow = 18 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 1 18 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .T. Col = 1 SELECTOR 0.00 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .T. Col = 2 ID 0.01 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .T. Col = 3 FIRST 0.01 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .T. Col = 4 LAST 0.01 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .T. Col = 5 STREET 0.01 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .T. Col = 6 CITY 0.01 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .T. Col = 7 STATE 0.01 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .T. Col = 8 ZIP 0.02 (b)MAIN 4291 :TSDRAWCELL 4272 :DRAWLINE 10905 :PAINT 870 TCONTROL:HANDLEEVENT 9446 .T. Col = 9 HIREDATE 0.02 xRow = 1 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 19 19 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10621 :PAGEDOWN 8536 :KEYDOWN 9406 .F. Col = 1 SELECTOR 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10621 :PAGEDOWN 8536 :KEYDOWN 9406 .F. Col = 2 ID 0.03 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10621 :PAGEDOWN 8536 :KEYDOWN 9406 .F. Col = 3 FIRST 0.03 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10621 :PAGEDOWN 8536 :KEYDOWN 9406 .F. Col = 4 LAST 0.04 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10621 :PAGEDOWN 8536 :KEYDOWN 9406 .F. Col = 5 STREET 0.04 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10621 :PAGEDOWN 8536 :KEYDOWN 9406 .F. Col = 6 CITY 0.04 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10621 :PAGEDOWN 8536 :KEYDOWN 9406 .F. Col = 7 STATE 0.05 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10621 :PAGEDOWN 8536 :KEYDOWN 9406 .F. Col = 8 ZIP 0.05 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10621 :PAGEDOWN 8536 :KEYDOWN 9406 .F. Col = 9 HIREDATE 0.05 xRow = 1 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 19 19 ... xRow = 1 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 1 1 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 1 SELECTOR 0.00 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 2 ID 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 3 FIRST 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 4 LAST 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 5 STREET 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 6 CITY 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 7 STATE 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 8 ZIP 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 9 HIREDATE 0.02 ... xRow = 1 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 19 19 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10228 :LOSTFOCUS 896 TCONTROL:HANDLEEVENT 9446 .F. Col = 1 SELECTOR 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10228 :LOSTFOCUS 896 TCONTROL:HANDLEEVENT 9446 .F. Col = 2 ID 0.03 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10228 :LOSTFOCUS 896 TCONTROL:HANDLEEVENT 9446 .F. Col = 3 FIRST 0.03 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10228 :LOSTFOCUS 896 TCONTROL:HANDLEEVENT 9446 .F. Col = 4 LAST 0.03 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10228 :LOSTFOCUS 896 TCONTROL:HANDLEEVENT 9446 .F. Col = 5 STREET 0.04 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10228 :LOSTFOCUS 896 TCONTROL:HANDLEEVENT 9446 .F. Col = 6 CITY 0.04 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10228 :LOSTFOCUS 896 TCONTROL:HANDLEEVENT 9446 .F. Col = 7 STATE 0.04 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10228 :LOSTFOCUS 896 TCONTROL:HANDLEEVENT 9446 .F. Col = 8 ZIP 0.04 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 10228 :LOSTFOCUS 896 TCONTROL:HANDLEEVENT 9446 .F. Col = 9 HIREDATE 0.05 xRow = 1 nRowCount = 18 nCell = 2 nTek = 1 RecNo = 19 19 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 1 SELECTOR 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 2 ID 0.01 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 3 FIRST 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 4 LAST 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 5 STREET 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 6 CITY 0.02 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 7 STATE 0.03 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 8 ZIP 0.03 (b)MAIN 4291 :TSDRAWCELL 4758 :DRAWSELECT 8034 :GOTFOCUS 915 TCONTROL:HANDLEEVENT 9446 .F. Col = 9 HIREDATE 0.03 [/pre2] добавил еще время прорисовки с учетом вывода в лог, т.е.[pre2] :Cargo:nSeconds := Seconds() :bOnDrawLine := {|ob,xrow| Local nRow := ob:nRowPos Local nPos := ob:nCell Local nLen := Len(ob:aRowPosAtRec) ob:Cargo:nSeconds := Seconds() ... :bTSDrawCell := {|ob,oc,ok| If oc:nDrawType == 0 ? myproc(1),procline(1),myproc(2),procline(2),myproc(3),procline(3),myproc(4),procline(4),myproc(5),procline(5) ?? oc:lDrawLine,"Col =",oc:nCell, ok:cName, Seconds() - ob:Cargo:nSeconds EndIf Return Nil } ... [/pre2]
kkg: SergKis Вы предлагайте конкретно по тексту, берем тут, правим так или так. "поигрался" на реальных данных из "тяжёлых" отчётов, на удивление мерцание текста вызывает не DrawLine, а DrawSelect путём "кастрации" в метод DrawCell и его использования в GoRight GoLeft мерцание текста потушил, но у меня не совсем стандартное использование, попробуйте у себя [pre2] * ============================================================================ * METHOD TSBrowse:GoRight() Version 9.0 Nov/30/2009 * ============================================================================ ... lRefresh := ( ::lCanAppend /*.or. ::lIsArr*/ ) // Игорь прав уже год делаю такую правку While ! ::IsColVisible( ::nCell ) .and. ::nColPos < ::nCell ::nColPos ++ lRefresh := .T. EndDo ::HiliteCell( ::nCell ) If ::aColumns[ ::nCell ]:bGotFocus != Nil .and. ::nOldCell != ::nCell Eval( ::aColumns[ ::nCell ]:bGotFocus, ::nOldCell, ::nCell, Self ) EndIf If ::aColumns[ ::nOldCell ]:bLostFocus != Nil .and. ::nOldCell != ::nCell Eval( ::aColumns[ ::nOldCell ]:bLostFocus, ::nCell, ::nOldCell, Self ) EndIf If lRefresh ::lNoPaint := .F. ::Refresh( .F. ) ElseIf ! ::lEditing ::DrawCell( ::nAt, ::nOldCell) ::DrawCell( ::nAt, ::nCell) // ::DrawSelect() EndIf ... * ============================================================================ * METHOD TSBrowse:GoLeft() Version 9.0 Nov/30/2009 * ============================================================================ ... If ::aColumns[ ::nOldCell ]:bLostFocus != Nil .and. ::nOldCell != ::nCell Eval( ::aColumns[ ::nOldCell ]:bLostFocus, ::nCell, ::nOldCell, Self ) EndIf iif( ::oHScroll != Nil, ::oHScroll:SetPos( ::nCell ), Nil ) ::HiliteCell( ::nCell ) // If ::nOldCell > ::nColPos .or. ::nCell <= ::nFreeze ::DrawCell( ::nAt, ::nOldCell) ::DrawCell( ::nAt, ::nCell) Else ::DrawSelect() endif ::nOldCell := ::nCell // If ::aColumns[ ::nCell ]:lVisible == .F. If ::nCell == 1 ::GoRight() Else ::GoLeft() Endif endif ... * ============================================================================ * METHOD TSBrowse:DrawCell() возможно правильнее DrawCellSelect() * ============================================================================ METHOD DrawCell( nRow,nCol ) CLASS TSBrowse Local oColumn, nStartCol, hBitMap, hFont, nAlign, cPicture, nClrFore, nClrBack, ; //, nBegin , nLastCol lNoLite, uData, l3DLook, lMulti, nClrTo, lOpaque, lBrush, nCursor, lCheck, uBmpCell, cMsg, lAdjBmp, ; lSelected, lDrawCell, ; nVertText := 0, ; nMaxWidth := ::nWidth(), ; // use local copies for speed nRowPos := ::nRowPos, ; aColSizes := AClone( ::aColSizes ), ; hWnd := ::hWnd, ; hDC := ::hDc, ; lFocused := ::lFocused := ( GetFocus() == ::hWnd ), ; nVAlign := 1 Local l3DText, nClr3dL, nClr3dS Local aBitMaps, lCheckVal := .F., cColAls Local lDraw := .F., xData //nDeltaLen, Local nClrText := ::nClrText, ; nClrPane := ::nClrPane, ; nClrFocuFore := ::nClrFocuFore, ; nClrFocuBack := ::nClrFocuBack, ; nClrLine := ::nClrLine, ; nLineStyle /*:= ::nLineStyle*/, ; nClrSeleBack := ::nClrSeleBack, ; nClrSeleFore := ::nClrSeleFore, ; nHeightCell := ::nHeightCell //, ; // nHeightHead := iif( ::lDrawHeaders, ::nHeightHead, 0 ), ; // nHeightFoot := iif( ::lDrawFooters != nil .and. ::lDrawFooters, ::nHeightFoot, 0 ), ; // nHeightSuper := iif( ::lDrawHeaders, ::nHeightSuper, 0 ),; // nHeightSpecHd:= iif( ::lDrawSpecHd, ::nHeightSpecHd, 0 ) Default nRow := nRowPos, lDrawCell := .T. ::nPaintRow := nRow ::aDrawCols := {} If Empty( ::aColumns ) Return Self EndIf If nCol < 1 .or. nCol > len(::aColumns) Return Self EndIf If _HMG_MainClientMDIHandle != 0 .and. ! lFocused .and. ::hWndParent == GetActiveMdiHandle() lFocused := .T. EndIf ::lDrawSelect := .T. lSelected := ::lCanSelect .and. ( AScan( ::aSelected, iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) ) > 0 ) nClrBack := iif( ::nPhantom = -1 .and. ! Empty( ::aColumns ), ATail( ::aColumns ):nClrBack, nClrPane ) nClrBack := iif( ValType( nClrBack ) == "B", Eval( nClrBack, ::nAt, Len( ::aColumns ), Self ), nClrBack ) l3DLook := iif( ::nPhantom = -1 .and. ! Empty( ::aColumns ), ATail( ::aColumns ):l3DLook, .F. ) IF ::lRowPosAtRec IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() ::aRowPosAtRec := Array( ::nRowCount() ) AFill( ::aRowPosAtRec, 0 ) ENDIF IF nRow == 0 .or. nRow > Len( ::aRowPosAtRec ) ELSEIF ::lIsDbf ::aRowPosAtRec[ nRow ] := ( ::cAlias )->( RecNo() ) ELSEIF ::lIsArr ::aRowPosAtRec[ nRow ] := ::nAt ENDIF ENDIF oColumn := ::aColumns[ nCol ] If ! ValType( oColumn ) == "O" .or. ! ValType(oColumn:oCell ) == "O" Return Self EndIf nLineStyle := ::nLineStyle nStartCol := oColumn:oCell:nStartCol If nStartCol == nil Return Self EndIf If HB_ISNUMERIC( oColumn:nLineStyle ) nLineStyle := oColumn:nLineStyle EndIf hFont := ::hFontGet( oColumn, nCol ) lAdjBmp := oColumn:lAdjBmp nAlign := oColumn:nAlign lOpaque := .T. lMulti := .F. cColAls := iif( '->' $ oColumn:cField, nil, oColumn:cAlias ) If nCol == 1 .and. ! Empty( ::hBmpCursor ) uBmpCell := ::hBmpCursor uData := "" xData := "" nAlign := nMakeLong( oColumn:nAlign, oColumn:nAlign ) lNoLite := .T. lAdjBmp := .F. lCheck := .F. Else If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" ElseIf cColAls != nil If Valtype( oColumn:bSeek ) == 'B' ( cColAls )->( Eval( oColumn:bSeek, Self, nCol ) ) EndIf uData := ::bDataEval( oColumn, , nCol ) Else If Valtype( oColumn:bSeek ) == 'B' Eval( oColumn:bSeek, Self, nCol ) EndIf uData := ::bDataEval( oColumn, , nCol ) EndIf xData := uData lMulti := Valtype( uData ) == "C" .and. At( Chr( 13 ), uData ) > 0 cPicture := ::cPictureGet( oColumn, nCol ) lCheck := ( oColumn:lCheckBox .and. ValType( uData ) == "L" .and. oColumn:lVisible ) lNoLite := oColumn:lNoLite nVertText := 0 If lCheck cPicture := "" nVertText := iif( uData, 3, 4 ) lCheckVal := uData EndIf uBmpCell := oColumn:uBmpCell If nCol == ::nColSel .and. ::uBmpSel != nil .and. lSelected uBmpCell := ::uBmpSel nAlign := nMakeLong( LoWord( nAlign ), ::nAligBmp ) ElseIf oColumn:lBitMap .and. Valtype( uData ) == "N" aBitMaps := iif( Valtype( oColumn:aBitMaps ) == "A", oColumn:aBitMaps, ::aBitMaps ) If ! Empty( aBitMaps ) .and. uData > 0 .and. uData <= Len( aBitMaps ) uBmpCell := aBitMaps[ uData ] EndIf nAlign := nMakeLong( LoWord( nAlign ), nAlign ) uData := "" ElseIf ! lCheck .and. oColumn:lEmptyValToChar .and. Empty( uData ) uData := "" ElseIf Empty( cPicture ) .or. lMulti uData := iif( Valtype( uData ) != "C", cValToChar( uData ), uData ) Else uData := iif( uData == nil, "", Transform( uData, cPicture ) ) EndIf EndIf nAlign := ::nAlignGet( oColumn:nAlign, nCol, DT_LEFT ) If lNoLite If ::lLiteBar nClrFore := ::GetValProp( oColumn:nClrFocuFore, nClrText, nCol, ::nAt ) nClrBack := ::GetValProp( oColumn:nClrFocuBack, nClrPane, nCol, ::nAt ) If ! Empty(oColumn:cName) .and. oColumn:cName == "oPhant" nClrBack := nClrPane ElseIf ValType( nClrBack ) == "N" .and. nClrBack < 0 nClrBack *= -1 EndIf Else nClrFore := ::GetValProp( oColumn:nClrFore, nClrText, nCol, ::nAt ) nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nCol, ::nAt ) EndIf nCursor := 0 Else If ( nClrFore := iif( lFocused, oColumn:nClrFocuFore, oColumn:nClrSeleFore ) ) == Nil nClrFore := iif( lFocused, nClrFocuFore, nClrSeleFore ) EndIf nClrFore := ::GetValProp( nClrFore, nClrFore, nCol, ::nAt ) If ( nClrBack := iif( lFocused, oColumn:nClrFocuBack, oColumn:nClrSeleBack ) ) == Nil nClrBack := iif( lFocused, nClrFocuBack, nClrSeleBack ) EndIf nClrBack := ::GetValProp( nClrBack, nClrBack, nCol, ::nAt ) If ValType( nClrBack ) == "N" .and. nClrBack < 0 nCursor := Abs( nClrBack ) nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nCol, ::nAt ) Else nCursor := 0 EndIf EndIf If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nCol, ::nAt ) nClrTo := nClrBack[2] nClrBack := nClrBack[1] Else nClrTo := nClrBack EndIf lBrush := Valtype( nClrBack ) == "O" l3DLook := oColumn:l3DLook hBitMap := iif( ValType( uBmpCell ) == "B" .and. ! ::lPhantArrRow, Eval( uBmpCell, nCol, Self ), uBmpCell ) hBitMap := iif( ValType( hBitMap ) == "O" .and. ! ::lPhantArrRow, Eval( ::bBitMapH, hBitMap ), hBitMap ) Default hBitMap := 0 If lCheck Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 ) } If Valtype(oColumn:aCheck) == "A" hBitMap := oColumn:aCheck[ iif( lCheckVal, 1, 2 ) ] Else hBitMap := ::aCheck[ iif( lCheckVal, 1, 2 ) ] EndIf nAlign := nMakeLong( DT_CENTER, DT_CENTER ) uData := "" EndIf If oColumn:l3DTextCell != nil l3DText := oColumn:l3DTextCell nClr3dL := oColumn:nClr3DLCell nClr3dS := oColumn:nClr3DSCell nClr3dL := iif( ValType( nClr3dL ) == "B", Eval( nClr3dL, ::nAt, nCol, Self ), nClr3dL ) nClr3dS := iif( ValType( nClr3dS ) == "B", Eval( nClr3dS, ::nAt, nCol, Self ), nClr3dS ) Else l3DText := nClr3dL := nClr3dS := nil EndIf If nAlign != DT_CENTER .and. ::nCellMarginLR != nil uData := ::CellMarginLeftRight( nCol, uData, oColumn, nAlign, lMulti, 0 ) EndIf oColumn:oCell:nRow := nRowPos oColumn:oCell:nCol := nStartCol // oColumn:oCell:nWidth := aColSizes[ nCol ] + nDeltaLen oColumn:oCell:nHeight := ::nHeightCell oColumn:oCell:nCell := nCol oColumn:oCell:uValue := xData oColumn:oCell:lDrawLine := .F. // DrawSelect() oColumn:oCell:hWnd := hWnd // 1 oColumn:oCell:hDC := hDC // 2 oColumn:oCell:xRow := nRowPos // 3 oColumn:oCell:nStartCol := nStartCol // 4 // oColumn:oCell:nSize := aColSizes[ nCol ] + nDeltaLen // 5 aColSizes[ nCol ] + nDeltaLen oColumn:oCell:uData := uData // 6 oColumn:oCell:nAlign := nAlign // 7 oColumn:oCell:nClrFore := nClrFore // 8 oColumn:oCell:nClrBack := nClrBack // 9 oColumn:oCell:hFont := hFont // 10 oColumn:oCell:hBitMap := hBitMap // 11 oColumn:oCell:nHeightCell:= nHeightCell // 12 oColumn:oCell:l3DLook := l3DLook // 13 oColumn:l3DLook oColumn:oCell:nLineStyle := nLineStyle // 14 oColumn:oCell:nClrLine := nClrLine // 15 oColumn:oCell:nDrawType := 0 // 16 line/header/footer/super // oColumn:oCell:nHeightHead:= nHeightHead // 17 // oColumn:oCell:nHeightFoot:= nHeightFoot // 18 // oColumn:oCell:nHeightSuper := nHeightSuper // 19 // oColumn:oCell:nHeightSpecHd := nHeightSpecHd // 20 oColumn:oCell:lAdjBmp := lAdjBmp // 21 oColumn:oCell:lMultiline := lMulti // 22 oColumn:oCell:nVAlign := nVAlign // 23 oColumn:oCell:nVertText := nVertText // 24 oColumn:oCell:nClrTo := nClrTo // 25 oColumn:oCell:lOpaque := lOpaque // 26 oColumn:oCell:hBrush := iif( lBrush, nClrBack:hBrush, 0 ) // 27 oColumn:oCell:l3DText := l3DText // 28 3D text oColumn:oCell:nClr3dL := nClr3dL // 29 3D text light color oColumn:oCell:nClr3dS := nClr3dS // 30 3D text shadow color oColumn:oCell:nCursor := nCursor // 31 Rect cursor oColumn:oCell:lInvertColor := !(::lCellBrw .and. nCol != ::nCell) // 32 Invert color If lDrawCell lDraw := ::TSDrawCell( oColumn:oCell, oColumn ) Else lDraw := .T. EndIf If lDraw AAdd( ::aDrawCols, nCol ) EndIf If ::bOnDraw != Nil Eval( ::bOnDraw, Self ) EndIf If ::lCellBrw cMsg := iif( ! Empty( ::AColumns[ ::nCell ]:cMsg ), ::AColumns[ ::nCell ]:cMsg, ::cMsg ) cMsg := iif( ValType( cMsg ) == "B", Eval( cMsg, Self, ::nCell ), cMsg ) If ! Empty( cMsg ) ::SetMsg( cMsg ) EndIf EndIf ::lDrawSelect := .F. Return Self [/pre2]
SergKis: kkg пишет попробуйте у себя Попробовал, поправил только ::DrawCell( /*::nAt*/, ::nOldCell) ::DrawCell( /*::nAt*/, ::nCell) т.к. :nAt это номер текущей строки отображения, т.е. для массива номер элемента, для dbf номер записи Разницы в работе не увидел (мониторы 14",15") Тут примеры https://TransFiles.ru/po4kc DemoMdi0.exe - это родной вариант DemoMdi.exe - это ваш
SergKis: PS Разве что в примере Tsb_Array_2 немного подрагивания меньше при горизонтальном движении вправо, но поставил ваше lRefresh := ( ::lCanAppend /*.or. ::lIsArr*/ ) и оно пропало
Haz: SergKis пишет: lCanAppend писал выше, нужно убрать всю строку целиком, не забыв проинициализировать переменную в . f. в начале метода. Просто не врубаюсь как связаны lCanAppend и goRight. С понедельника по не многу продолжу
SergKis: Haz пишет нужно убрать всю строку целиком, не забыв проинициализировать переменную в . f. в начале метода. Просто не врубаюсь как связаны lCanAppend и goRight. У меня lCanAppend всегда .F., потому без разницы где инициализировать. А вдруг, кто то врубается , а мы сломаем
Haz: SergKis пишет: А вдруг, кто то врубается , а мы сломаем CanAppend разрешает skip ниже последней строки и делает Append . как это должно влиять на goright не пойму. В goLeft такого нет. Так что не сломаем, а если сломаем то починим.
kkg: Haz а если сломаем то починим. не нужно ломать, я по ходу нащупал проблему, откатите назад в оригинал и попробуйте [pre2] * ============================================================================ * METHOD TSBrowse:GoRight() Version 9.0 Nov/30/2009 * ============================================================================ METHOD GoRight() CLASS TSBrowse Local nTxtWid, nWidth, nCell, nSkip, lRefresh Local i,j ... lRefresh := ( ::lCanAppend /*.or. ::lIsArr*/ ) While ! ::IsColVisible( ::nCell ) .and. ::nColPos < ::nCell ::nColPos ++ lRefresh := .T. EndDo ::HiliteCell( ::nCell ) If ::aColumns[ ::nCell ]:bGotFocus != Nil .and. ::nOldCell != ::nCell Eval( ::aColumns[ ::nCell ]:bGotFocus, ::nOldCell, ::nCell, Self ) EndIf If ::aColumns[ ::nOldCell ]:bLostFocus != Nil .and. ::nOldCell != ::nCell Eval( ::aColumns[ ::nOldCell ]:bLostFocus, ::nCell, ::nOldCell, Self ) EndIf If lRefresh ::lNoPaint := .F. j :=::nAt i := -1 * ::nRowPos() - 1 if i !=0; ::skip(i) endif for i = 1 to ::nRowCount() ::skip(1) next ::GoPos( j, ::nCell ) // ::Refresh( .F. ) ElseIf ! ::lEditing ::DrawSelect() EndIf ... [/pre2] для GoLeft аналогично нужно проверить :lMoreFields := .T. может он и ненужен будет PS. наверно нужно прокомментировать. это место где при выходе за пределы экрана прорисовывается весь экран (что бы проверить достаточно заремить) меня как и Сержа не волнует скорость, раздражает мерцание текста (двойная прорисовка) чтоб убрать мерцание в зоне Freeze хотел DrawCell расширить до прорисовки таблицы и заодно рисовать не построчно, а по колонкам (по идее один раз открывая объект колонки и меняя только изменяемые значения для строк можно было бы ускорится) по факту все попытки получить массив строк и колонок вызывают DraweLine (что делает бессмысленным саму прорисовку) как и нет смысла рисовать строку курсора DrawSelect всё равно вызовется 2 раза до и после по GotLostFocus. если подскажете как в этом месте получить массив строк,колонок без прорисовки, попробую допилить DrawCell
kkg: Haz писал выше, нужно убрать всю строку целиком, не забыв проинициализировать переменную в . f. в начале метода. Просто не врубаюсь как связаны lCanAppend и goRight. С понедельника по не многу продолжу не нужно, при движении вправо по последней строке и достижения конца, должна произойти вставка строки и для её отображения нужен refresh для движения влево не нужно
SergKis: kkg пишет по факту все попытки получить массив строк и колонок вызывают DraweLine (что делает бессмысленным саму прорисовку) как и нет смысла рисовать строку курсора DrawSelect всё равно вызовется 2 раза до и после по GotLostFocus. Не все так грустно. Можно делать таким образом для начала, схема очень упрощенная - имеем hash с ключом <Recno\Element>+<имя колонки>+<тип вывода (line\select)> в значении {oCol, oCell} - в блоке кода :bOnDrawLine если ключ есть, то выводим :TSDrawCell( oCell, oCol ) из массива и возвращаем .T. - в блоке кода :bTSDrawCell если ключ есть, то вывод уже был, возвращаем .F. иначе на ключ запоминаем массив {oCol, oCell} и возврат .T. - для ключа <Recno\Element> значение берем из[pre2] If xrow > 0 .and. xrow <= Len(ob:aRowPosAtRec) ?? ob:aRowPosAtRec[ xrow ] EndIf[/pre2] - не очень ясно в какой момент очищать hash от ключей уже не используемых, т.е. за пределами данных массива ob:aRowPosAtRec По тексту[pre2] METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... If ::bOnDrawLine != Nil // свой блок кода для рисования IF ! Empty( Eval( ::bOnDrawLine, Self, xRow ) ) ; RETURN Self ENDIF EndIf ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... If ::bOnDrawLine != Nil // свой блок кода для рисования IF ! Empty( Eval( ::bOnDrawLine, Self, xRow ) ) ; RETURN Self ENDIF EndIf If ! ::lDrawLine ... В программе ставим :lRowPosAtRec := .T. :bTSDrawCell := {|ob,ocel,ocol| If oc:nDrawType == 0 IF oc:lDrawLine // DrawLine // рисуем, если ключ есть ELSE // DrawSelect // рисуем, если ключ есть ENDIF EndIf Return Nil } :bOnDrawLine := {|ob,xrow| // свой вывод или стандартный Return Nil } [/pre2]
Haz: kkg пишет: при движении вправо по последней строке и достижения конца, должна произойти вставка строки в исходниках не нашел такой фичи , ткните пальцем
Haz: kkg пишет: меня как и Сержа не волнует скорость, раздражает мерцание текста (двойная прорисовка) со скоростью соглашусь , на локальном примере без сети и простым дбф - не удалость получить эффект тормоза. Видимо Сергей прав - все дело в скорости выборки данных
SergKis: Haz пишет все дело в скорости выборки данных Весь текст h_tbrowse.prg пропитан такими строками[pre2] nSkip := nNewRow - nOldRow If ( ::nRowPos + nSkip ) <= nTotRow .and. ( ::nRowPos + nSkip ) >= 1 ::Skip( nSkip ) ::nRowPos += nSkip ElseIf ! ::lIsDbf ::nAt := nNewRow ElseIf Empty( ::nLogicPos() ) While ::nAt != nNewRow If ::nAt < nNewRow ::Skip( 1 ) Else ::Skip( -1 ) EndIf EndDo ElseIf ! Empty( ::nLogicPos() ) ( cAlias )->( DbSkip( nSkip ) ) ::nAt := ::nLogicPos() Else ( cAlias )->( Eval( ::bGoToPos, nNewRow ) ) ::nAt := ::nLogicPos() EndIf If nNewRow != nOldRow .and. ::nLen > nTotRow .and. nNewRow > nTotRow If ::lIsDbf nRecNo := ( cAlias )->( RecNo() ) ( cAlias )->( DbSkip( nTotRow - ::nRowPos ) ) If ( cAlias )->( EoF() ) Eval( ::bGoBottom ) ::nRowPos := nTotRow While ::nRowPos > 1 .and. ( cAlias )->( RecNo() ) != nRecNo ::Skip( -1 ) ::nRowPos -- EndDo Else ( cAlias )->( DbGoTo( nRecNo ) ) EndIf [/pre2] т.е. постоянно переходим к первой потом от нее к текущей и еще это может происходить не 1 раз, откуда скорость возьмется ? Запоминать только первую строку (позицию) и переходить от нее к тек. не очень проходит, в промежутке может появиться новая строка и все развалится. Можно пробовать танцевать от массива :aRowPosAtRec по содержимому элементов, т.е. сразу переход на первый и потом до тек. xRow и до конца отображать, в принциме аналогичным массивом\hash можно организовать одинарную прорисовку строк, но как то хлопотно по мне
kkg: Haz в исходниках не нашел такой фичи , ткните пальцем в исходниках этого не найти, это жизнь. когда пользователь вводит данные и нажимает Enter уходит вправо, на последней строке и последней колонке рождается новая строка (в ней весь заложенный смысл) хотя согласен, для арабов должно работать и при движении влево, видать не юзают Harbour PS был не прав, то что для нас вправо вниз, а влево ввех, для арабов наоборот, лучше этот вариант вообще не рассматривать, а то запутаемся
kkg: SergKis Можно делать таким образом для начала, схема очень упрощенная в обед нарыл попроще [pre2] m := ::lFirstPaint ::lFirstPaint := nil n := ::lDrawLine ::lDrawLine := .F. j :=::nAt i := -1 * ::nRowPos() - 1 if i !=0; ::skip(i) endif for i = 1 to ::nRowCount() ::skip(1) next ::GoPos( j, ::nCell ) ::lDrawLine := n ::lFirstPaint := m [/pre2] , но к сожалению на несколько дней загрузили работой. если есть интерес могу скинуть промежеточный код DrawCell в DrawRect но он очень "сырой"
SergKis: kkg пишет если есть интерес могу скинуть Нет, не надо, в целом, меня устраивает и то как сейчас работает. Все решается выборкой на local pc или процедурой на сервере (массив recno) и тсб на этот файл с выборкой Скорости хватает, не спорткар, но и не трактор
kkg: SergKis не спорткар, но и не трактор абсолютно согласен, лично у меня ERP системы приучили пользователя, что нажав кнопку получить отчёт, а через 25 мин он получает TimeOut и при этом пользователя обвиняют что он был не прав взяв большой период, то мы пока всё таки спорткар :) (пока данные и отчёты берут от нас)
Haz: SergKis пишет: Весь текст h_tbrowse.prg пропитан такими строками От этих skip никуда не деться. Можно попробовать оптимизировать уменьшив число переходов. Но полностью от цикла не уйти. Сегодня попробовал вариант goLeft goRight делать скролом окна бровса и прорисовывать только появляющуюся колонку. В исходнике кстати есть намек на такой вариант, но автор его бросил ( или не доделал). Из рисков такой логики это наткнуться на ситуацию когда скроллируемое окно не соответствует по записям новой колонке ( удалил или добавил кто то в совместном доступе ). Как обойти не придумал. Получается нужно в объекте держать массив номеров recno текущего отображения бровса..... А если так то и до массива всех записей в окне бровса недалеко. Тогда придется работать страницами. В текущем окне все будет летать , но появятся задержки при формировании новой страницы значениями для показа. Плюс не ясно как ловить изменения по сети. В общем пока только одни мысли, до решения далеко
SergKis: Haz пишет Получается нужно в объекте держать массив номеров recno текущего отображения бровса..... А если так то и до массива всех записей в окне бровса недалеко. Мы с тобой об одном и том же, выше описал на базе ob:aRowPosAtRec именно такую схему, а все записи бровса (страница, можно, конечно и весь) храним по ключу в hash в виде практически готовых объектов oCl, oCell, при выводе только координаты поправляются, т.к. goleft и goright по разному список колонок, помещающихся показывают. От skipov сильно не избавишься, но данные блоков кода, выполненые раз хранятся в oCell
SergKis: Haz пишет Плюс не ясно как ловить изменения по сети. Как обычно pgUp, pgDn и явный Refresh по кнопке или F5, как в IE и т.д. Из рисков такой логики это наткнуться на ситуацию когда скроллируемое окно не соответствует по записям новой колонке ( удалил или добавил кто то в совместном доступе ). Не очень понял, в совместном доступе у нас dbf или результат выборки (структура определена), как то не с руки в такой ситуевине менять структуру - это уже, как бы др. запрос, др. результат\ файл\массив
Haz: Из рисков такой логики это наткнуться на ситуацию когда скроллируемое окно не соответствует по записям новой колонке ( удалил или добавил кто то в совместном доступе ). Сергей я о другом механизме ::GoLeft() и ::GoRight() в КРАЙНИХ позициях Сейчас реализовано через полную перерисовку и передачу фокуса на появившуюся колонку. В методах ::GoUp() и ::GoDown() по другому - там сразу скролл всего окна бровса и ::DrawLine() на "освободившейся" строке. Если ::GoLeft() и ::GoRight() в КРАЙНИХ позициях перевести на эту логику , то скролл окна вправо или влево и ::DrawCol() - которого пока нет )) Функция TSBrwHScroll() в С модуле есть, метод ::TSBrwHScroll прописать не сложно как METHOD TSBrwHScroll( nDir ) INLINE TSBrwHScroll( ::hWnd, nDir, 0, 0) - проверил работает Сложнее сделать новые ::GoLeft2() и ::GoRight2() на основе скрола и тут может возникнуть ситуация когда новый ::DrawCol() нарисует колонку с другим набором записей чем на скроллируемой картинке. Думаю этот вопрос и заставил автора библиотеки бросить эту тему и пойти по пути перерисовки всего бровса
SergKis: Haz пишет тут может возникнуть ситуация когда новый ::DrawCol() нарисует колонку с другим набором записей чем на скроллируемой картинке. Думаю этот вопрос и заставил автора библиотеки бросить эту тему и пойти по пути перерисовки всего бровса Согласен с тобой и автором. Ускорить прорисовку (не ясно насколько) можно попробовать сохраняя oCell в hash для каждой нарисованной записи и ячейки DrawLine, DrawSelect при первом проходе, потом использовать данные hash для повторных рисований. oCol можно исп. из :aColumns, но если активно исп. Cargo колонки, то и oCol желательно сохранять для каждой ячейки вместе с oCell
SergKis: PS новый ::DrawCol() нарисует колонку новый :DrawCol() может опираться на массив записей, заполненный в DrawLine, DrawSelect, т.е. к примеру :aRowPosAtRec тогда рассогласования по списку записей не будет
SergKis: gfilatov2002 Поправить немного надо, Игорь подсказал, где сбивалось содержимое ::aRowPosAtRec[pre2] METHOD GoDown() CLASS TSBrowse ... If lTranspar ::Paint() Else ::nRowPos := nLines ::TSBrwScroll( 1 ) ::Skip( -1 ) ::DrawLine( ::nRowPos - 1 ) // added 10.07.2015 ::Skip( 1 ) IF ::lRowPosAtRec .and. Len( ::aRowPosAtRec ) > 0 hb_ADel( ::aRowPosAtRec, 1, .T. ) AAdd( ::aRowPosAtRec, ::nAt ) ENDIF EndIf ... METHOD GoUp() CLASS TSBrowse ... If ! lTranspar ::lRePaint := .F. ::TSBrwScroll( -1 ) ::Skip( 1 ) ::DrawLine( 2 ) ::Skip( -1 ) IF ::lRowPosAtRec .and. Len( ::aRowPosAtRec ) > 0 ASize( ::aRowPosAtRec, Len( ::aRowPosAtRec ) - 1 ) hb_AIns( ::aRowPosAtRec, 1, ::nAt, .T. ) ENDIF Else ::Paint() EndIf ... [/pre2]
Haz: SergKis пишет: Ускорить прорисовку (не ясно насколько) можно попробовать сохраняя oCell в hash для каждой нарисованной записи и ячейки DrawLine, это хорошая мысль. В принципе логика получается простая, 2 хеша содержат 1 хеш содержит { номер записи => хеш значений записи } 2 хеш значений содержит { имя колонки => значение для показа ( или oCell целиком )} или как вариант хеши держать в каждой ::aColumns, тогда 1 хаш в каждой колонке { RecNo() => значение для показа ( или oCell целиком )} Прирост в скорости будет в разы по сети , год назад тестировал хеширование справочников используемых в ::bData в результате по сети получил прирост раза в 4 ( визуально ) ::Refresh() обнуляет хеш(и), а ::DrawLine() и ::DrawSelect() заполняют если ключа нет или берут из хеша если ключ есть
SergKis: Haz пишет 2 хеша содержат А почему не один ? { Ключ := <:nAt>+<oCol:cName> => <копия oCell> } Если смотреть на DrawLine и DrawSelect, то они отличаются раскраской и вопрос хранить ли DrawSelect или рисовать его всегда. Если хранить то в этом же hash { Ключ := <:nAt>+<oCol:cName>+<oCel:lDrawLine> => <копия oCell> }
Haz: SergKis пишет: А почему не один ? { Ключ := <:nAt>+<oCol:cName> => <копия oCell> } Согласен SergKis пишет: хранить ли DrawSelect или рисовать его всегда. на него можно забить и не хранить
gfilatov2002: SergKis пишет: Поправить немного надо Благодарю за исправление Кстати, подготовил 3-ю бету для новой сборки со следующим списком изменений: [pre2] * New: Added the new functions for Windows GDI objects memory release. It will activate the GDI objects recording and call CheckRes() to generate the checkres.txt log file on the application quit. The above logfile will report the following unreleased objects: - BITMAP handles; - BRUSH handles; - CURSOR handles; - FONT handles; - ICON handles; - IMAGELIST handles; - REGION handles. Note: This feature will work after setting of debugging mode via the Harbour command Set( _SET_DEBUG, .T. ) or AltD( 1 ). Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\Grid_5) * Fixed: Detected resource leakage of GDI objects at the release of the Main form with usage of the new MiniGUI Resources control system. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Fixed: TREE: There is a blurring of the picture in some cases. Bug was reported by Eladio Bravo <eladibravo/at/gmail.com>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\DirTree_2) * Updated: Revised a hot mouse tracking in the ButtonEx control. Problem was reported by Gilbert Vaillancourt. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see menulist_2.prg in folder \samples\Advanced\MenuList) * Updated: Synchronized Extended HMG for compatibility with Official HMG: - New: COMBOBOXEX supports the optional clause NOTRANSPARENT; - New: IMAGE CHECKBUTTON supports the optional clause NOTRANSPARENT; - New: TAB control supports the optional clause NOTRANSPARENT; - New: TREE control supports the optional clause NOTRANSPARENT. Based upon a contribution of Claudio Soto <srvet/at/adinet.com.uy>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> * Updated: Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new variable :lFastDraw in the TSBrowse class; - correction of a filling of :aRowPosAtRec auxiliary array in the methods GoUp() and GoDown(). Suggested and contributed by Sergej Kiselev. - updated class TCursor has been used for creating of the STOP cursor in the method MouseMove(). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: HbSQLite3 library: - update for using SQLITE3 version 3.34.0dev (from 3.33.0). Contributed by Grigory Filatov <gfilatov@inbox.ru> * Updated: 'How to add a skin for a Grid control' sample: - fixed a resource leakage with usage of the Minigui Resources control system. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo2.prg in folder \samples\Basic\Grid_5) * Updated: 'TBrowse in the MDI environment' sample: - added a memo field editing in the Card edit mode. Contributed by Sergej Kiselev (see in folder \samples\Advanced\Tsb_DemoMDI) [/pre2]
Haz: Haz пишет: { Ключ := <:nAt> только не :nAt а RecNo() при работе с ADS ( при использовании SQL ) :nAt содержит непонятно что
SergKis: Haz пишет Согласен Возникает вариант не задан oCol:cName, берем номер колонки и возникают риски перестановки колонки в списке. Если после перестановки сработает Refresh, то все должно быть хорошо, если нет то плохо
Haz: SergKis пишет: не задан oCol:cName Можно уйти на отдельные хеши в колонках и проблем не будет
SergKis: Haz пишет только не :nAt Сейчас это основа. Для :lIsArr и :lIsDbf работает нормально вроде (смотрел при отладке :aRowPosAtRec) Может надо и для ADS SQL поправить, по тексту мест много с проверками :lIsArr, :lIsDbf ?
SergKis: Haz пишет Можно уйти на отдельные хеши в колонках Или присвоить колонкам имена внутренние типа _Dummy_Col_<номер колонки>
Haz: SergKis пишет: Или присвоить колонкам имена внутренние типа _Dummy_Col_<номер колонки> или генерить уникальный ID колонки при создании , тогда вопрос отпадет совсем
Haz: SergKis пишет: Сейчас это основа. Для :lIsArr и :lIsDbf работает нормально вроде ту все нормально для DBF идет Recno() [pre2] ELSEIF ::lIsDbf ::aRowPosAtRec[ xRow ] := ( ::cAlias )->( RecNo() ) ELSEIF ::lIsArr ::aRowPosAtRec[ xRow ] := ::nAt ENDIF [/pre2]
SergKis: gfilatov2002 Поправьте немного еще [pre2] METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... If ::bOnDrawLine != Nil IF !Empty( Eval( ::bOnDrawLine, Self, xRow ) ) RETURN Self ENDIF EndIf ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... If ::bOnDrawLine != Nil IF !Empty( Eval( ::bOnDrawLine, Self, xRow ) ) RETURN Self ENDIF EndIf If ! ::lDrawLine nBegin := 1 nLastCol := ::nColCount() EndIf ... [/pre2]
SergKis: Haz пишет ту все нормально для DBF идет Recno() Т.е. при ADS SQL :lIsDbf == .T. ? Тогда :nAt, по идее, везде должна быть нормальной, т.к. определяется в :nLogicPos() в ней только для ADO возврат[pre2] If ::cAlias == "ADO_" Return Eval( ::bKeyNo ) EndIf Return ::nAt [/pre2]
Haz: SergKis пишет: Тогда :nAt, по идее, везде должна быть нормальной, т.к. определяется в :nLogicPos() в ней только для ADO возврат :nAt только для массива же ? При ADS SQL :lIsDbf будет == .T. и Recno() как уникальный номер записи возмется с таблицы по которой построили запрос ( тоже все нормально ) Принцип работы ADS SQL простой -> DoSql( cAlias, cSql ) и получим рабочую новую область согласно запросу, фактически как USE cBase NEW ALIAS (cAlias) а вот LogicPos вернет что угодно только не позицию в логическом порядке записей. Из-за этого при запросе slect ... from ... order by ... вертикальный скроллбар прыгает хаотично. и это косяк именно ADS в исходниках подцепиться не к чему, если только создать виртуальное поле - нумератор и скроллбар настроить на него.
SergKis: Haz пишет :nAt для массива и dbf работает нормально, исп. без анализа в своих блоках кода и ф-ях Может тут, что то править надо [pre2] METHOD SetDbf( cAlias ) CLASS TSBrowse Local cAdsKeyNo, cAdsKeyCount, nTags, nEle Default ::cAlias := cAlias Default ::cAlias := Alias() If Empty( ::cAlias ) Return Nil EndIf cAlias := ::cAlias ::cDriver := ( ::cAlias )->( RddName() ) Default ::bGoTop := {|| ( cAlias )->( DbGoTop() ) }, ; ::bGoBottom := {|| ( cAlias )->( DbGoBottom() ) }, ; ::bSkip := {| n | iif( n == Nil, n := 1, Nil ), ::DbSkipper( n ) }, ; ::bBof := {|| ( cAlias )->( Bof() ) }, ; ::bEof := {|| ( cAlias )->( Eof() ) } If "ADS" $ ::cDriver cAdsKeyNo := "{| n, oBrw | iif( n == Nil, Round( " + cAlias + "->( ADSGetRelKeyPos() ) * oBrw:nLen, 0 ), " + ; cAlias + "->( ADSSetRelKeyPos( n / oBrw:nLen ) ) ) }" cAdsKeyCount := "{|cTag| " + cAlias + "->( ADSKeyCount(cTag,, 1 ) ) }" Default ::bKeyNo := &cAdsKeyNo , ; ::bKeyCount := &cAdsKeyCount, ; ::bLogicLen := &cAdsKeyCount, ; ::bTagOrder := {|uTag| ( cAlias )->( OrdSetFocus( uTag ) ) }, ; ::bGoToPos := {|n| Eval( ::bKeyNo, n, Self ) } Else Default ::bKeyNo := {| n | ( cAlias )->( iif( n == Nil, iif( IndexOrd() > 0, OrdKeyNo(), RecNo() ), ; iif( IndexOrd() > 0, OrdKeyGoto( n ), DbGoTo( n ) ) ) ) }, ; ::bKeyCount := {|| ( cAlias )->( iif( IndexOrd() > 0, OrdKeyCount(), LastRec() ) ) }, ; ::bLogicLen := {|| ( cAlias )->( iif( IndexOrd() == 0, LastRec(), OrdKeyCount() ) ) }, ; ::bTagOrder := {|uTag| ( cAlias )->( OrdSetFocus( uTag ) ) }, ; ::bGoToPos := {|n| Eval( ::bKeyNo, n ) } EndIf nTags := ( cAlias )->( OrdCount() ) ::aTags := {} For nEle := 1 To nTags AAdd( ::aTags, { ( cAlias )->( OrdName( nEle ) ), ( cAlias )->( OrdKey( nEle ) ) } ) Next if "SQL" $ ::cDriver Eval( ::bGoToPos, 100 ) ::bGoBottom := {|| CursorWait(), ( cAlias )->( DbGoBottom() ), CursorArrow() } ::bRecLock := {|| .t. } endif ::nLen := Eval( ::bLogicLen ) ::ResetVScroll( .T. ) Return Self [/pre2]
gfilatov2002: SergKis пишет: Поправьте немного еще OK
Haz: SergKis пишет: Может тут, что то править надо Сергей , бесполезно Уже не раз смотрел и правил. Просто если в SQL запросе присутствует ORDER BY ( т.е. сортировка ) логика в ADS примерно такая 1) Выполняется основной запрос и ADSGetRelKeyPos будет правильным для несортированной таблицы. 2) Потом выполняется ORDER BY из запроса и вместо ADSGetRelKeyPos на выходе получаем компот. В исходниках ADSRDD нет ничего , что позволило бы получить правильную логическую позицию, единственный вариант - это создание временной таблицы в памяти сервера [pre2] DOSQL(, "SELECT ... INTO #T1 FROM ... ORDER BY ...") а потом DOSQL("T2", "SELECT * FROM #T1" ) ... и после всего этого T2->(dbCloseArea()) DOSQL(, "DROP TABLE #T1") [/pre2] Предлагаю даже не заморачиваться с этим, запросы без ORDER BY идут в логике обычного DBF, если нужна сортировка , то делаю индекс в таблице и он подхватывается в результат прямого запроса
SergKis: Haz пишет Предлагаю даже не заморачиваться с этим OK ! Спасибо за разъяснения
SergKis: gfilatov2002 С учетом разъяснений Игоря, поправьте[pre2] METHOD GoDown() CLASS TSBrowse ... If lTranspar ::Paint() Else ::nRowPos := nLines ::TSBrwScroll( 1 ) ::Skip( -1 ) ::DrawLine( ::nRowPos - 1 ) // added 10.07.2015 ::Skip( 1 ) IF ::lRowPosAtRec .and. Len( ::aRowPosAtRec ) > 0 hb_ADel( ::aRowPosAtRec, 1, .T. ) AAdd( ::aRowPosAtRec, iif( ::lIsDbf, (::cAlias)->(RecNo()), ::nAt ) ) ENDIF EndIf ... METHOD GoUp() CLASS TSBrowse ... If ! lTranspar ::lRePaint := .F. ::TSBrwScroll( -1 ) ::Skip( 1 ) ::DrawLine( 2 ) ::Skip( -1 ) IF ::lRowPosAtRec .and. Len( ::aRowPosAtRec ) > 0 ASize( ::aRowPosAtRec, Len( ::aRowPosAtRec ) - 1 ) hb_AIns( ::aRowPosAtRec, 1, iif( ::lIsDbf, (::cAlias)->(RecNo()), ::nAt ), .T. ) ENDIF Else ::Paint() EndIf ... [/pre2]
Andrey: SergKis пишет: Скорости хватает, не спорткар, но и не трактор Вообще то МиниГуи ТСБ будет получше чем у других. Вот для примера стандартный C# грид - https://cloud.mail.ru/public/2wYs/pJMfZSrtD Кол-во столбцов и строк можно самому настраивать в настройке этой проги.
Haz: SergKis пишет: Или присвоить колонкам имена внутренние типа _Dummy_Col_<номер колонки> Может действительно в TSCOLUMN добавить DATA nID INIT 0 , а в METHOD TSColumn:New() в описание переменных static nLastID := 0 и сразу далее ::nId := ++nLastId Тогда ключ для любой колонки всегда будет уникальным , как бы ее не перемещали ???
SergKis: Haz пишет Тогда ключ для любой колонки всегда будет уникальным , как бы ее не перемещали ??? Для внутреннего использования даже оч. нормально (может и еще где сгодится "славянский шкаф")
gfilatov2002: SergKis пишет: С учетом разъяснений Игоря, поправьте Поправил, конечно
SergKis: PS Но тогда в класс TSBrowse добавить переменную надо DATA nLastIdColumn AS NUMERIC INIT 0 и в метод AddColumn и InsColumn добавить ведение этого счетчика, т.е. [pre2] METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse Local nI, nCell := ::nCell oColumn:nId := ++ ::nLastIdColumn If oColumn == Nil // if no Column object supplied Return Nil // return nil instead of reference to object EndIf ... METHOD AddColumn( oColumn ) CLASS TSBrowse Local nHeight, nAt, cHeading, cRest, nOcurs, ; hFont := iif( ::hFont != Nil, ::hFont, 0 ) Default ::aColSizes := {} oColumn:nId := ++ ::nLastIdColumn ... [/pre2]
Haz: SergKis пишет: Но тогда в класс TSBrowse добавить переменную надо если это единственный счетчик, который из TSColumn переезжает в TSBrowse как DATA nLastIdColumn AS NUMERIC INIT 0 то да здесь правильнее, но из TSColumn:New() придется убрать ::nId := ... иначе будут переназначения
SergKis: Игорь Не вижу в TsColumn ::nId := ..., совсем не находится nId, ::nId есть в TControl, но от него TsBrowse (ID TsBrowse понимаю), т.е. можем спокойно для колонок в класс TsColumn добавить DATA nId AS NUMERIC INIT 0 // ID column а в TsBrowse ведение счетчика колонок, можно короче назвать DATA nIdColumn AS NUMERIC INIT 0 и при добавлении\вставке колонок счетчик увеличиваем, не вижу что бы с чем то перекрывались А фантомной колонке надо присвоить nId, наверно взять :nId := -1[pre2] If ::oPhant == Nil // "Phantom" column; :nPhantom hidden IVar ::oPhant := TSColumn():New( "", ; // cHeading {|| "" }, ; // bdata nil, ; // cPicture { nClrText, nClrBack }, ; // aColors nil, ; // aAlign ::nPhantom, ; // nWidth nil, ; // lBitMap nil, ; // lEdit nil, ; // bValid .T., ; // lNoLite nil, ; // cOrder nil, ; // cFooting nil, ; // bPrevEdit nil, ; // bPostEdit nil, ; // nEditMove nil, ; // lFixLite {l3DLook}, ; nil, ; Self ) ::oPhant:cName := "oPhant" ::oPhant:nId := -1 Else [/pre2] т.к. для колонки SELECTOR тогда может быть :nId := 0
gfilatov2002: SergKis пишет: в класс TsColumn добавить DATA nId AS NUMERIC INIT 0 // ID column а в TsBrowse ведение счетчика колонок, можно короче назвать DATA nIdColumn AS NUMERIC INIT 0 Добавил эти изменения также
Haz: SergKis пишет: и при добавлении\вставке колонок счетчик увеличиваем, не вижу что бы с чем то перекрывались А фантомной колонке надо присвоить nId, наверно взять :nId := -1 тоже не увидел проблем
SergKis: gfilatov2002 В догонку добавления [pre2] METHOD AddColumn( oColumn ) CLASS TSBrowse ... Default ::aColSizes := {} oColumn:nId := ++ ::nIdColumn If oColumn:lDefineColumn ... METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse ... oColumn:nId := ++ ::nIdColumn If oColumn:lDefineColumn oColumn:DefColor( Self, oColumn:aColors ) oColumn:DefFont ( Self ) EndIf ... METHOD DrawHeaders( lFooters, lDrawCell ) CLASS TSBrowse ... ::oPhant:cName := "oPhant" ::oPhant:nId := -1 ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... ::oPhant:cName := "oPhant" ::oPhant:nId := -1 ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... ::oPhant:cName := "oPhant" ::oPhant:nId := -1 ... [/pre2]
SergKis: PS Запустил с изменениями (выше) Tsb_MoreFields\demo.prg, получил лог [pre2] 1 ID 2 FIRST 3 LAST 4 STREET 5 CITY 6 STATE 7 ZIP 8 HIREDATE 9 MARRIED 10 AGE 11 SALARY 12 FIRST2 13 LAST2 14 STREET2 15 CITY2 16 STATE2 17 ZIP2 18 HIREDATE2 19 MARRIED2 20 AGE2 21 SALARY2 22 FIRST3 23 LAST3 24 STREET3 25 CITY3 26 STATE3 27 ZIP3 28 HIREDATE3 29 MARRIED3 30 AGE3 31 SALARY3 32 FIRST4 33 LAST4 34 STREET4 35 CITY4 36 STATE4 37 ZIP4 38 HIREDATE4 39 MARRIED4 40 AGE4 41 SALARY4 42 FIRST5 43 LAST5 44 STREET5 45 CITY5 46 STATE5 47 ZIP5 48 HIREDATE5 49 MARRIED5 50 AGE5 51 SALARY5 52 FIRST6 53 LAST6 54 STREET6 55 CITY6 56 STATE6 57 ZIP6 58 HIREDATE6 59 MARRIED6 60 AGE6 61 SALARY6 62 FIRST7 63 LAST7 64 STREET7 65 CITY7 66 STATE7 67 ZIP7 68 HIREDATE7 69 MARRIED7 70 AGE7 71 SALARY7 72 FIRST8 73 LAST8 74 STREET8 75 CITY8 76 STATE8 77 ZIP8 78 HIREDATE8 79 MARRIED8 80 AGE8 81 SALARY8 .F. Col = 1 82 SELECTOR 0.06 .F. Col = 2 1 ID 0.08 .F. Col = 3 2 FIRST 0.08 .F. Col = 4 3 LAST 0.08 .F. Col = 5 4 STREET 0.08 .F. Col = 6 5 CITY 0.08 .F. Col = 7 6 STATE 0.08 .F. Col = 8 7 ZIP 0.08 .F. Col = 9 8 HIREDATE 0.08 .T. Col = 1 82 SELECTOR 0.08 .T. Col = 2 1 ID 0.08 .T. Col = 3 2 FIRST 0.08 .T. Col = 4 3 LAST 0.08 .T. Col = 5 4 STREET 0.08 .T. Col = 6 5 CITY 0.08 .T. Col = 7 6 STATE 0.08 .T. Col = 8 7 ZIP 0.08 .T. Col = 9 8 HIREDATE 0.09 .T. Col = 1 82 SELECTOR 0.09 [/pre2] В нем колонка SELECTOR нумеруется через счетчик, так что фантомную колонку можно -1 не делать, оставить 0 Какие мысли по этому варианту ?
SergKis: PS2 .F. Col = 1 82 SELECTOR 0.06 выделенное цветом это nId колонки SELECTOR
SergKis: PS3 Наверно с nId := 0 для колонки SELECTOR лучше, лог выглядит так[pre2] .F. Col = 1 0 SELECTOR 0.06 .F. Col = 2 1 ID 0.06 .F. Col = 3 2 FIRST 0.06 .F. Col = 4 3 LAST 0.06 ... [/pre2] цветом :nId выделен. Если так лучше, то такая правка требуется [pre2] METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse Local nI, nCell := ::nCell If oColumn == Nil // if no Column object supplied Return Nil // return nil instead of reference to object EndIf IF ! ( !Empty( oColumn:cName ) .and. oColumn:cName == "SELECTOR" ) oColumn:nId := ++ ::nIdColumn ENDIF ... [/pre2]
gfilatov2002: SergKis пишет: такая правка требуется METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse Записал в этом методе таким образом: [pre2]METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse ... If nPos == 1 .and. Len( ::aColumns ) > 1 .and. ::lSelector oColumn:nId := 0 Return Nil EndIf oColumn:nId := ++ ::nIdColumn ... [/pre2]
SergKis: gfilatov2002[pre2] METHOD InsColumn( nPos, oColumn ) CLASS TSBrowse ... If nPos == 1 .and. Len( ::aColumns ) > 1 .and. ::lSelector oColumn:nId := 0 Return Nil EndIf Else oColumn:nId := ++ ::nIdColumn EndIf ...[/pre2]
Haz: SergKis пишет: Если так лучше, то такая правка требуется Думаю все равно в каком порядке нумерация будет , главное больше 0. Тогда на отрицательные значения со временем можно дополнительный смысл возложить скажем -6 значит колонка с ID = 6 требует обновление hash. Или вообще не задумываться , просто ID > 0 и все. 😏
SergKis: Haz пишет Думаю все равно в каком порядке нумерация будет , главное больше 0 nId == 0 это SELECTOR, так проще, если работать по nId, а проверять совсем не надо. Колонки :nId == 0 и :nId == -1 надо в hash сохранять как все др. колонки, т.к. блоки кода в них тоже работают и проходят через метод :TSDrawCell(), а порядок это, действительно, все равно
SergKis: Haz пишет скажем -6 значит колонка с ID = 6 требует обновление hash. Для обновления надо метод написать, т.е. очищает или заполняет по имеющимся ключам hash, хотя последнее сделает DrawLine при прорисовке и отсутствию ключа в hash
Haz: SergKis пишет: Для обновления надо метод написать hash будет жить в объекте Tsbrowse ? Как его назовем и какова структура ?
SergKis: Haz пишет hash будет жить в объекте Tsbrowse ? Как его назовем и какова структура ? Мне пока такое лезет в голову[pre2] DATA lFastDrawCell AS LOGICAL INIT .F. DATA aFastDrawCell INIT hb_Hash() ... METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... Local nDeltaLen, xData, nAt, oCell, cCell ... 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 ] := ( nAt := ( ::cAlias )->( RecNo() ) ) ELSEIF ::lIsArr ::aRowPosAtRec[ xRow ] := ( nAt := ::nAt ) ENDIF ENDIF If ::nLen > 0 IF nAt == NIL nAt := iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) ENDIF ... nJ := iif( nI < ::nColPos, nJ + 1, nI ) lSelected := iif( nJ == nLastCol, .F., lSelected ) oColumn := iif( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] ) nDeltaLen := ::GetDeltaLen( nJ, nStartCol, nMaxWidth, aColSizes ) cCell := hb_ntos(nAt)+"."+hb_ntos(oColumn:nId) IF ::lFastDrawCell oCell := hb_HGetDef( ::aFastDrawCell, cCell, NIL ) IF ISOBJECT(oCell) oCell:nRow := xRow oCell:nCol := nStartCol oCell:nWidth := aColSizes[ nJ ] + nDeltaLen oCell:nHeight := ::nHeightCell oCell:nCell := nJ IF lDrawCell ::TSDrawCell( oCell, oColumn ) ENDIF nStartCol += aColSizes[ nJ ] + nDeltaLen LOOP ENDIF ENDIF //If HB_ISNUMERIC( oColumn:nLineStyle ) // nLineStyle := oColumn:nLineStyle //EndIf nLineStyle := iif( HB_ISNUMERIC( oColumn:nLineStyle ), oColumn:nLineStyle, ::nLineStyle ) cPicture := ::cPictureGet( oColumn, nJ ) ... IF lDrawCell ::TSDrawCell( oColumn:oCell, oColumn ) IF ::lFastDrawCell hb_HSet( ::aFastDrawCell, cCell, __objClone( oColumn:oCell ) ) ENDIF ENDIF nStartCol += aColSizes[ nJ ] + nDeltaLen ... [/pre2] Метод для очистки ::aFastDrawCell METOD FastDrawCell() INLINE ::aFastDrawCell := hb_Hash() Вызовы, как ты писал, в Refresh() поставить
SergKis: PS А может и не в Refresh(), т.к. по :GoLeft(), :GoRight() очистки не должно быть. Тогда где ?
SergKis: PS2 Попробовал по быстрому набрать, как писал выше, но такая правка[pre2] IF ::lFastDrawCell oCell := hb_HGetDef( ::aFastDrawCell, cCell, NIL ) IF ISOBJECT(oCell) oCell:nRow := xRow oCell:nCol := nStartCol oCell:nWidth := aColSizes[ nJ ] + nDeltaLen oCell:nHeight := ::nHeightCell oCell:nCell := nJ oCell:hWnd := hWnd oCell:hDC := hDC oCell:xRow := xRow oCell:nStartCol := nStartCol oCell:nSize := aColSizes[ nJ ] + nDeltaLen oColumn:oCell := oCell IF lDrawCell ::TSDrawCell( oColumn:oCell, oColumn ) ENDIF nStartCol += aColSizes[ nJ ] + nDeltaLen LOOP ENDIF ENDIF [/pre2] попробовал пример Tsb_MoreFields\demo.prg, поставив :lFastDrawCell := .T. Что то отобразилось, но с искажениями после перемещений курсора. Я отключаюсь на несколько дней от темы.
Haz: SergKis пишет: А может и не в Refresh(), т.к. по :GoLeft(), :GoRight() очистки не должно быть. Тогда где ? [pre2] METHOD Refresh( lPaint, lRecount, lClearHash ) CLASS TSBrowse Default lPaint := .T., ; lRecount := .F. ; lClearHash := .T. if lClearHsh ::aFastDrawCell:= hb_hash() end If ::lFirstPaint == Nil .or. ::lFirstPaint Return 0 EndIf If lRecount .or. Empty( ::nLen ) ::nLen := iif( ::lIsDbf, ( ::cAlias )->( Eval( ::bLogicLen ) ), Eval( ::bLogicLen ) ) EndIf ::lNoPaint := .F. Return ::Super:Refresh( lPaint ) [/pre2] и в двух методах GoLeft / GoRight поправить вызов Refresh() с учетом 3-го параметра
Haz: SergKis пишет: Попробовал по быстрому набрать, как писал выше, но такая правка Выложи исходники h_browse.prg и TColumn.prg. Я пока посмотрю что получается
SergKis: Haz Тут https://TransFiles.ru/tif7u Немного поправил. В таком виде работает. Возможно, ты прав, что в hash надо хранить структуру. В тексте сохраняю объект, но наверно, надо массив с выборочными данными
SergKis: Haz пишет и в двух методах GoLeft / GoRight поправить вызов Refresh() с учетом 3-го параметра В том то и дело, что тут они не нужны, т.к. по этим методам те cell, которые есть в hash отображаются из него, а тех что нет отображаются пополняя hash, т.е. если не делаем ::aFastDrawCell:= hb_hash(), то съедаем весь дбф в hash и все отображение идет из него. И когда делать ::aFastDrawCell:= hb_hash(), наверно надо решать самому. Или при смене листа, т.е. PgDn, PgUp
SergKis: PS И когда делать ::aFastDrawCell:= hb_hash(), наверно надо решать самому. И в :Reset() обязятельно
Haz: SergKis пишет: В том то и дело, что тут они не нужны я имел ввиду что по умолчанию refresh обнуляет hash, а третий параметр отключает это. В методах goLeft и goRight нужно заменить вызовы refresh с явным третьим параметром в FALSE чтоб не очищался hash SergKis пишет: И в :Reset() обязятельно не надо, там есть вызов ::Refresh( .T., .T. )
SergKis: Haz пишет с явным третьим параметром в FALSE чтоб не очищался hash Что то мне подсказывает, что нужна переменная, очищать или нет hash, т.к. работать можно только с hash на широких отчетах и hash сбрасывать не надо до конца работы тсб
SergKis: Игорь Правку такую сделай, так правильнее, по мне[pre2] METHOD DrawLine( xRow, lDrawCell ) CLASS TSBrowse ... IF lDrawCell ::TSDrawCell( oColumn:oCell, oColumn ) ENDIF IF ::lFastDrawCell .and. ! lCell hb_HSet( ::aFastDrawCell, cCell, __objClone( oColumn:oCell ) ) ENDIF nStartCol += aColSizes[ nJ ] + nDeltaLen ... [/pre2]
Haz: SergKis пишет: т.к. работать можно только с hash на широких отчетах и hash сбрасывать не надо до конца работы тсб Нужно подумать тк записи не только вширь бровса но и по количеству записей всего. Тут скорее нужен отдельный метод :tbrw2hash() -> aHash то есть пробежаться по всей таблице без прорисовки и получить хаш всей таблицы
SergKis: PS DrawSelect поправил на hash[pre2] METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse Local nI, nJ, nBegin, nStartCol, oColumn, nLastCol, hBitMap, hFont, nAlign, cPicture, nClrFore, nClrBack, ; lNoLite, uData, l3DLook, lMulti, nClrTo, lOpaque, lBrush, nCursor, lCheck, uBmpCell, cMsg, lAdjBmp, ; lSelected, ; nVertText := 0, ; nMaxWidth := ::nWidth(), ; // use local copies for speed nRowPos := ::nRowPos, ; aColSizes := AClone( ::aColSizes ), ; hWnd := ::hWnd, ; hDC := ::hDc, ; lFocused := ::lFocused := ( GetFocus() == ::hWnd ), ; nVAlign := 1 Local l3DText, nClr3dL, nClr3dS Local aBitMaps, lCheckVal := .F., cColAls Local nDeltaLen, lDraw := .F., xData Local nAt, oCell, cCell, lCell Local nClrText := ::nClrText, ; nClrPane := ::nClrPane, ; nClrFocuFore := ::nClrFocuFore, ; nClrFocuBack := ::nClrFocuBack, ; nClrLine := ::nClrLine, ; nLineStyle /*:= ::nLineStyle*/, ; nClrSeleBack := ::nClrSeleBack, ; nClrSeleFore := ::nClrSeleFore, ; nHeightCell := ::nHeightCell, ; nHeightHead := iif( ::lDrawHeaders, ::nHeightHead, 0 ), ; nHeightFoot := iif( ::lDrawFooters != Nil .and. ::lDrawFooters, ::nHeightFoot, 0 ), ; nHeightSuper := iif( ::lDrawHeaders, ::nHeightSuper, 0 ),; nHeightSpecHd:= iif( ::lDrawSpecHd, ::nHeightSpecHd, 0 ) Default xRow := nRowPos, lDrawCell := .T. ::nPaintRow := xRow ::aDrawCols := {} If Empty( ::aColumns ) Return Self EndIf If _HMG_MainClientMDIHandle != 0 .and. ! lFocused .and. ::hWndParent == GetActiveMdiHandle() lFocused := .T. EndIf ::lDrawSelect := .T. lSelected := ::lCanSelect .and. ( AScan( ::aSelected, iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) ) > 0 ) If ( ::lNoLiteBar .or. ( ::lNoGrayBar .and. ! lFocused ) ) .and. Empty( ::hBmpCursor ) ::DrawLine() // don't want hilited cursor bar of any color ElseIf ::nLen > 0 nClrBack := iif( ::nPhantom = -1 .and. ! Empty( ::aColumns ), ATail( ::aColumns ):nClrBack, nClrPane ) nClrBack := iif( ValType( nClrBack ) == "B", Eval( nClrBack, ::nAt, Len( ::aColumns ), Self ), nClrBack ) l3DLook := iif( ::nPhantom = -1 .and. ! Empty( ::aColumns ), ATail( ::aColumns ):l3DLook, .F. ) If ::oPhant == Nil // "Phantom" column; :nPhantom hidden IVar ::oPhant := TSColumn():New( "", ; // cHeading {|| "" }, ; // bdata nil, ; // cPicture { nClrText, nClrBack }, ; // aColors nil, ; // aAlign ::nPhantom, ; // nWidth nil, ; // lBitMap nil, ; // lEdit nil, ; // bValid .T., ; // lNoLite nil, ; // cOrder nil, ; // cFooting nil, ; // bPrevEdit nil, ; // bPostEdit nil, ; // nEditMove nil, ; // lFixLite {l3DLook}, ; nil, ; Self ) ::oPhant:cName := "oPhant" ::oPhant:nId := -1 Else ::oPhant:nClrFore := nClrText ::oPhant:nClrBack := nClrBack ::oPhant:nWidth := ::nPhantom ::oPhant:l3DLook := l3DLook EndIf AAdd( aColSizes, ::nPhantom ) nJ := nStartCol := 0 nLastCol := Len( ::aColumns ) + 1 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 xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) ELSEIF ::lIsDbf ::aRowPosAtRec[ xRow ] := ( nAt := ( ::cAlias )->( RecNo() ) ) ELSEIF ::lIsArr ::aRowPosAtRec[ xRow ] := ( nAt := ::nAt ) ENDIF ENDIF If ::bOnDrawLine != Nil IF !Empty( Eval( ::bOnDrawLine, Self, xRow ) ) RETURN Self ENDIF EndIf If ! ::lDrawLine nBegin := 1 nLastCol := ::nColCount() EndIf IF nAt == NIL nAt := iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) ENDIF For nI := nBegin To nLastCol If nStartCol >= nMaxWidth .and. ::lDrawLine Exit EndIf nJ := iif( nI < ::nColPos, nJ + 1, nI ) oColumn := iif( nJ > Len( ::aColumns ), ::oPhant, ::aColumns[ nJ ] ) nLineStyle := ::nLineStyle nDeltaLen := ::GetDeltaLen( nJ, nStartCol, nMaxWidth, aColSizes ) cCell := hb_ntos(nAt)+"."+hb_ntos(oColumn:nId) lCell := .F. IF ::lFastDrawCell oCell := hb_HGetDef( ::aFastDrawCell, cCell, NIL ) lCell := ISOBJECT(oCell) ENDIF //If HB_ISNUMERIC( oColumn:nLineStyle ) // nLineStyle := oColumn:nLineStyle //EndIf nLineStyle := iif( HB_ISNUMERIC( oColumn:nLineStyle ), oColumn:nLineStyle, ::nLineStyle ) hFont := ::hFontGet( oColumn, nJ ) lAdjBmp := oColumn:lAdjBmp nAlign := oColumn:nAlign lOpaque := .T. lMulti := .F. cColAls := iif( '->' $ oColumn:cField, Nil, oColumn:cAlias ) If nJ == 1 .and. ! Empty( ::hBmpCursor ) uBmpCell := ::hBmpCursor uData := "" xData := "" nAlign := nMakeLong( oColumn:nAlign, oColumn:nAlign ) lNoLite := .T. lAdjBmp := .F. lCheck := .F. Else If Valtype( oColumn:bSeek ) == 'B' If cColAls != Nil ( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) Else Eval( oColumn:bSeek, Self, nJ ) EndIf EndIf If ::lIsArr .and. ( ::lAppendMode .or. ::nAt > Len( ::aArray ) ) uData := "" // append mode for arrays //ElseIf cColAls != Nil // If Valtype( oColumn:bSeek ) == 'B' // ( cColAls )->( Eval( oColumn:bSeek, Self, nJ ) ) // EndIf // uData := ::bDataEval( oColumn, , nJ ) ElseIf lCell uData := oCell:uValue Else //If Valtype( oColumn:bSeek ) == 'B' // Eval( oColumn:bSeek, Self, nJ ) //EndIf uData := ::bDataEval( oColumn, , nJ ) EndIf xData := uData lMulti := Valtype( uData ) == "C" .and. At( Chr( 13 ), uData ) > 0 cPicture := ::cPictureGet( oColumn, nJ ) lCheck := ( oColumn:lCheckBox .and. ValType( uData ) == "L" .and. oColumn:lVisible ) lNoLite := oColumn:lNoLite nVertText := 0 If lCheck cPicture := "" nVertText := iif( uData, 3, 4 ) lCheckVal := uData EndIf uBmpCell := oColumn:uBmpCell If nJ == ::nColSel .and. ::uBmpSel != Nil .and. lSelected uBmpCell := ::uBmpSel nAlign := nMakeLong( LoWord( nAlign ), ::nAligBmp ) ElseIf oColumn:lBitMap .and. Valtype( uData ) == "N" aBitMaps := iif( Valtype( oColumn:aBitMaps ) == "A", oColumn:aBitMaps, ::aBitMaps ) If ! Empty( aBitMaps ) .and. uData > 0 .and. uData <= Len( aBitMaps ) uBmpCell := aBitMaps[ uData ] EndIf nAlign := nMakeLong( LoWord( nAlign ), nAlign ) uData := "" ElseIf ! lCheck .and. oColumn:lEmptyValToChar .and. Empty( uData ) uData := "" ElseIf lCell uData := oCell:cValue ElseIf Empty( cPicture ) .or. lMulti uData := iif( Valtype( uData ) != "C", cValToChar( uData ), uData ) Else uData := iif( uData == NIL, "", Transform( uData, cPicture ) ) EndIf EndIf nAlign := ::nAlignGet( oColumn:nAlign, nJ, DT_LEFT ) If lNoLite If ::lLiteBar nClrFore := ::GetValProp( oColumn:nClrFocuFore, nClrText, nJ, ::nAt ) nClrBack := ::GetValProp( oColumn:nClrFocuBack, nClrPane, nJ, ::nAt ) If ! Empty(oColumn:cName) .and. oColumn:cName == "oPhant" nClrBack := nClrPane ElseIf ValType( nClrBack ) == "N" .and. nClrBack < 0 nClrBack *= -1 EndIf Else nClrFore := ::GetValProp( oColumn:nClrFore, nClrText, nJ, ::nAt ) nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nJ, ::nAt ) EndIf nCursor := 0 Else If ( nClrFore := iif( lFocused, oColumn:nClrFocuFore, oColumn:nClrSeleFore ) ) == Nil nClrFore := iif( lFocused, nClrFocuFore, nClrSeleFore ) EndIf nClrFore := ::GetValProp( nClrFore, nClrFore, nJ, ::nAt ) If ( nClrBack := iif( lFocused, oColumn:nClrFocuBack, oColumn:nClrSeleBack ) ) == Nil nClrBack := iif( lFocused, nClrFocuBack, nClrSeleBack ) EndIf nClrBack := ::GetValProp( nClrBack, nClrBack, nJ, ::nAt ) If ValType( nClrBack ) == "N" .and. nClrBack < 0 nCursor := Abs( nClrBack ) nClrBack := ::GetValProp( oColumn:nClrBack, nClrPane, nJ, ::nAt ) Else nCursor := 0 EndIf EndIf If ValType( nClrBack ) == "A" nClrBack := ::nClrBackArr( nClrBack, nJ, ::nAt ) nClrTo := nClrBack[2] nClrBack := nClrBack[1] Else nClrTo := nClrBack EndIf lBrush := Valtype( nClrBack ) == "O" l3DLook := oColumn:l3DLook hBitMap := iif( ValType( uBmpCell ) == "B" .and. ! ::lPhantArrRow, Eval( uBmpCell, nJ, Self ), uBmpCell ) hBitMap := iif( ValType( hBitMap ) == "O" .and. ! ::lPhantArrRow, Eval( ::bBitMapH, hBitMap ), hBitMap ) Default hBitMap := 0 If lCheck IF lCell hBitMap := oCell:hBitMap nAlign := oCell:nAlign ELSE Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 ) } If Valtype(oColumn:aCheck) == "A" hBitMap := oColumn:aCheck[ iif( lCheckVal, 1, 2 ) ] Else hBitMap := ::aCheck[ iif( lCheckVal, 1, 2 ) ] EndIf nAlign := nMakeLong( DT_CENTER, DT_CENTER ) ENDIF uData := "" EndIf If oColumn:l3DTextCell != Nil l3DText := oColumn:l3DTextCell nClr3dL := oColumn:nClr3DLCell nClr3dS := oColumn:nClr3DSCell nClr3dL := iif( ValType( nClr3dL ) == "B", Eval( nClr3dL, ::nAt, nJ, Self ), nClr3dL ) nClr3dS := iif( ValType( nClr3dS ) == "B", Eval( nClr3dS, ::nAt, nJ, Self ), nClr3dS ) Else l3DText := nClr3dL := nClr3dS := Nil EndIf oColumn:nEditWidthDraw := 0 If nDeltaLen > 0 oColumn:nEditWidthDraw := aColSizes[ nJ ] + nDeltaLen EndIf IF ! lCell If nAlign != DT_CENTER .and. ::nCellMarginLR != NIL uData := ::CellMarginLeftRight( nJ, uData, oColumn, nAlign, lMulti, 0 ) EndIf ENDIF IF Empty( oColumn:oCell ) oColumn:oCell := TSBcell():New() ENDIF oColumn:oCell:nRow := nRowPos oColumn:oCell:nCol := nStartCol oColumn:oCell:nWidth := aColSizes[ nJ ] + nDeltaLen oColumn:oCell:nHeight := ::nHeightCell oColumn:oCell:nCell := nJ oColumn:oCell:uValue := xData oColumn:oCell:lDrawLine := .F. // DrawSelect() oColumn:oCell:hWnd := hWnd // 1 oColumn:oCell:hDC := hDC // 2 oColumn:oCell:xRow := nRowPos // 3 oColumn:oCell:nStartCol := nStartCol // 4 oColumn:oCell:nSize := aColSizes[ nJ ] + nDeltaLen // 5 aColSizes[ nJ ] + nDeltaLen oColumn:oCell:uData := uData // 6 oColumn:oCell:nAlign := nAlign // 7 oColumn:oCell:nClrFore := nClrFore // 8 oColumn:oCell:nClrBack := nClrBack // 9 oColumn:oCell:hFont := hFont // 10 oColumn:oCell:hBitMap := hBitMap // 11 oColumn:oCell:nHeightCell:= nHeightCell // 12 oColumn:oCell:l3DLook := l3DLook // 13 oColumn:l3DLook oColumn:oCell:nLineStyle := nLineStyle // 14 oColumn:oCell:nClrLine := nClrLine // 15 oColumn:oCell:nDrawType := 0 // 16 line/header/footer/super oColumn:oCell:nHeightHead:= nHeightHead // 17 oColumn:oCell:nHeightFoot:= nHeightFoot // 18 oColumn:oCell:nHeightSuper := nHeightSuper // 19 oColumn:oCell:nHeightSpecHd := nHeightSpecHd // 20 oColumn:oCell:lAdjBmp := lAdjBmp // 21 oColumn:oCell:lMultiline := lMulti // 22 oColumn:oCell:nVAlign := nVAlign // 23 oColumn:oCell:nVertText := nVertText // 24 oColumn:oCell:nClrTo := nClrTo // 25 oColumn:oCell:lOpaque := lOpaque // 26 oColumn:oCell:hBrush := iif( lBrush, nClrBack:hBrush, 0 ) // 27 oColumn:oCell:l3DText := l3DText // 28 3D text oColumn:oCell:nClr3dL := nClr3dL // 29 3D text light color oColumn:oCell:nClr3dS := nClr3dS // 30 3D text shadow color oColumn:oCell:nCursor := nCursor // 31 Rect cursor oColumn:oCell:lInvertColor := !(::lCellBrw .and. nJ != ::nCell) // 32 Invert color If lDrawCell .and. ::lDrawLine lDraw := ::TSDrawCell( oColumn:oCell, oColumn ) Else lDraw := .T. EndIf nStartCol += aColSizes[ nJ ] + nDeltaLen If lDraw AAdd( ::aDrawCols, nJ ) EndIf Next EndIf If ::bOnDraw != Nil Eval( ::bOnDraw, Self ) EndIf If ::lCellBrw cMsg := iif( ! Empty( ::AColumns[ ::nCell ]:cMsg ), ::AColumns[ ::nCell ]:cMsg, ::cMsg ) cMsg := iif( ValType( cMsg ) == "B", Eval( cMsg, Self, ::nCell ), cMsg ) If ! Empty( cMsg ) ::SetMsg( cMsg ) EndIf EndIf ::lDrawSelect := .F. Return Self [/pre2]
Haz: сделал все таки так [pre2] METHOD Refresh( lPaint, lRecount, lClearHash ) CLASS TSBrowse Default lPaint := .T., ; lRecount := .F.,; lClearHash := .T. IF lClearHash ::aFastDrawCell := hb_Hash() EndIf If ::lFirstPaint == Nil .or. ::lFirstPaint Return 0 EndIf If lRecount .or. Empty( ::nLen ) ::nLen := iif( ::lIsDbf, ( ::cAlias )->( Eval( ::bLogicLen ) ), Eval( ::bLogicLen ) ) EndIf ::lNoPaint := .F. Return ::Super:Refresh( lPaint ) METHOD GoLeft() CLASS TSBrowse ... If lDraw ::Refresh( .F.,, .F. ) EndIf ... If ::nCell > ( ::nFreeze + 1 ) ::nColPos := ::nCell := ::nFreeze + 1 ::Refresh( .F.,, .F.) If ::oHScroll != Nil ::oHScroll:GoTop() EndIf EndIf METHOD GoRight() CLASS TSBrowse If lRefresh ::lNoPaint := .F. ::Refresh( .F.,,.F. ) ElseIf ! ::lEditing ::DrawSelect() EndIf [/pre2]
SergKis: Haz пишет то есть пробежаться по всей таблице без прорисовки и получить хаш всей таблицы Такой вариант есть, я потому и вынес (предложение выше)[pre2] IF ::lFastDrawCell .and. ! lCell hb_HSet( ::aFastDrawCell, cCell, __objClone( oColumn:oCell ) ) ENDIF за скобки. Делаем как в примерах Tsb_Export_2 oBrw:lDrawLine := .F. dbGotop() do while !EOF() oBrw:DrawLine() dbSkip() enddo oBrw:lDrawLine := .T. [/pre2] hash колонок создан
Haz: SergKis пишет: Такой вариант есть, я потому и вынес (предложение выше) Согласен , можно так сделать через отдельный флаг . Но чуть позже когда общая логика выстроится. Пока погонял с изменениями на рабочем проекте. Мне нравится тяжелые бровсы с подменными значениями в колонках ожили.
SergKis: Haz пишет сделал все таки так По мне, нужен отд. метод и переменная в классе, т.к. можно удалить из hash - только одну колонку - все колонки одной строки nAt - все колонки Переменную и метод назвать, к примеру DATA lFastDrawClear AS LOGICAL INIT .T. METHOD FastDrawClear( ... ) Для начала параметр .T.\.F. потом уточнятся
SergKis: Haz пишет сделал все таки так Поправил, попробовал. Работает шустрее тсб
Haz: SergKis пишет: По мне, нужен отд. метод и переменная в классе, т.к. можно удалить из hash Выделим в метод, это уже детали , которые дают дополнительный сервис к новому функционалу. базовую логику можно и так обыграть.
SergKis: Haz пишет Выделим в метод, это уже детали Но переменную надо уже сейчас добавить[pre2] DATA lFastDrawClear AS LOGICAL INIT .T. ... METHOD Refresh( lPaint, lRecount, lClearHash ) CLASS TSBrowse Default lPaint := .T., ; lRecount := .F., ; lClearHash := ::lFastDrawClear ... [/pre2]
Haz: SergKis пишет: Но переменную надо уже сейчас добавить Будем считать что она есть
SergKis: Игорь Ты еще что то правил ? Я в перерывах на кофе правил, то что писал. Погонял на примерах, косяков не заметил. У меня нет проектов на этой версии hmg, надо переносить изменения в свою. Потому и спрашиваю. Если шевелится, то буду переносить и Григорию для версии положить.
gfilatov2002: SergKis пишет: Григорию для версии положить Заранее благодарен Погонял текущий hash-вариант на тестовой локальной базе с миллионом записей - вроде, работает нормально
Haz: SergKis пишет: Ты еще что то правил по мелочам вызовы refresh в методах. Не критично. У меня комп только на работе. Скину завтра номера строк. Тоже погонял, на рабочем проекте. Пользователи не заметили. Первая бэтка вышла удачной
Haz: Сергей! Думаю нужны три метода для этого хеша. Это check, refresh и clear возможно как ты предлагал все целиком или по колонкам. И вроде больше добавить нечего. Если только перерисовку ячейки в видимой части бровса при изменении в хеш без изменения фокуса бровса.
SergKis: gfilatov2002 Сделал правки [pre2] CLASS TSBrowse FROM TControl ... ACCESS Tsb INLINE ::oWnd ACCESS nAtPos INLINE iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) ... METHOD FastDrawClear( cCell ) CLASS TSBrowse LOCAL oCell, oCol Default cCell := ::nAtPos IF ISNUMERIC( cCell ) ; cCell := hb_ntos( cCell ) ENDIF IF ISLOGICAL( cCell ) .and. cCell ::aFastDrawCell := hb_Hash() ELSEIF ISCHAR( cCell ) IF "." $ cCell oCell := hb_HGetDef( ::aFastDrawCell, cCell, NIL ) IF oCell != Nil hb_HDel( ::aFastDrawCell, cCell ) ENDIF ELSE FOR EACH oCol IN ::aColumns oCell := hb_HGetDef( ::aFastDrawCell, cCell+"."+hb_ntos( oCol:nId ), NIL ) IF oCell != Nil hb_HDel( ::aFastDrawCell, cCell+"."+hb_ntos( oCol:nId ) ) ENDIF NEXT ENDIF ENDIF Return Self ... 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 ::FastDrawClear( hb_ntos( ::nAtPos )+"."+hb_ntos( oCol:nId ) ) cMsg := iif( ValType( cMsg ) == "B", Eval( cMsg, Self, nCell ), cMsg ) ... 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 ) ELSE ::aRowPosAtRec[ xRow ] := ::nAtPos //ELSEIF ::lIsDbf // ::aRowPosAtRec[ xRow ] := ( nAt := ( ::cAlias )->( RecNo() ) ) //ELSEIF ::lIsArr // ::aRowPosAtRec[ xRow ] := ( nAt := ::nAt ) ENDIF ENDIF If ::nLen > 0 IF nAt == Nil ; nAt := ::nAtPos // iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) 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 ) ELSE ::aRowPosAtRec[ xRow ] := ::nAtPos //ELSEIF ::lIsDbf // ::aRowPosAtRec[ xRow ] := ( nAt := ( ::cAlias )->( RecNo() ) ) //ELSEIF ::lIsArr // ::aRowPosAtRec[ xRow ] := ( nAt := ::nAt ) ENDIF ENDIF ... IF nAt == Nil ; nAt := ::nAtPos // iif( ::lIsDbf, ( ::cAlias )->( RecNo() ), ::nAt ) ENDIF ... If lDrawCell .and. ::lDrawLine lDraw := ::TSDrawCell( oColumn:oCell, oColumn ) Else lDraw := .T. EndIf IF ::lFastDrawCell .and. ! lCell hb_HSet( ::aFastDrawCell, cCell, __objClone( oColumn:oCell ) ) ENDIF nStartCol += aColSizes[ nJ ] + nDeltaLen ... [/pre2]
SergKis: Haz пишет Думаю нужны три метода для этого хеша. Это check, refresh и clear Не очень понятны по смыслу check, refresh. Для одной колонки и даже для всей строки - проще удалить чем выяснять или я не учитываю что то.
SergKis: gfilatov2002 Чуток поправить [pre2] METHOD FastDrawClear( cCell ) CLASS TSBrowse LOCAL oCell, oCol Default cCell := ::nAtPos IF ISNUMERIC( cCell ) ; cCell := hb_ntos( cCell ) ENDIF IF ! ::lFastDrawCell ELSEIF ISLOGICAL( cCell ) .and. cCell ::aFastDrawCell := hb_Hash() ... [/pre2]
kkg: SergKis [pre2] ENDIF ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... IF ::lRowPosAtRec .and. ::nRowCount() > 0 IF Empty( ::aRowPosAtRec ) .or. Len( ::aRowPosAtRec ) != ::nRowCount() ::aRowPosAtRec := Array( ::nRowCount() ) AFill( ::aRowPosAtRec, 0 ) ENDIF IF xRow == 0 .or. xRow > Len( ::aRowPosAtRec ) ELSE ::aRowPosAtRec[ xRow ] := ::nAtPos //ELSEIF ::lIsDbf // ::aRowPosAtRec[ xRow ] := ( nAt := ( ::cAlias )->( RecNo() ) ) //ELSEIF ::lIsArr // ::aRowPosAtRec[ xRow ] := ( nAt := ::nAt ) ENDIF ENDIF ... [/pre2] Серж, я ещё такую правку делаю, иначе на пустых выборках слетает
gfilatov2002: SergKis пишет: Сделал правки OK, принято SergKis пишет: Чуток поправить Благодарю за помощь
Haz: SergKis пишет: Не очень понятны по смыслу check, refresh. Для одной колонки и даже для всей строки - проще удалить чем выяснять или я не учитываю что то. Tsbrowse статичен , то есть это просто отрисованная картинка, а хеш содержит все нобходимые данные для проверки какие ячейки изменились. С появлением хеша появилась возможность в realtime показывать изменения ячеек другими пользователями по сети без перерисовки всего бровса. Смысл не только в визуальном вау ээфекте, очень часто возникает диалог - Поменяй !!! - поменял - не вижу - обнови - как ? итд
SergKis: kkg пишет такую правку делаю, иначе на пустых выборках слетает Надо как в :DrawLine()[pre2] METHOD DrawSelect( 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 ) ELSE ::aRowPosAtRec[ xRow ] := ::nAtPos ENDIF ENDIF ... [/pre2]
Haz: Тут добавил третий параметр в ::Refresh() [pre2] METHOD ChangeFont( hFont, nColumn, nLevel ) CLASS TSBrowse ... If ::lPainted SetHeights( Self ) ::Refresh( .F.,,.F. ) EndIf METHOD DelColumn( nPos ) CLASS TSBrowse ... ::SetFocus() ::Refresh( .F.,,.F. ) METHOD PageDown( nLines ) CLASS TSBrowse ... If nKeyPressed == Nil ::Refresh( ::nLen < nTotLines,, .F. ) METHOD PageUp( nLines ) CLASS TSBrowse ... If ::lPageMode .and. ::nRowPos > 1 ::DrawLine() // nSkipped := ::Skip( -( ::nRowPos - 1 ) ) //V90 active ::nRowPos := 1 ::Refresh( .F.,,.F. ) METHOD PanEnd() CLASS TSBrowse ... ::Refresh( .F. ,, .F.) If ! ::lNoHScroll .and. ::oHScroll != Nil METHOD PanLeft() CLASS TSBrowse ... If ::nCell != ::nOldCell ::Refresh( .F. ,, .F.) EndIf METHOD PanRight() CLASS TSBrowse ... If ::nCell != ::nOldCell ::Refresh( .F.,, .F. ) EndIf METHOD PostEdit( uTemp, nCol, bValid ) CLASS TSBrowse ... If lAppend .and. ::nLen <= ::nRowCount() ::Refresh( .T. ,, .F.) ::nRowPos := Min( ::nRowCount(), ::nLen ) EndIf METHOD SetNoHoles( nDelta, lSet ) CLASS TSBrowse ... ::Paint() ::lEnabled := .T. ::Refresh( .F.,,.F. ) [/pre2]
SergKis: Haz пишет Tsbrowse статичен , то есть это просто отрисованная картинка, а хеш содержит все нобходимые данные для проверки какие ячейки изменились. Т.е. пляшем от hash, а не колонок, что то типа такого[pre2] Local oCols := oKeyData():aKey := oBrw:aFastDrawCell Local aCols := oCols:GetAll(.F.), aCol, nCol, oCol, cCell Local xData, uData FOR EACH aCol IN aCols cCell := aCol[1] oCol := aCol[2] xData := oCol:oCell:uValue uData := oBrw:GetValue(oCol:cName) IF xData != uData .... ENDIF NEXT [/pre2]
SergKis: PS Пропустил переход по записям[pre2] nRec := val(left(cCell, At(".", cCell)-1)) (oBrw:cAlias)->( dbGoto(nRec) ) // тут xData, uData [/pre2]
Haz: SergKis пишет: Т.е. пляшем от hash, а не колонок, что то типа такого да , примерно так пока не сложилось как понять что oCell принадлежит видимой части ( окну ) бровса
gfilatov2002: gfilatov2002 пишет: OK, принято Заметил некорректную работу при активном индексе в базе (зависает при сортировке - двойной клик по заголовку колонки). Пример для проверки - в папке \SAMPLES\Advanced\Tsb_SpecHeader
Haz: gfilatov2002 пишет: Заметил некорректную работу при активном индексе в базе (зависает при сортировке - двойной клик по заголовку колонки). у меня отработало нормально. Может какие правки из последних не учел. Есть где взять со всеми последними изменениями ? На рабочем проекте тоже переключает индексы нормально
gfilatov2002: Haz пишет: На рабочем проекте тоже переключает индексы нормально Отлично, значит, мне показалось Haz пишет: где взять со всеми последними изменениями ? Выложил здесь click here
SergKis: Haz пишет На рабочем проекте тоже переключает индексы нормально Соглашусь с Григорием Заметил некорректную работу при активном индексе в базе (зависает при сортировке - двойной клик по заголовку колонки). Установил последнюю версию в раб. каталоге (без последних изменений с FastDraw), пример \SAMPLES\Advanced\Tsb_SpecHeader работает странно (меню первое пункт SPECHEADER) не виснет, но сортировка туду-сюда нормально не работает. В тексте есть[pre2] Brw_1:aColumns[ 1 ]:cOrder := "FIRST" Brw_1:aColumns[ 4 ]:cOrder := "CITY" Brw_1:SetAppendMode( .T. ) //Brw_1:SetIndexCols( 1, 2 ) Brw_1:SetIndexCols( 1, 4 ) // поправил на 4-ю колонку индекс //Brw_1:SetOrder( 1 ) [pre2] работает при 2 клике по колонкам, но странно. Пример Tsb_addrecord_2 с такими же возможностями 2 клика -> сортировка работает нормально и в версии с FastDraw Правка текста в нем для сортировки туда-обратно, так же работает OK, т.е.[pre2] ... oCol := oBrw:GetColumn("ID") oCol:cOrder := "KOD" //oCol:lNoDescend := .T. oCol := oBrw:GetColumn("INFO") oCol:cOrder := "NAM" //oCol:lNoDescend := .T. ... oBrw:SetIndexCols( oBrw:nColumn("ID"), ; oBrw:nColumn("INFO") ) oBrw:SetOrder( oBrw:nColumn("ID") ) ... [/pre2]
SergKis: Haz пишет На рабочем проекте тоже переключает индексы нормально Соглашусь с Григорием Заметил некорректную работу при активном индексе в базе (зависает при сортировке - двойной клик по заголовку колонки). Установил последнюю версию в раб. каталоге (без последних изменений с FastDraw), пример \SAMPLES\Advanced\Tsb_SpecHeader работает странно (меню первое пункт SPECHEADER) не виснет, но сортировка туду-сюда нормально не работает. В тексте есть[pre2] Brw_1:aColumns[ 1 ]:cOrder := "FIRST" Brw_1:aColumns[ 4 ]:cOrder := "CITY" Brw_1:SetAppendMode( .T. ) //Brw_1:SetIndexCols( 1, 2 ) Brw_1:SetIndexCols( 1, 4 ) // поправил на 4-ю колонку индекс //Brw_1:SetOrder( 1 ) [pre2] работает при 2 клике по колонкам, но странно. Пример Tsb_addrecord_2 с такими же возможностями 2 клика -> сортировка работает нормально и в версии с FastDraw Правка текста в нем для сортировки туда-обратно, так же работает OK, т.е.[pre2] ... oCol := oBrw:GetColumn("ID") oCol:cOrder := "KOD" //oCol:lNoDescend := .T. oCol := oBrw:GetColumn("INFO") oCol:cOrder := "NAM" //oCol:lNoDescend := .T. ... oBrw:SetIndexCols( oBrw:nColumn("ID"), ; oBrw:nColumn("INFO") ) oBrw:SetOrder( oBrw:nColumn("ID") ) ... [/pre2]
SergKis: PS :lFastDrawCell не ставил в .T., т.е. отключена была для тестирования этих примеров
SergKis: PS2 проверил с :lFastDrawCell := .T. туда-сюда сортировка на колонках работает нормально, версия с изменениями FastDraw
SergKis: это про пример Tsb_addrecord_2, не туда ткнул
gfilatov2002: SergKis пишет: пример \SAMPLES\Advanced\Tsb_SpecHeader работает странно Разобрался и поправил этот пример для правильной работы с индексом NTX. 1) создание индексов д.б. USE Employee SHARED NEW Index On Employee->First+Employee->Last To Name // NTX Index On Employee->City To City // NTX Set Index To Name, City // NTX 2) подключение индексов в зависимости от типа источника данных д.б. [pre2] IF met > 1 Brw_1:aColumns[ 1 ]:cOrder := "FIRST" Brw_1:aColumns[ 4 ]:cOrder := "CITY" ELSE Brw_1:aColumns[ 1 ]:cOrder := "Name" Brw_1:aColumns[ 4 ]:cOrder := "City" ENDIF [/pre2] Теперь пример работает нормально
Haz: gfilatov2002 пишет: Теперь пример работает нормально попереключал сортировку в своем проекте с последними изменениям - все отлично работает. Видимо в примере действительно проблема была
SergKis: Haz пишет пока не сложилось как понять что oCell принадлежит видимой части ( окну ) бровса Так в теории будет выглядеть функция (метод такой вряд ли нужен, слишком много вариантов, что можно делать)[pre2] FUNC FastDrawCheck( oBrw ) Local oCols := oKeyData():aKey := hb_HSort( oBrw:aFastDrawCell ) Local aCols := oCols:GetAll(.F.) Local cAls := oBrw:cAlias Local aCol, nCol, oCol, cCell Local xData, uData, nRec Local lVisi, lEque FOR EACH aCol IN aCols cCell := aCol[1] oCol := aCol[2] nRec := val( left(cCell, At(".", cCell)-1) ) lEque := .F. lVisi := .F. uData := Nil xData := oCol:oCell:uValue If nRec != (cAls)->( RecNo() ) (cAls)->( dbGoto(nRec) ) EndIf If nRec == (cAls)->( RecNo() ) uData := oBrw:GetValue(oCol:cName) lEque := xData == uData lVisi := AScan( oBrw:aRowPosAtRec, nRec ) > 0 // видимость на екране IF ! lEque // ... ENDIF IF lVisi // ... ENDIF EndIf AAdd( aCol, lVisi ) AAdd( aCol, lEque ) AAdd( aCol, xData ) AAdd( aCol, uData ) NEXT RETURN aCols [/pre2]
SergKis: gfilatov2002 Посмотрел h_tbrowse.zip, небольшие правки[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 ) ELSE ::aRowPosAtRec[ xRow ] := ( nAt := ::nAtPos ) ENDIF ENDIF ... Не обязательно, но так лучше - убрать лишнее IF Empty( oColumn:oCell ) oColumn:oCell := TSBcell():New() ENDIF oCell := oColumn:oCell oCell:nRow := xRow oCell:nCol := nStartCol ... oCell:nCursor := 0 // 31 Rect cursor oCell:lInvertColor := .F. // 32 Invert color ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... IF ::lRowPosAtRec .AND. Len( ::nRowCount() ) > 0 IF Empty( ::aRowPosAtRec ) .OR. Len( ::aRowPosAtRec ) != ::nRowCount() ::aRowPosAtRec := Array( ::nRowCount() ) AFill( ::aRowPosAtRec, 0 ) ENDIF IF ::nLen == 0 .or. xRow == 0 .OR. xRow > Len( ::aRowPosAtRec ) ELSE ::aRowPosAtRec[ xRow ] := ( nAt := ::nAtPos ) ENDIF ENDIF ... IF Empty( oColumn:oCell ) oColumn:oCell := TSBcell():New() ENDIF oCell := oColumn:oCell oCell:nRow := nRowPos oCell:nCol := nStartCol ... oCell:nCursor := nCursor // 31 Rect cursor oCell:lInvertColor := !( ::lCellBrw .AND. nJ != ::nCell ) // 32 Invert color [/pre2]
SergKis: gfilatov2002 Посмотрел h_tbrowse.zip, небольшие правки[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 ) ELSE ::aRowPosAtRec[ xRow ] := ( nAt := ::nAtPos ) ENDIF ENDIF ... Не обязательно, но так лучше - убрать лишнее IF Empty( oColumn:oCell ) oColumn:oCell := TSBcell():New() ENDIF oCell := oColumn:oCell oCell:nRow := xRow oCell:nCol := nStartCol ... oCell:nCursor := 0 // 31 Rect cursor oCell:lInvertColor := .F. // 32 Invert color ... METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... IF ::lRowPosAtRec .AND. Len( ::nRowCount() ) > 0 IF Empty( ::aRowPosAtRec ) .OR. Len( ::aRowPosAtRec ) != ::nRowCount() ::aRowPosAtRec := Array( ::nRowCount() ) AFill( ::aRowPosAtRec, 0 ) ENDIF IF ::nLen == 0 .or. xRow == 0 .OR. xRow > Len( ::aRowPosAtRec ) ELSE ::aRowPosAtRec[ xRow ] := ( nAt := ::nAtPos ) ENDIF ENDIF ... IF Empty( oColumn:oCell ) oColumn:oCell := TSBcell():New() ENDIF oCell := oColumn:oCell oCell:nRow := nRowPos oCell:nCol := nStartCol ... oCell:nCursor := nCursor // 31 Rect cursor oCell:lInvertColor := !( ::lCellBrw .AND. nJ != ::nCell ) // 32 Invert color [/pre2]
SergKis: Опять 2а раза отправилось
gfilatov2002: SergKis пишет: METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... IF ::lRowPosAtRec .AND. Len( ::nRowCount() ) > 0 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 ::nLen > 0
SergKis: Игорь Уточнение по видимости колонки lVisi := AScan( oBrw:aRowPosAtRec, nRec ) > 0 .and. AScan( oBrw:aDrawCols, oBrw:nColumn(oCol:cName) ) // видимость
kkg: gfilatov2002 Григорий, пересмотрел изменения которые я вношу, возможно данное примете в стандарт если будет интересно сообществу HbXlsXml [pre2] CREATE CLASS ExcelWriterXML_Sheet VAR id VAR aAddSheet INIT {} VAR cells INIT { => } VAR colWidth INIT { => } ... METHOD ExcelWriterXML_Sheet:getSheetXML( handle ) ... xml += " </Table>" + hb_eol() if valtype(::aAddSheet) == 'A' .and. len(::aAddSheet)>0 for ir = 1 to len(::aAddSheet) xml += ::aAddSheet[ir] + hb_eol() next endif xml += "</Worksheet>" + hb_eol() ... я использую для передачи "заморозки" шапки, nFreeze и АвтоФильтра aadd(oSh,' <WorksheetOptions xmlns="urn:schemas-microsoft-com:office:excel">') aadd(oSh,' <Unsynced/>') aadd(oSh,' <FreezePanes/>') aadd(oSh,' <FrozenNoSplit/>') aadd(oSh,' <SplitHorizontal>+[номер строки]+</SplitHorizontal>') aadd(oSh,' <TopRowBottomPane>+[номер строки]+</TopRowBottomPane>') aadd(oSh,' <SplitVertical>'+[номер колонки]+'</SplitVertical>') aadd(oSh,' <LeftColumnRightPane>'+[номер колонки]+'</LeftColumnRightPane>') aadd(oSh,' <ActivePane>0</ActivePane>') aadd(oSh,' <Panes>') aadd(oSh,' <Pane>') aadd(oSh,' <Number>3</Number>') aadd(oSh,' </Pane>') aadd(oSh,' <Pane>') aadd(oSh,' <Number>1</Number>') aadd(oSh,' <ActiveCol>2</ActiveCol>') aadd(oSh,' </Pane>') aadd(oSh,' <Pane>') aadd(oSh,' <Number>2</Number>') aadd(oSh,' </Pane>') aadd(oSh,' <Pane>') aadd(oSh,' <Number>0</Number>') aadd(oSh,' <ActiveCol>0</ActiveCol>') aadd(oSh,' </Pane>') aadd(oSh,' </Panes>') aadd(oSh,' <ProtectObjects>False</ProtectObjects>') aadd(oSh,' <ProtectScenarios>False</ProtectScenarios>') aadd(oSh,' </WorksheetOptions>') aadd(oSh,' <AutoFilter x:Range="R+[строка]+C+[колонка]+:R+[строка]+C'+[колонка]+'" xmlns="urn:schemas-microsoft-com:office:excel">') aadd(oSh,' </AutoFilter>') [/pre2]
kkg: gfilatov2002 пересобрал с последними изменениями есть поправка [pre2] METHOD DrawSelect( xRow, lDrawCell ) CLASS TSBrowse ... [4622] IF ::lRowPosAtRec .AND. ::nRowCount() > 0 // без len() [/pre2]
gfilatov2002: kkg пишет: есть поправка Принято
SergKis: Haz пишет предлагаю добавить Игорь, а чем не подошло METHOD FastDrawClear( cCell ) CLASS TSBrowse описанный выше cCell := .T. - очищает hash cCell := :nAtPos - удаляет колонки строки заданной cCell := hb_ntos(:nAtPos)+"."+hb_ntos( oCol:nId ) - удаляет колонку
SergKis: PS Например AEval(oBrw:aRowPosAtRec, {|nat| oBrw:FastDrawClear(nat) }) удалит все колонки для строк, участвующих в Refresh()
Haz: SergKis пишет: Игорь, а чем не подошло Видимо тем что отвлекался от этой темы ( работы много ) и не обновил у себя исходник. В своем ничего не нашел и быстренько написал. Метод есть , все устраивает Удалю пост чтоб не путать
gfilatov2002: Подготовил первый RC для новой сборки 20.10 Кратко, что нового: [pre2] * Added the new functions for Windows GDI objects memory release. It will activate the GDI objects recording and call CheckRes() to generate the checkres.txt log file on the application quit. Note: This feature will work after setting of debugging mode via the Harbour command Set( _SET_DEBUG, .T. ) or AltD( 1 ). * Fixed detected resource leakage of GDI objects at the release of Main form with usage of the new MiniGUI Resources control system. * TOOLBAR control: toolbuttons supports an optional ADJUST clause. * Revised a hot mouse tracking in the ButtonEx control. * Revised a releasing of the AniGif control. * Synchronized Extended HMG for compatibility with Official HMG: - COMBOBOXEX supports the optional clause NOTRANSPARENT; - IMAGE CHECKBUTTON supports the optional clause NOTRANSPARENT; - TAB control supports the optional clause NOTRANSPARENT; - TREE control supports the optional clause NOTRANSPARENT. * Added the optional color's constants to the header files i_color.ch and i_wincolor.ch. * Adaptation FiveWin Class TSBrowse 9.0 in HMG: - added the new variables :lFastDrawCell, :aFastDrawCell and :lFastDrawClear, method :FastDrawClear() for high-speed HASH-based data refreshing in the TSBrowse class; Note: you should set :lFastDrawCell to .T. for switch ON the above mode. Thanks a lot for this GREAT contribution to SergKis and Haz! * Updated Sqlite3 library. * Added the new interesting samples and updated some examples. [/pre2] P.S. Желаю всем доброго здоровья и хорошего дня
gfilatov2002: Опубликована новая сборка 20.10 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив находится по адресу http://hmgextended.com/files/CONTRIB/hmg-20.10-setup.exe Огромная благодарность Сергею Киселеву и Игорю Назарову за помощь при подготовке этой сборки
SergKis: gfilatov2002 Поправьте, слетает Tsb_DemoMdi при Alt+F4, .т.к. в окнах _HMG_aFormMiscData1[ k ] := {} (может еще где) [pre2] FUNCTION ReleaseAllWindows () ... IF Len( _HMG_aFormMiscData1[ i ] ) > 0 .and. _HMG_aFormMiscData1 [ i ] [ 1 ] != NIL DestroyIcon ( _HMG_aFormMiscData1 [ i ] [ 1 ] ) ENDIF IF Len( _HMG_aFormMiscData1[ i ] ) > 2 .and. ! Empty ( _HMG_aFormMiscData1 [ i ] [ 3 ] ) DeleteObject ( _HMG_aFormMiscData1 [ i ] [ 3 ] ) ENDIF ... [/pre2]
SergKis: PS Наверно, надо вставить освобождение и в h_events.prg на CASE WM_DESTROY добавить
gfilatov2002: SergKis пишет: Поправьте, слетает Tsb_DemoMdi при Alt+F4 Поправил, конечно Благодарю за помощь P.S. Сделал тихое обновление этой сборки с учетом найденных ошибок...
gfilatov2002: Выпустил 1-е обновление сборки 20.10 Что нового: [pre2] * Fixed: Browse control without PICTURE option had a wrong formatting for the fields with negative numbers (introduced in the build 20.05). Bug was reported by Pablo Jalabert. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\Browse_4) * Fixed: Correction in the Imagelist ADD IMAGE commands. Syntax: ADD IMAGE <image> [ MASK <mask> ] TO <control> OF <parent> ADD MASKEDIMAGE <image> [ COLOR <aColor> ] TO <control> ; OF <parent> Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\TOOLBAR_3) * Enhanced: TOOLBAR control: tool buttons respect the BALLOON style of tooltips and the command SET TOOLTIP [ ACTIVATE ] <ON | OFF>. Requested by Ivanil Marcelino <ivanil/at/linkbr.com.br>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Basic\TOOLBAR_2) * Enhanced: ANIGIF control: added support of animated GIF from resources. Requested by Ivanil Marcelino <ivanil/at/linkbr.com.br>. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see demo in folder \samples\Advanced\AniGIF) * Enhanced: BtnTextBox and GetBox controls support Controls Context menu. Requested by Ivanil Marcelino <ivanil/at/linkbr.com.br>. Contributed by Grigory Filatov <gfilatov@inbox.ru> * Modified: Adding the new selected values to the multiple selection Grid was significantly accelerated (noticeable for grids with more than one hundred thousand items). Suggested by HMG user Edward. Contributed by Grigory Filatov <gfilatov@inbox.ru> * New: 'Month Calendar control with the bold days and backcolor' sample. Based upon a contribution of Kevin Carmody <i@kevincarmody.com>. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see demo3.prg in folder \samples\Basic\MONTHCAL) * New: 'MiniGUI ToolBar ImageList Demo' sample. Contributed by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\TOOLBAR_3) [/pre2]
gfilatov2002: Выложил 2-е обновление сборки 20.10 В этом обновлении добавил новый элемент управления - PROGRESSWHEEL. Для его усовершенствования требуется помощь сишника - Петр, сможете помочь
gfilatov2002: Выложил срочное 3-е обновление сборки 20.10 Причина: напутал в функции вычисления цвета градиента для PROGRESSWHEEL (поправил без помощи Петра). Также учтены пожелания Андрея для ButtonEx
Andrey: gfilatov2002 пишет: Также учтены пожелания Андрея для ButtonEx Спасибо !
gfilatov2002: Выложил 4-е обновление сборки 20.10 с учетом последних исправлений Надеюсь, что это последний апдейт для этой сборки ЗЫ. Выпуск новых сборок больше не планируется...
gfilatov2002: gfilatov2002 пишет: Выпуск новых сборок больше не планируется... Пересмотрел свои планы, и решил все же выпустить декабрьскую сборку. Уже подготовил ее первую бета-версию, изюминкой которой должны стать оригинальные исходники HMG-IDE Роберто Лопеза, которые я адаптировал для Минигуи
Andrey: gfilatov2002 пишет: Пересмотрел свои планы, и решил все же выпустить декабрьскую сборку. Отличная новость !
Haz: gfilatov2002 пишет: Пересмотрел свои планы, и решил все же выпустить Хорошая новость. Спасибо Григорий
sashaBG: У меня вопрос по TSBrowse в Select mode. Есть необходимость выбрать все строки TSBrowse , нажатием клавишили . Я думаю надо заполнить самому масив ::aSelected а потом вызвать ::DrawSelect() Подскажите пожалуйста, если есть другой способ! Будьте здоровы!
Dima: sashaBG Заполняешь некий массив номерами записей (у меня HASH) , после делаем Refresh В описании бровса у меня obrwloc:SetColor( { 1 ,2}, { CLR_BLACK ,{||if(!hb_hhaskey(hinsrec,(obrwloc:calias)->(recno())),rgb(255,255,206),rgb(255,179,255))} } )
SergKis: sashaBG пишет потом вызвать ::DrawSelect() Потом надо вызвать :Refresh(), т.к. надо перепоказать все строки. Другой способ используя hash или в режиме set oop on[pre2] oCol := :GetColumn("ID") oCol:Cargo:oSelect := oKeyData() // hb_Hash() oCol:nClrBack := {|at,nc,br,oc| oc := br:aColumns[nc], at := oc:Cargo:oSelect:Get(br:nAtPos, 0), ; iif( at > 0, CLR_BLUE, CLR_WHITE ) } // меняем цвет в колонке от наличия номера записи в :Cargo:oSelect // вместо цвета можно менять bmp в колонке, цвет взял для просто меньше писать ... :UserKeys( VK_SPACE, {|ob,nr,oc| // Select\UnSelect oc := ob:GetColumn("ID") nr := oc:Cargo:oSelect:Get((ob:nAtPos, 0) If nr > 0 oc:Cargo:oSelect:Del(ob:nAtPos) Else oc:Cargo:oSelect:Set(ob:nAtPos, ob:nAtPos) EndIf ob:DrawSelect() do events Return Nil } :UserKeys( VK_F2, {|ob| // Select All Local cAls := ob:cAlias, nRec Local nOld := (cAls)->(RecNo()) Local oc := ob:GetColumn("ID") oc:Cargo:oSelect:oKeyData() do while (cAls)->( !EOF() ) nRec := (cAls)->(RecNo()) oc:Cargo:oSelect:Set(nRec, nRec) (cAls)->(dbSkip()) enddo (cAls)->(dbGoto(nOld)) Return Nil } :UserKeys( VK_F3, {|ob| // Get values all Selected line Local oc := ob:GetColumn("ID") ? "aSelected =", oc:Cargo:oSelect:GetAll(.F.) ?v oc:Cargo:oSelect:GetAll(.F.) ? Return Nil } [/pre2] Написанное применимо к любой колонке и не имеет значения находится TSBrowse в Select mode или нет С hash похожие действия
SergKis: PS добавить надо[pre2] :UserKeys( VK_F2, {|ob| // Select All ... (cAls)->(dbGoto(nOld)) ob:Refresh() do events Return Nil } [/pre2]
sashaBG: Сапсибо Сергей, работает!
SergKis: sashaBG пишет работает! Добавка в пример Tsb_BitMaps для работы с bmp индикацией (клавиши: SPACE, F2, F3, F5)[pre2] LOCAL oCol SET OOP ON ... oBrw:GetColumn("FLD7"):lBitMap := .T. oBrw:aBitMaps := { LoadImage(".\RES\flag_bel.bmp"), ; LoadImage(".\RES\flag_en.bmp" ), ; LoadImage(".\RES\flag_kaz.bmp"), ; LoadImage(".\RES\flag_ru.bmp" ), ; LoadImage(".\RES\flag_ua.bmp" ), ; StockBmp( 7 ) , ; StockBmp( 6 ) ; } oCol := :GetColumn("ID") oCol:Cargo := oKeyData() oCol:Cargo:oSelect := oKeyData() oCol:uBmpCell := {|nc,ob| Local oc := ob:aColumns[ nc ] Local nr := oc:Cargo:oSelect:Get(ob:nAtPos, 0) Return ob:aBitMaps[ 6+nr ] } :UserKeys( VK_SPACE, {|ob| // Select\unSelect Local oc := ob:GetColumn("ID") Local nr := ob:nAtPos, np If ( np := oc:Cargo:oSelect:Get(nr, 0) ) > 0 oc:Cargo:oSelect:Del(nr) Else oc:Cargo:oSelect:Set(nr, 1) EndIf ob:DrawSelect() ; DO EVENTS Return Nil } ) :UserKeys( VK_F2, {|ob| // Select all Local cAls := ob:cAlias, nRec Local nOld := (cAls)->(RecNo()) Local oc := ob:GetColumn("ID") oc:Cargo:oSelect:oKeyData() (cAls)->(dbGotop()) do while (cAls)->( !EOF() ) nRec := (cAls)->(RecNo()) oc:Cargo:oSelect:Set(nRec, 1) (cAls)->(dbSkip()) enddo (cAls)->(dbGoto(nOld)) ob:Refresh() ; DO EVENTS Return Nil } ) :UserKeys( VK_F3, {|ob| // unSelect all Local oc := ob:GetColumn("ID") oc:Cargo:oSelect := oKeyData() ob:Refresh() ; DO EVENTS Return Nil } ) :UserKeys( VK_F5, {|ob| // Get values all Selected line Local oc := ob:GetColumn("ID") Local ar := oc:Cargo:oSelect:GetAll(.F.) Local nk := Len(ar) Local cs := "", ni For ni := 1 To nk cs += hb_ValToExp(ar[ ni ]) + iif( ni == nk, "", ";" ) Next AlertInfo( "Selected : "+iif( Empty(cs), "0", ";"+cs ) ) Return Nil } ) ON KEY ESCAPE ACTION ThisWindow.Release ... [/pre2]
gfilatov2002: SergKis пишет: Добавка в пример Tsb_BitMaps Проверил: работает нормально. Благодарю за помощь
SergKis: gfilatov2002 Маленькая правка[pre2] :UserKeys( VK_F2, {|ob| // Select all ... oc:Cargo:oSelect := oKeyData() ... [/pre2]
gfilatov2002: SergKis пишет: Маленькая правка OK
SergKis: gfilatov2002 Добавьте в пример выше строки[pre2] oCol := :GetColumn("ID") oCol:Cargo := oKeyData() oCol:Cargo:oSelect := oKeyData() oCol:Cargo:nSeleBack := CLR_YELLOW oCol:Cargo:aSeleBack := { RGB(220, 220, 220), RGB(220, 220, 220) } oCol:uBmpCell := {|nc,ob| Local oc := ob:aColumns[ nc ] Local nr := oc:Cargo:oSelect:Get(ob:nAtPos, 0) Return ob:aBitMaps[ 6+nr ] } oCol:nClrBack := {|na,nc,ob| Local oc := ob:aColumns[ nc ] na := oc:Cargo:oSelect:Get(ob:nAtPos, 0) Return iif( na > 0, oc:Cargo:nSeleBack, ob:nClrPane ) } oCol:nClrFocuBack := {|na,nc,ob| Local oc := ob:aColumns[ nc ] na := oc:Cargo:oSelect:Get(ob:nAtPos, 0) Return iif( na > 0, oc:Cargo:nSeleBack, oc:Cargo:aSeleBack ) } :nFreeze := 1 :lLockFreeze := .T. :nCell := :nFreeze + 1 :UserKeys( VK_SPACE, {|ob| // Select\unSelect ... [/pre2]
gfilatov2002: ОК Благодарю за помощь
gfilatov2002: Подготовил 2-й RC для новой сборки 20.12 Что нового (кратко): [pre2] * Fixed: A support of use the Harbour pcode DLL was broken in the MiniGUI core (introduced in the build 16.12). * Fixed: Possible program crash at releasing of the standard 'Image Button' control with NOXPSTYLE clause (introduced in the build 16.03). * Synchronized Extended HMG for compatibility with Official HMG: - misc updates for a correct compiling of the HMG-IDE tool. * 'HMG IDE' sample: code was modified to original source of utility. Based upon a contribution of HMG Founder Roberto Lopez. Thanks a lot for this GREAT contribution! * Updated HMGS-IDE v.1.4.4.3, BosTaurus and Sqlite3 libraries. * Added the new interesting samples and updated some examples. * Added the ProcInfo and Selector libraries source code. Note: It is available in the mingw64-based donationware distribution only. [/pre2]
gfilatov2002: Завершена подготовка декабрьской сборки, которая будет опубликована послезавтра. Рассматриваю эту сборку как финальную во всех отношениях...
gfilatov2002: Выложил декабрьскую сборку по адресу: http://hmgextended.com/files/CONTRIB/hmg-20.12-setup.exe Желаю всем мира, добра и здоровья
Dima: gfilatov2002 пишет: Выложил декабрьскую сборку по адресу: Спасибо , я так понял это последняя.... Может и под MINGW выложите ?
gfilatov2002: Dima пишет: Может и под MINGW выложите ? Посмотри в личке...
Andrey: gfilatov2002 пишет: Выложил декабрьскую сборку по адресу: [pre2]* New: 'Get Text Width Test' sample. Based upon a contribution at official HMG forum. Adapted for Minigui Extended by Grigory Filatov <gfilatov@inbox.ru> (see in folder \samples\Basic\GetTextWidth)[/pre2] Давно использую функции Сергея: [pre2]FUNCTION GetTxtWidth( cText, nFontSize, cFontName, lBold ) // получить Width текста LOCAL hFont, nWidth DEFAULT cText := REPL('A', 2) , ; cFontName := _HMG_DefaultFontName, ; // из MiniGUI.Init() nFontSize := _HMG_DefaultFontSize, ; // из MiniGUI.Init() lBold := .F. IF Valtype(cText) == 'N' cText := repl('A', cText) ENDIF hFont := InitFont(cFontName, nFontSize, lBold) nWidth := GetTextWidth(0, cText, hFont) // ширина текста DeleteObject (hFont) RETURN nWidth FUNCTION GetTxtHeight( cText, nFontSize, cFontName, lBold ) // получить Height текста LOCAL hFont, nHeight DEFAULT cText := "B" , ; cFontName := _HMG_DefaultFontName, ; // из MiniGUI.Init() nFontSize := _HMG_DefaultFontSize, ; // из MiniGUI.Init() lBold := .F. hFont := InitFont( cFontName, nFontSize, lBold ) nHeight := GetTextHeight( 0, cText , hFont ) // высота шрифта DeleteObject( hFont ) RETURN nHeight[/pre2] Григорий, можно сделать совместить функции Сергея и новых функции ?
Dima: Andrey пишет: Давно использую функции Сергея Юзай и дальше Andrey пишет: Григорий, можно сделать совместить функции Сергея и новых функции ? Новые функции не в ядре а в примерах , зачем совмещать что то ?
Andrey: Хотелось бы иметь эти функции в ядре ! Замучился таскать их из проекта в проект. Да и маленькие примеры если делаешь, то опять нужно тащить эту функцию в пример. Dima пишет: Новые функции не в ядре а в примерах , зачем совмещать что то ? Да в ядре уже - смотри C:\MiniGUI\SOURCE\c_controlmisc.c
SergKis: Andrey пишет Замучился таскать их из проекта в проект. Используй, например, такой вариант. Сделай свой ch file в Include каталоге i_MySets.ch --------------[pre2] /* my ch */ #xtranslate IsFile( <f> ) => hb_FileExists( <f> ) FUNCTION GetTxtWidth( cText, nFontSize, cFontName, lBold ) // получить Width текста LOCAL hFont, nWidth DEFAULT cText := REPL('A', 2) , ; cFontName := _HMG_DefaultFontName, ; // из MiniGUI.Init() nFontSize := _HMG_DefaultFontSize, ; // из MiniGUI.Init() lBold := .F. IF Valtype(cText) == 'N' cText := repl('A', cText) ENDIF hFont := InitFont(cFontName, nFontSize, lBold) nWidth := GetTextWidth(0, cText, hFont) // ширина текста DeleteObject (hFont) RETURN nWidth FUNCTION GetTxtHeight( cText, nFontSize, cFontName, lBold ) // получить Height текста LOCAL hFont, nHeight DEFAULT cText := "B" , ; cFontName := _HMG_DefaultFontName, ; // из MiniGUI.Init() nFontSize := _HMG_DefaultFontSize, ; // из MiniGUI.Init() lBold := .F. hFont := InitFont( cFontName, nFontSize, lBold ) nHeight := GetTextHeight( 0, cText , hFont ) // высота шрифта DeleteObject( hFont ) RETURN nHeight [/pre2] А в prg делай #include <hmg.ch> #include <i_MySets.ch> ... Можно в hmg.ch добавить такую строку
SergKis: PS Т.к. это крайняя версия hmg (если и будет меняться, то редко) можешь смело в h_tbrowse.prg добавить #include <i_MySets.ch> // без стр. #xtranslate ... и пересобрать только tsbrowse.lib можешь еще свои доп. ф-ии определить в ch file. Если будет new версия, установишь и снова добавишь в h_tbrowse.prg #include <i_MySets.ch>
Vlad04: gfilatov2002 Было заявлено исходники HMG-IDE Роберто Лопеза, которые я адаптировал для Минигуи Где искать ?
gfilatov2002: Vlad04 пишет: Где искать ? Посмотри в папке \samples\Advanced\hmgide
Vlad04: BtnTextBox естественно нет ?
gfilatov2002: gfilatov2002 пишет: Пересмотрел свои планы Снова пересмотрел свои планы, и решил выпустить январскую сборку (с учетом последних исправлений ). Кратко, что нового: [pre2] * Fixed: The symbol fonts were abandoned in the internal function _DefineFont() (introduced in the build 16.12). * Fixed: An Image index assigning was ignored in the Grid control with 'ColumnControls' property defined as NIL (introduced in the build 20.06). * The command DEFINE FONT <font> FONTNAME <name> ... will delete automatically a previous font definition instead of the error message. * Adaptation of MiniGUI core for compatibility with Borland/ Embarcadero C++ 7.20 64-bit compiler. * Added the Harbour contrib library for Cabinet file (*.CAB) compression and extraction. * Added the binary of HMG IDE tool of Roberto Lopez. * Updated SQLite3 library and the some examples. [/pre2]
Andrey: Отличная новость ! Поздравляю всех с Рождеством !
gfilatov2002: Всем кому это интересно Завершена подготовка новой сборки 21.01 для BCC 5.8.2 и компиляторов Harbour и xHarbour, которая будет опубликована послезавтра. В основном сборка содержит исправления для обнаруженных недоработок, но есть и новое - добавлена библиотека HbCab для сжатия информации в формате CAB.
gfilatov2002: Опубликована январская сборка библиотеки, которая доступна по адресу: http://hmgextended.com/files/CONTRIB/hmg-21.01-setup.exe Желаю всем удачи в этом году
Andrey: gfilatov2002 пишет: Опубликована январская сборка библиотеки Отличная новость! Пере собрал свою прогу, вроде работает !
Haz: gfilatov2002 пишет: Опубликована январская сборка Григорий, спасибо.
Andrey: Небольшой баг, и я с ним уже сталкивался. На форму положили большой LABEL1, далее если второй LABEL2 (меньшего размера) положить на первый, то нет показа. Второй LABEL2 беру из другого *.prg Если положить GETBOX - показ есть, всякие FRAME или CHECKLABEL есть. Странно... Если из другого *.prg ставлю так:[pre2] @ aWin[1], aWin[2] LABEL Label_2 PARENT &cForm WIDTH aWin[3] HEIGHT nHLbl VALUE "text defect" ; SIZE 14 BOLD FONTCOLOR BLACK BACKCOLOR RED .... FORM_MyDefect(cForm,aTabWin,aBClr,aFont) .... FUNCTION FORM_MyDefect() ... DEFINE TAB Tab_ZDef OF &cForm ; ..... @ nRow1, nCol LABEL Label_3 .... // этот LABEL-3 показывается без PARENT &cForm[/pre2] Почему LABEL_2 не показывается, а LABEL-3 показывается ? И у объекта[pre2] DEFINE TAB Tab_ZDef OF &cForm ; AT nTabRow, nTabCol WIDTH nTabWidth HEIGHT nTabHeight ; VALUE nPgValue BACKCOLOR aTabBColor ; FONT cPgFont SIZE nPgFSize BOLD ; HOTTRACK HTFORECOLOR BLACK HTINACTIVECOLOR GRAY [/pre2] Не показываются вкладки !!! Стоит убрать большой LABEL1 с формы все работает, показ всех объектов есть.
SergKis: gfilatov2002 Поправил в c_controlmisc.c[pre2] HB_FUNC( INSERTVKEY ) { if( hb_parni( 2 ) != NULL ) { keybd_event ( ( BYTE ) hb_parni( 2 ), // virtual-key code 0, // hardware scan code 0, // flags specifying various function options 0 // additional data associated with keystroke ); } if( hb_parni( 1 ) != NULL ) { keybd_event ( ( BYTE ) hb_parni( 1 ), // virtual-key code 0, 0, 0 ); } if( hb_parni( 2 ) != NULL ) { keybd_event ( ( BYTE ) hb_parni( 2 ), // virtual-key code 0, // hardware scan code KEYEVENTF_KEYUP, // flags specifying various function options 0 // additional data associated with keystroke ); } } для использования с VK_MENU, VK_SHIFT, VK_CONTROL клавишами InsertVKey( , VK_MENU) // активация строки main menu InsertVKey(VK_V, VK_CONTROL) // Ctrl+V ... [/pre2] Включил в lib из примеров ф-ии HB_FUNC( SHELLEXECUTEEX ), HB_FUNC( TERMINATEPROCESS ) [pre2] #pragma BEGINDUMP #include <windows.h> #include <hbapi.h> #include <shlobj.h> HB_FUNC( SHELLEXECUTEEX ) { SHELLEXECUTEINFO SHExecInfo; ZeroMemory(&SHExecInfo, sizeof(SHExecInfo)); SHExecInfo.cbSize = sizeof(SHExecInfo); SHExecInfo.fMask = SEE_MASK_NOCLOSEPROCESS; SHExecInfo.hwnd = HB_ISNIL( 1 ) ? GetActiveWindow() : (HWND) hb_parnl( 1 ); SHExecInfo.lpVerb = (LPCSTR) hb_parc( 2 ); SHExecInfo.lpFile = (LPCSTR) hb_parc( 3 ); SHExecInfo.lpParameters = (LPCSTR) hb_parc( 4 ); SHExecInfo.lpDirectory = (LPCSTR) hb_parc( 5 ); SHExecInfo.nShow = hb_parni( 6 ); if( ShellExecuteEx(&SHExecInfo) ) hb_retnl( (LONG) SHExecInfo.hProcess ); else hb_retnl( NULL ); } HB_FUNC( TERMINATEPROCESS ) { hb_retl( (BOOL) TerminateProcess( (HANDLE) hb_parnl( 1 ), 0 ) ); } #pragma ENDDUMP [/pre2] и сделал аналог _Execute(...)[pre2] *-----------------------------------------------------------------------------* FUNCTION _ExecuteEx( hWnd , cOperation , cFile , cParameters , cDirectory , nState ) *-----------------------------------------------------------------------------* RETURN ShellExecuteEx( hb_defaultValue( hWnd, GetActiveWindow() ) , ; cOperation /* possible values are 'edit', 'explore', 'find', 'open', 'print' */ , ; hb_defaultValue( cFile, "" ) , cParameters , cDirectory , hb_defaultValue( nState, SW_SHOWNORMAL ) ) [/pre2] То есть: если PID есть, то приложение уже запустилось, если не сработал PostMessage(hWnd, WM_CLOSE, 0, 0) для внешнего приложения, делаем TerminateProcess( hPid ), если это не помогло, то запускаем cRun := %windir%/System32/taskkill.exe /T /IM <AppName.exe> через _ExecuteEx( 0, "runas", cRun, , , SW_HIDE ) С этими изменениями стало проще бороться с внешними приложениями
gfilatov2002: SergKis пишет: для использования с VK_MENU, VK_SHIFT, VK_CONTROL клавишами Благодарю за помощь, но для этих целей у нас уже есть специальная функция HMG_PressKey() Пример использования для эмуляции нажатия Ctrl + Shift + A: HMG_PressKey( VK_CONTROL, VK_SHIFT, VK_A ) Остальные функции для выгрузки сторонних приложений есть в примерах и библиотеке ProcInfo
SergKis: gfilatov2002 пишет для этих целей у нас уже есть специальная функция HMG_PressKey() Эта ф-я нажимает и отпускает клавиши списком, как аналог AEval({ VK_CONTROL, VK_SHIFT, VK_A }, {|n| _PushKey( n ) }) совместно нажать VK_CONTROL + VK_V + отпустить VK_CONTROL не получится есть в примерах ShellExecuteEx(...) удобней исп., чем ShellExecute(...) может тогда заменить, а не таскать из примеров, если не добавлять
SergKis: SergKis пишет не получится Все получится, это я просмотрел, второе событие отжатие в обратном порядке Сори
Andrey: SergKis пишет: ShellExecuteEx(...) удобней исп., чем ShellExecute(...) может тогда заменить, а не таскать из примеров, если не добавлять Я тоже таскаю свою функцию ShellExecuteEx(...), пришлось делать её самому и я давно ещё предлагал её добавить. Хотелось бы иметь такую функцию в библиотеке сразу.
gfilatov2002: Andrey пишет: я давно ещё предлагал её добавить Добавил Си-функцию ShellExecuteEx() в новую сборку, которая выйдет на этой неделе. Сейчас занят переработкой Си-кода доя использования кодировки Unicode, пример MainDemo отрабатывает уже нормально.
rvu: gfilatov2002 пишет: Сейчас занят переработкой Си-кода доя использования кодировки Unicode, пример MainDemo отрабатывает уже нормально. Я даже удивлен. Ожидал здесь множество эмоций, а никто не прокомментировал. Нужная же вещь для тех, у кого больше двух языков в программе и то, один из них английский.
SergKis: rvu пишет Я даже удивлен. Ожидал здесь множество эмоций, а никто не прокомментировал. Эмоции будут когда пощупаем, т.к. кому надо было unicode, варианты реализации были сделаны для работы ... Как их адаптировать под hmg unicode, вопрос пока открытый. А то что потребность в hmg unicode была и есть, это несомненно. Григорию большой респект, что нашел время и взялся за адаптацию
gfilatov2002: SergKis пишет: потребность в hmg unicode была и есть Вот так выглядит пример использования Unicode для японского языка: Как говорится, HMG Power Ready
Andrey: gfilatov2002 пишет: Вот так выглядит пример использования Unicode для японского языка: Это классно ! Ждём результата ! Но интересуют примеры допустим русский и украинский язык. Допустим на форме объекты BUTTON, LABEL, GETBOX на русском языке, а нужно сделать BUTTON, LABEL на украинском, GETBOX оставляем на русском языке. Как сделать чтение и замену допустим из ini-файлов-языка или из DBF-файла ? Вот такой пример бы очень пригодился.
SergKis: Andrey пишет Вот такой пример бы очень пригодился + тсб с колонкой на RU и колонкой на UA
Петр: Andrey пишет: Но интересуют примеры допустим русский и украинский язык. Есть такая кодовая страница Windows-1251. "Windows-1251 выгодно отличается от других 8‑битных кириллических кодировок (таких как CP866, KOI8-R и ISO 8859-5) наличием практически всех символов, использующихся в русской типографике для обычного текста (отсутствует только значок ударения); Она также содержит все символы для других славянских языков: украинского, белорусского, сербского, македонского и болгарского" - из Википедии. cp1251 широко используется в госучреждениях Украины при работе с Казначейством (Державна казначейська служба України). "Структура транспортного файлу Реєстр бюджетних фінансових зобов’язань. Транспортний файл має відповідати структурі dBaseIII. Дані в транспортному файлі мають відповідати кодовій сторінці Win-1251, кодова сторінка Win-1251 має бути зазначена в заголовку файлу" - это из требований к файлам подаваемых клиентами. SergKis пишет: + тсб с колонкой на RU и колонкой на UA Как вы себе такой пример представляете? Добавил Русский и Украинский в языковую панель. Установил cp1251 и работаешь. Здесь юникод нафиг ненужен. Andrey пишет: Как сделать чтение и замену допустим из ini-файлов-языка или из DBF-файла Это элементарные технические приемы, которые вы должны применять самостоятельно, поскольку в библиотеке отсутствует стандартная ("из коробки") поддержка файлов языковых ресурсов.
SergKis: Петр пишет Как вы себе такой пример представляете? Для UA не скажу, для LV866 (en,ru,lv), его мы вставляем в hb unicode и своя hmg unicode 2012 года hb_cdpSelect("LV866") ; hb_setTermCP("LV866") и все - 3и языка на контролах и базах Есть такая кодовая страница Windows-1251 Есть и 1257+DE+FR, а UA в продолжении вопроса от Андрея написал, т.к. в тсб фонты идут по handle (используя hardset ?), а базы в LV866. Или переводим все в utf8, включая dbf и работаем hb_cdpSelect("UTF8") ; hb_setTermCP("UTF8") ?
SergKis: SergKis пишет 3и языка на контролах и базах Язык программы то же en,ru,lv, а txt, ini, cfg файлы все имеют BOM и utf8 тексты внутри
gfilatov2002: Опубликована февральская сборка библиотеки, которая доступна по адресу: http://hmgextended.com/files/CONTRIB/hmg-21.02-setup.exe Эта версия использует, как обычно, ANSI charset (посмотреть кодировку можно, вызвав функцию MiniGUIVersion()) Работа над UNICODE-версией продолжается, начинается этап тестирования и исправления допущенных ошибок (неточностей)
gfilatov2002: Петр Рад приветствовать на форуме Возможно ли обратиться к Вам за помощью в реализации Unicode-cборки
Петр: gfilatov2002 пишет: Петр Рад приветствовать на форуме Здравствуйте, Григорий! К сожалению, сейчас я здесь редко бываю. Возможно ли обратиться к Вам за помощью в реализации Unicode-cборки Пишите на почту, которая gmail, если чем-то смогу помочь - помогу обязательно.
rvu: gfilatov2002 пишет: Опубликована февральская сборка библиотеки Спасибо! И особое спасибо за доработки браузера!
gfilatov2002: TBrowse уже работает в Unicode режиме Тестирование продолжается...
SergKis: gfilatov2002 Добавьте в h_objects.prg[pre2] CLASS TKeyData ... METHOD Keys() INLINE hb_HKeys( ::aKey ) METHOD Values() INLINE hb_HValues( ::aKey ) METHOD CloneHash() INLINE hb_HClone( ::aKey ) METHOD Clone() INLINE __objClone( Self ) METHOD Sort() INLINE ::aKey := hb_HSort( ::aKey ) METHOD Fill( xVal ) INLINE hb_HFill( ::aKey, xVal ) _METHOD GetAll( lAll ) ... [/pre2] TBrowse уже работает в Unicode режиме Это отличная новость Хотелось уточнения для колонок тсб, к примеру выше. Одна колонка UA кодировка в базе, другая LV1257 и третья DE, все другие RU1251. Как установки кодировок будут выглядеть ?
gfilatov2002: SergKis пишет: Добавьте в h_objects.prg Сделал, благодарю за помощь SergKis пишет: Хотелось уточнения для колонок тсб Пока не знаю, как это реализовать...
SergKis: gfilatov2002 пишет Пока не знаю, как это реализовать... По идее уст. CP utf8 глобально и USE ... на базу с содержимым полей в utf8 (с языками разными) должны отображаться в тсб колонках правильно. Если это так, то, по идее, в выше указанном условии, данные колонок привести к utf8, hb_StrToUtf8(..., "CP колонки"), поставив в блок кода колонки :bDecode, в :bEncode сделать обратную операцию hb_Utf8ToStr(..., "CP колонки"). USE ... так же делаем без указания CP
SergKis: gfilatov2002 Предлагаю поправить[pre2] METHOD DoKeyEvent( nKey ) CLASS Get LOCAL n, r := 0, cKey := hb_ntos( nKey ) IF Len( ::aKeyEvent ) > 0 cKey += iif( _GetKeyState( VK_CONTROL ), '#', '' ) cKey += iif( _GetKeyState( VK_SHIFT ), '^', '' ) cKey += iif( _GetKeyState( VK_MENU ), '@', '' ) IF ( n := AScan( ::aKeyEvent, {| a | a[ 1 ] == cKey } ) ) > 0 IF HB_ISBLOCK( ::aKeyEvent[ n ][ 2 ] ) //Eval( ::aKeyEvent[ n ][ 2 ], Self, nKey, cKey ) Do_ControlEventProcedure( ::aKeyEvent[ n ][ 2 ], __mvGet( ::name ), Self, nKey, cKey ) r := 1 ENDIF ENDIF ENDIF RETURN r [/pre2] тогда в боке кода будет среда This для контрола GETBOX, как в блоках кода @ y,x GETBOX ...
gfilatov2002: SergKis пишет: тогда в боке кода будет среда This для контрола GETBOX Предложение интересное, но смущает значение переменной __mvGet( ::name ), которая передается вторым параметром. Там должен быть числовой параметр, а Вы передаете строковый Или я что-то упустил
SergKis: gfilatov2002 пишет Или я что-то упустил [pre2] FUNCTION _DefineGetBox ( ControlName, ParentFormName, x, y, w, h, Value, ; ... k := _GetControlFree() ... Public &mVar. := k ... oget := Get() oget:New( -1, -1, { | x | iif( x == NIL, oget:cargo, oget:cargo := x ) }, '', cPicture ) oget:cargo := Value oget:preblock := when oget:postblock := valid oget:message := cmessage oget:name := mVar oget:control := ControlHandle oget:SetFocus() oget:original := oGet:buffer ... [/pre2] Это имя переменной, в которой определен индекс контрола и __mvGet( ::name ) дает из public переменной номер индекса, можно проверять на наличие переменной, но это излишне, т.к. объект существует пока есть контрол GETBOX
gfilatov2002: SergKis пишет: дает из public переменной номер индекса Ok, принято
gfilatov2002: Подготовил 3-ю бета-версию для новой сборки 21.03 Что нового (кратко): * Implementation of UNICODE support in the MiniGUI core libraries. * Fixed ANIGIF control: restored a proper handling of the DELAY clause (bug was introduced in the build 20.10 (update 2)). * The Tab page(s) at owner-draw colored TAB control supports now PNG, GIF and TIF images. The 'Transparent' property will be added to these images automatically. * Updated 'Open Table InSpector' sample: - added the source code for the OTIS library version 1.20 b01; - updated documentation (look at \Doc folder). * Updated SQLite3 library. * Updated some examples for UNICODE support. Поддержка уникода потребовала серьезного пересмотра Си-кода ядра библиотеки Возможно, что-то я упустил из виду...
Andrey: Очень ждём !
SergKis: gfilatov2002 Небольшая правка[pre2] CLASS TWndData //--------------------------------------------------- ... ACCESS VarName INLINE ::cVar ACCESS FocusedControl INLINE _GetFocusedControl ( ::cName ) ... METHOD SetFocus( xName ) INLINE iif( empty(xName), SetFocus( ::nHandle ), ; iif( HB_ISOBJECT(::GetObj(xName)), ::GetObj(xName):SetFocus(), DoMethod(::cName, xName, "SetFocus") ) ) ... [/pre2]
gfilatov2002: SergKis пишет: Небольшая правка Принято с благодарностью
SergKis: gfilatov2002 Правка по колонке тсб[pre2] METHOD ToWidth( uLen, nKfc, lHeader ) CLASS TSColumn LOCAL nWidth, nLen, cTyp, cChr := 'B', hFont := ::hFont DEFAULT nKfc := 1 IF HB_ISLOGICAL( lHeader ) hFont := iif( lHeader, ::hFontHead, ::hFontFoot ) DEFALT hFont := ::hFont ENDIF If HB_ISCHAR( uLen ) cChr := uLen ElseIf ! Empty( ::cPicture ) .and. HB_ISCHAR( ::cPicture ) If Empty( uLen ) ... nWidth := GetTextWidth( 0, cChr, hFont ) ... [/pre2]
SergKis: PS Возможно такой вариант лучше ?[pre2] If HB_ISCHAR( uLen ) IF CRLF $ uLen cChr := "" FOR EACH uLen IN hb_ATokens( uLen ) IF Len( uLen ) > Len( cChr ) ; cChr := uLen ENDIF NEXT ELSE cChr := uLen ENDIF ElseIf ! Empty( ::cPicture ) .and. HB_ISCHAR( ::cPicture ) [/pre2]
gfilatov2002: SergKis пишет: Возможно такой вариант лучше ? Да, в таком случае учитываются многострочные ячейки... Благодарю за помощь
gfilatov2002: Опубликована новая сборка 21.03 для BCC 5.8.2 и компиляторов Harbour и xHarbour. Базовый дистрибутив для кодировки ANSI находится по адресу http://hmgextended.com/files/CONTRIB/hmg-21.03-setup.exe Огромная благодарность Сергею Киселеву за помощь при подготовке этой сборки P.S. Я также подготовил архив для UNICODE сборки 21.03, который доступен всем, кто решит поддержать разработку библиотеки.
SergKis: gfilatov2002 Небольшая правка, упустил слегка (согласовать TWndData и TCnlData)[pre2] CLASS TWndData ... ACCESS WO INLINE ::oCargo ACCESS WP INLINE ::oProp METHOD SetProp( xKey, xVal ) INLINE ::oProp:Set( xKey, xVal ) METHOD GetProp( xKey ) INLINE iif( pCount() > 0, ::oProp:Get( xKey ), ::oProp ) ... CLASS TCnlData INHERIT TWndData ... METHOD GetProp( xKey ) INLINE iif( pCount() > 0, ::oWin:oProp:Get( xKey ), ::oWin:oProp ) ... Применять DEFINE WINDOW ... ... WITH OBJECT (This.Object):GetProp() :nTable := 3 :cTable := "oReport11" ... END WITH ... (This.Object):Event(20, {|ow| LOCAL cBrw, nBrw WITH OBJECT ow:GetProp() // или ow:WP cBrw := :cTable nBrw := :nTable ... END WITH ... RETURN NIL }) [/pre2] подготовил архив для UNICODE Можно получить в личке, для пощупать
SergKis: gfilatov2002 ACCESS WO INLINE ::oCargo ACCESS WP INLINE ::oProp В TWndData есть, глаз замылился
gfilatov2002: SergKis пишет: ACCESS WO INLINE ::oCargo ACCESS WP INLINE ::oProp Благодарю за помощь Уже обновил по-быстрому мартовскую сборку
SergKis: gfilatov2002 Что не так делаю в unicode сборке ? prg -> utf8 с bom, поставил SET CODEPAGE TO UNICODE собрал exe и тсб с lEdit := .T. USE ... без указания CDP пытаюсь в колонку CITY добавить в конец RU русскую букву и на добавляет, а EN буквы все ok! Пример APP_OOPREPORT\demo.prg поправил слегка [pre2] п»ї/* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "hmg.ch" #include "tsbrowse.ch" REQUEST HB_CODEPAGE_RU1251 REQUEST DBFCDX FIELD FIRST, LAST, AGE, STATE, CITY, INCOMING, OUTLAY *-----------------------------------------------------------------------------* FUNCTION Main() *-----------------------------------------------------------------------------* LOCAL nY, nX, nW, nH, hSpl, oTabl, cAlias LOCAL cWnd := 'wMain' SET CODEPAGE TO UNICODE RddSetDefault("DBFCDX") SET CENTURY ON SET DATE GERMAN SET DELETED ON SET EXCLUSIVE ON SET EPOCH TO 2000 SET AUTOPEN ON SET EXACT ON SET SOFTSEEK ON SET NAVIGATION EXTENDED SET FONT TO "Arial", 11 SET DEFAULT ICON TO "hmg_ico" *-------------------------------- SET OOP ON *-------------------------------- DEFINE FONT Normall FONTNAME _HMG_DefaultFontName ; SIZE _HMG_DefaultFontSize DEFINE FONT FontBold FONTNAME _HMG_DefaultFontName ; SIZE _HMG_DefaultFontSize BOLD DEFINE FONT FontNorm FONTNAME "Courier New" ; SIZE _HMG_DefaultFontSize USE Employee ALIAS BASE SHARED NEW cAlias := Alias() DEFINE WINDOW &cWnd AT 0,0 WIDTH 950 HEIGHT 650 ; TITLE 'MiniGUI Demo for TBrowse report' ; MAIN NOMAXIMIZE NOSIZE ; ON RELEASE dbCloseAll() ; ON INTERACTIVECLOSE (This.Object):Action DEFINE STATUSBAR BOLD STATUSITEM '' ACTION Nil STATUSITEM '' WIDTH 80 ACTION Nil STATUSITEM '' WIDTH 430 ACTION Nil END STATUSBAR DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 CAPTION "REPORT" BUTTONSIZE 52,32 FLAT BUTTON E0 CAPTION ' ' PICTURE 'cabinet' ACTION Nil ; SEPARATOR BUTTON 01 CAPTION 'First' PICTURE 'n1' ; TOOLTIP 'Column report FIRST Ctrl+1, Shift+1' ; ACTION _wPost(1) SEPARATOR BUTTON 02 CAPTION 'Last' PICTURE 'n2' ; TOOLTIP 'Column report LAST Ctrl+2, Shift+2' ; ACTION _wPost(2) SEPARATOR BUTTON 03 CAPTION 'Age' PICTURE 'n3' ; TOOLTIP 'Column report AGE Ctrl+3, Shift+3' ; ACTION _wPost(3) SEPARATOR BUTTON 04 CAPTION 'State' PICTURE 'n4' ; TOOLTIP 'Column report STATE Ctrl+4, Shift+4' ; ACTION _wPost(4) SEPARATOR BUTTON 05 CAPTION 'City' PICTURE 'n5' ; TOOLTIP 'Column report CITY Ctrl+5, Shift+5' ; ACTION _wPost(5) SEPARATOR BUTTON 06 CAPTION 'State ?' PICTURE 'n6' ; TOOLTIP 'Column report STATE + Left(LAST, 1) Ctrl+6, Shift+6' ; ACTION _wPost(6) SEPARATOR BUTTON 07 CAPTION 'City ?' PICTURE 'n7' ; TOOLTIP 'Column report CITY + Left(LAST, 1) Ctrl+7, Shift+7' ; ACTION _wPost(7) SEPARATOR END TOOLBAR DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE 42,32 FLAT BUTTON 99 CAPTION 'Exit' PICTURE 'exit' ACTION _wPost(99) END TOOLBAR END SPLITBOX WITH OBJECT This.Object // ---- Window events // StatusBar :StatusBar:Say(MiniGUIVersion(), 3) // ToolBar 1 :Event( 1, {|ow,ky| Report(ow, ky) } ) :Event( 2, {|ow,ky| Report(ow, ky) } ) :Event( 3, {|ow,ky| Report(ow, ky) } ) :Event( 4, {|ow,ky| Report(ow, ky) } ) :Event( 5, {|ow,ky| Report(ow, ky) } ) :Event( 6, {|ow,ky| Report(ow, ky) } ) :Event( 7, {|ow,ky| Report(ow, ky) } ) // ToolBar 2 :Event( 99, {|ow | ow:Release() } ) // Tsb. Right click - context menu :Event( 90, {|ow | MenuReport(ow) } ) // StatusBar :Event( 91, {|ow | ow:StatusBar:Say('... W A I T ...') } ) :Event( 92, {|ow | ow:StatusBar:Say('') } ) END WITH // ---- Window events nY := GetWindowHeight(hSpl) nX := 1 nW := This.ClientWidth - nX * 2 nH := This.ClientHeight - This.StatusBar.Height - nY DEFINE TBROWSE oTabl AT nY, nX ALIAS cAlias WIDTH nW HEIGHT nH CELL ; TOOLTIP 'Right click - context menu' ; FONT {"Normal", "FontBold", "FontBold"} ; FOOTERS .T. EDIT ; COLUMNS {"FIRST", "LAST", "AGE", "STATE", "CITY", "INCOMING", "OUTLAY"} ; COLNUMBER {1, 40} LOADFIELDS COLSEMPTY //:hFontHead := GetFontHandle( "FontBold" ) //:hFontFoot := GetFontHandle( "FontBold" ) :SetAppendMode( .F. ) :SetDeleteMode( .F. ) //:LoadFields(.F.) :lNoGrayBar := .T. :nWheelLines := 1 :nClrLine := COLOR_GRID :nHeightCell += 2 :nHeightHead := :nHeightCell + 2 :nHeightFoot := :nHeightCell + 2 //:lDrawFooters := .T. //:lFooting := .T. :lNoVScroll := .F. :lNoHScroll := .T. :bChange := {|ob| ob:DrawFooters() } :bRClicked := {|p1,p2,p3,ob| p1:=p2:=p3:=Nil, _wPost(90, ob:cParentWnd) } :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; {RGB(220, 220, 220), RGB(220, 220, 220)} ) } } ) :aColumns[ 1 ]:cFooting := { |nc,ob| nc := ob:nAt, iif( Empty(nc), '', hb_ntos(nc) ) } :aColumns[ 2 ]:cFooting := hb_ntos( (cAlias)->( LastRec() ) ) :UserKeys( VK_1, {|ob| _wPost(1, ob:cParentWnd) }, .T. ) :UserKeys( VK_2, {|ob| _wPost(2, ob:cParentWnd) }, .T. ) :UserKeys( VK_3, {|ob| _wPost(3, ob:cParentWnd) }, .T. ) :UserKeys( VK_4, {|ob| _wPost(4, ob:cParentWnd) }, .T. ) :UserKeys( VK_5, {|ob| _wPost(5, ob:cParentWnd) }, .T. ) :UserKeys( VK_6, {|ob| _wPost(6, ob:cParentWnd) }, .T. ) :UserKeys( VK_7, {|ob| _wPost(7, ob:cParentWnd) }, .T. ) :ResetVScroll( .T. ) :oHScroll:SetRange( 0, 0 ) :AdjColumns() END TBROWSE oTabl:SetNoHoles() oTabl:SetFocus() ON KEY SHIFT+1 ACTION wPost(1) ON KEY SHIFT+2 ACTION wPost(2) ON KEY SHIFT+3 ACTION wPost(3) ON KEY SHIFT+4 ACTION wPost(4) ON KEY SHIFT+5 ACTION wPost(5) ON KEY SHIFT+6 ACTION wPost(6) ON KEY SHIFT+7 ACTION wPost(7) //ON KEY ESCAPE ACTION wPost(99) ON KEY ESCAPE ACTION {|| iif( oTabl:IsEdit, oTabl:SetFocus(), _wPost(99) ) } // выход РїРѕ ESC END WINDOW CENTER WINDOW &cWnd ACTIVATE WINDOW &cWnd RETURN Nil *-----------------------------------------------------------------------------* FUNCTION _ShowFormContextMenu( cForm, nRow, nCol, lCenter ) *-----------------------------------------------------------------------------* LOCAL xContextMenuParentHandle := 0, hWnd, aRow DEFAULT nRow := -1, nCol := -1, lCenter := .F. If .Not. _IsWindowDefined(cForm) xContextMenuParentHandle := _HMG_xContextMenuParentHandle Else xContextMenuParentHandle := GetFormHandle(cForm ) Endif If xContextMenuParentHandle == 0 MsgMiniGuiError("Context Menu is not defined. Program terminated") EndIf lCenter := lCenter .or. ( nRow == 0 .or. nCol == 0 ) hWnd := GetFormHandle(cForm) If lCenter If nCol == 0 nCol := int( GetWindowWidth (hWnd) / 2 ) EndIf If nRow == 0 nRow := int( GetWindowHeight(hWnd) / 2 ) EndIf ElseIf nRow < 0 .or. nCol < 0 aRow := GetCursorPos() nRow := aRow[1] nCol := aRow[2] EndIf TrackPopupMenu ( _HMG_xContextMenuHandle , nCol , nRow , xContextMenuParentHandle ) RETURN Nil *-----------------------------------------------------------------------------* STATIC FUNC MenuReport( oWnd, aTxt, lPost, nRow, nCol, lCenter, nZeroLen ) *-----------------------------------------------------------------------------* LOCAL cWnd := oWnd:Name LOCAL nItm := 0, cNam, cImg, i LOCAL lDis := .F. LOCAL bAct := {|| nItm := Val(This.Name) } Default nZeroLen := 4, lPost := .T. Default aTxt := { ; 'Column report FIRST', ; 'Column report LAST ', ; 'Column report AGE ', ; 'Column report STATE', ; 'Column report CITY ', ; 'Column report STATE + Left(LAST, 1)', ; 'Column report CITY + Left(LAST, 1) ' ; } DEFINE CONTEXT MENU OF &cWnd For i := 1 To len(aTxt) cNam := StrZero(i, nZeroLen) If i > 9 cImg := Nil Else cImg := 'n' + hb_ntos(i) EndIf _DefineMenuItem( aTxt[ i ], bAct, cNam, cImg, .F., lDis, , , , .F., .F.) NEXT SEPARATOR MENUITEM 'Exit' ACTION NIL END MENU _ShowFormContextMenu(cWnd, nRow, nCol, lCenter ) DEFINE CONTEXT MENU OF &cWnd END MENU DO EVENTS If nItm > 0 .and. lPost oWnd:PostMsg(nItm) EndIf RETURN nItm *-----------------------------------------------------------------------------* STATIC FUNC Report( oWnd, nEvent ) *-----------------------------------------------------------------------------* LOCAL nOld := Select(), cKey, aRpt LOCAL oBrw := (This.oTabl.Object):Tsb LOCAL cAls := oBrw:cAlias LOCAL nRec := (cAls)->( RecNo() ) LOCAL b, o := oKeyData() LOCAL cNam := oBrw:aColumns[ nEvent ]:cHeading oWnd:Action := .F. oBrw:lEnabled := .F. oWnd:StatusBar:Say('... W A I T ...') This.&(StrZero(nEvent, 2)).Enabled := .F. This.E0.Caption := hb_ntos(nEvent) DO EVENTS // keys to summarize the report b := { {|| Alltrim( FIRST ) }, ; {|| Alltrim( LAST ) }, ; {|| hb_ntos( AGE ) }, ; {|| Alltrim( STATE ) }, ; {|| Alltrim( CITY ) }, ; {|| STATE + ', ' + LEFT( LAST, 1 ) + '...' }, ; {|| CITY + ', ' + LEFT( LAST, 1 ) + '...' } ; } wApi_Sleep(500) // specially delay for the test dbSelectArea( cAls ) GO TOP // create report in container object DO WHILE ! EOF() DO EVENTS cKey := Eval( b[ nEvent ] ) o:Sum( cKey, { 1, cKey, 1, INCOMING, OUTLAY, INCOMING - OUTLAY } ) SKIP ENDDO GOTO nRec // report from the container object to the array aRpt := o:Eval(.T.) // array value {{...}, {...}, ...} dbSelectArea( nOld ) wApi_Sleep(500) // specially delay for the test oWnd:StatusBar:Say('') DO EVENTS oWnd:Action := .T. TsbReport( oWnd, nEvent, aRpt, cNam ) (This.oTabl.Object):Tsb:lEnabled := .T. // oBrw:lEnabled := .T. (This.oTabl.Object):SetFocus() // oBrw:SetFocus() This.&(StrZero(nEvent, 2)).Enabled := .T. This.E0.Caption := '' DO EVENTS RETURN Nil *-----------------------------------------------------------------------------* STATIC FUNC TsbReport( oWnd, nEvent, aArray, cColName ) *-----------------------------------------------------------------------------* LOCAL aCap, oRpt, nY, nX, hSpl LOCAL aHead, aSize, aFoot, aPict, aAlign, aName, aFontHF LOCAL a, i, o := oKeyData() // calculate the results FOR EACH a IN aArray For i := 1 To Len(a) If i < 3 o:Sum(i, 1) // quantity Else o:Sum(i, a[ i ]) // amount EndIf Next NEXT a := o:Eval(.T.) // array {{value}, ...} aAlign := array(Len(a)) aSize := array(Len(a)) aPict := array(Len(a)) aFoot := array(Len(a)) aSize [ 1 ] := 50 aPict [ 1 ] := '9999' aAlign[ 1 ] := DT_CENTER AEVal(a, {|ns,nn| aFoot[ nn ] := iif( nn == 1, '', hb_ntos(ns) ) }) // report title Report aCap := { 'Column report FIRST', ; 'Column report LAST' , ; 'Column report AGE' , ; 'Column report STATE', ; 'Column report CITY' , ; 'Column report STATE, LAST ?...', ; 'Column report CITY, LAST ?...' ; } If nEvent == 6 cColName := 'State, Last ? ...' ElseIf nEvent == 7 cColName := 'City, Last ? ...' ElseIf nEvent == 3 .or. nEvent == 4 // Age, State aSize [ 2 ] := 80 aAlign[ 2 ] := DT_CENTER EndIf // report column headers aHead := { "#", cColName, "Quantity", "Incoming", "Outlay", "Balance" } aFontHF := GetFontHandle("FontBold") DEFINE WINDOW Report ; AT 0, 0 ; WIDTH 700 ; HEIGHT 450 + GetTitleHeight() + GetBorderHeight() ; TITLE aCap[ nEvent ] ; MODAL NOSIZE ; ON RELEASE Nil DEFINE SPLITBOX HANDLE hSpl DEFINE TOOLBAR ToolBar_1 CAPTION "" BUTTONSIZE 42,32 FLAT BUTTON 01 CAPTION 'Print' PICTURE 'printer' ; TOOLTIP 'Report printing F5' ; ACTION wPost() SEPARATOR BUTTON 02 CAPTION 'Excel' PICTURE 'excel' ; TOOLTIP 'Export to MS Excel F6' ; ACTION wPost() SEPARATOR END TOOLBAR DEFINE TOOLBAR ToolBar_2 CAPTION "" BUTTONSIZE 42,32 FLAT BUTTON 99 CAPTION 'Exit' PICTURE 'exit' ACTION wPost() END TOOLBAR END SPLITBOX // ToolBar 1 (This.Object):Event( 1, {|ow| oWnd:StatusBar:Say('... W A I T ...'), ; MsgBox('P r i n t i n g. This.Name = ' + This.Name, ow:Name), ; oWnd:StatusBar:Say('') } ) (This.Object):Event( 2, {|ow| oWnd:PostMsg(91), ; MsgBox('Export to MS Excel. This.Name = ' + This.Name, ow:Name), ; oWnd:PostMsg(92) } ) // ToolBar 2 (This.Object):Event( 99, {|ow| ow:Release() } ) nY := GetWindowHeight(hSpl) DEFINE TBROWSE oRpt AT nY, nX WIDTH This.ClientWidth ; HEIGHT This.ClientHeight - nY CELL ; TOOLTIP 'Double click on title - sorting' :SetArrayTo( aArray, aFontHF, aHead, aSize, aFoot, aPict, aAlign, aName ) :lNoGrayBar := .T. :nWheelLines := 1 :nClrLine := COLOR_GRID :nHeightCell += 5 :nHeightHead := :nHeightCell + 2 :nHeightFoot := :nHeightCell + 2 :lDrawFooters := .T. :lFooting := .T. :lNoVScroll := .F. :lNoHScroll := .T. :SetColor( { CLR_FOCUSB }, { { |a,b,c| If( c:nCell == b, {RGB( 66, 255, 236), RGB(209, 227, 248)}, ; {RGB(220, 220, 220), RGB(220, 220, 220)} ) } } ) :aColumns[ 1 ]:bData := {|| oRpt:nAt } :aColumns[ 1 ]:lIndexCol := .F. If nEvent == 6 .or. nEvent == 7 :aColumns[ 2 ]:hFont := GetFontHandle('FontNorm') :aColumns[ 2 ]:nWidth += 70 EndIf :UserKeys( VK_F5, {|ob| wPost(1, ob) } ) :UserKeys( VK_F6, {|ob| wPost(2, ob) } ) :AdjColumns({3, 4, 5, 6}) // :AdjColumns() END TBROWSE oRpt:SetNoHoles() oRpt:SetFocus() ON KEY ESCAPE ACTION wPost(99) END WINDOW CENTER WINDOW Report ACTIVATE WINDOW Report RETURN Nil *-----------------------------------------------------------------------------* FUNC wPost( nEvent, nIndex, xParam ) *-----------------------------------------------------------------------------* LOCAL oWnd If HB_ISOBJECT(nIndex) oWnd := _WindowObj(nIndex:cParentWnd) oWnd:SetProp(nEvent, xParam) oWnd:PostMsg(nEvent) Else DEFAULT nEvent := val( This.Name ) If nEvent > 0 oWnd := (ThisWindow.Object) oWnd:SetProp(nEvent, xParam) oWnd:PostMsg(nEvent, nIndex) EndIf EndIf RETURN Nil *-----------------------------------------------------------------------------* FUNC wSend( nEvent, nIndex, xParam ) *-----------------------------------------------------------------------------* LOCAL oWnd If HB_ISOBJECT(nIndex) oWnd := _WindowObj(nIndex:cParentWnd) oWnd:SetProp(nEvent, xParam) oWnd:SendMsg(nEvent) Else DEFAULT nEvent := val( This.Name ) If nEvent > 0 oWnd := (ThisWindow.Object) oWnd:SetProp(nEvent, xParam) oWnd:SendMsg(nEvent, nIndex) EndIf EndIf RETURN Nil [/pre2]
SergKis: PS[pre2] DEFINE FONT Normall FONTNAME _HMG_DefaultFontName ; [/pre2] поправил лишнюю букву, результат тот же.
gfilatov2002: SergKis пишет: пытаюсь в колонку CITY добавить в конец RU русскую букву и на добавляет А это контрол GETBOX шалит, он использует для проверки ввода Харбор-функцию IsAlpha(), которая не пропускает символы с кодом > 255. Кстати, в библиотеке TSBrowse тоже есть своя функция _IsChar() с таким же ограничением. Надо подумать, чем можно их заменить. Возможно, надо сделать обертку для Си-функции hb_charIsAlpha( iChar )
SergKis: gfilatov2002 Может это подойдет [pre2] HB_FUNC( ISUTF ) /* Этот текст UTF ? */ { byte *s; byte c; int ln, e; s = (byte *) hb_parc(1); /* Исходная строка в UTF-8 */ ln = hb_parclen(1); e = 0; while(ln > 0){ c = *s++; ln--; if( (c & 0x80 )==0x00){ } else if( (c & 0xE0 )==0xC0 ){ c = *s++; ln--; if( ! ((c & 0xC0)==0x80) ) e++; } else if( (c & 0xE0 )==0xE0 ){ c = *s++; ln--; if( (c & 0xC0)==0x80){ c = *s++; ln--; if( ! ((c & 0xC0)==0x80) ) e++; } else e++; } else e++; } hb_retl( e==0 ); } [/pre2] ? IsUtf("Привет ! ļķņ"), IsUtf(hb_StrToUtf8("Привет ! ļķņ")) // .F. .T.
gfilatov2002: SergKis пишет: Может это подойдет Нет, такая функция уже есть в Харборе - hb_StrIsUTF8() Я поправил класс TGet и внес изменения в обработку нажатой клавиши для GetBox, чтобы можно было ввести unicode символы. GetBox уже заработал с русским языком, но в TsBrowse надо править также методы KeyChar и Edit Может Вы сможете это сделать с учетом вашей уникодной hmg 2.07
SergKis: gfilatov2002 пишет в TsBrowse надо править также методы KeyChar и Edit У нас ничего исправленного в методах нет, т.к. cdp utf8 не используется, сразу в unicode все. И GetBox в этом направлении не трогался (там др. версия его). такая функция уже есть в Харборе - hb_StrIsUTF8() Которую давал текст, уже исп. с 10 года. Я хотел предложить на ней или родной вариант типа #xtranslate _IsAlpha( cChar ) => iif( hb_StrIsUTF8(), .T., IsAlpha( cChar ) ) и в TGET использовать, добавив _ к IsAlpha( cChar ) Хорошо бы с nKey иметь похожую ф-ю. Помочь не против
полная версия страницы