Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть V) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть V) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
SergKis: gfilatov2002 Предложение такое, снимает\упрощает некоторые решения, в том числе и обработка колонки с .T.\.F.\NIL [pre2] было METHOD DrawLine( xRow ) CLASS TSBrowse ... nVertText := 0 lCheck := oColumn:lCheckBox .and. ValType( uData ) == "L" //V90 If lCheck .and. ValType( uData ) == "L" cPicture:= "" nVertText := If( uData, 3, 4 ) EndIf ... If nJ == ::nColSel .and. ::uBmpSel != Nil .and. lSelected uBmpCell := ::uBmpSel nAlign := nMakeLong( LoWord( nAlign ), ::nAligBmp ) ElseIf oColumn:lBitMap .and. Valtype( uData ) == "N" .and. ! Empty( ::aBitMaps ) If uData > 0 .and. uData <= Len(::aBitMaps) uBmpCell := ::aBitMaps[ uData ] EndIf nAlign := nMakeLong( oColumn:nAlign, oColumn:nAlign ) uData := "" ... If lCheck Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 )} hBitMap := ::aCheck[ If( Upper( uData ) == "T", 1, 2 ) ] nAlign := nMakeLong( DT_CENTER, DT_CENTER ) uData := "" ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... lCheck := oColumn:lCheckBox .and. ValType( uData ) == "L" //V90 lNoLite := oColumn:lNoLite nVertText := 0 If lCheck .and. ValType( uData ) == "L" cPicture := "" nVertText := If( uData, 3, 4 ) EndIf ... If nJ == ::nColSel .and. ::uBmpSel != Nil .and. lSelected uBmpCell := ::uBmpSel nAlign := nMakeLong( LoWord( nAlign ), ::nAligBmp ) ElseIf oColumn:lBitMap .and. Valtype( uData ) == "N" .and. ! Empty( ::aBitMaps ) If uData > 0 .and. uData <= Len(::aBitMaps) uBmpCell := ::aBitMaps[ uData ] nAlign := nMakeLong( LoWord( nAlign ), nAlign ) uData := "" EndIf ... If lCheck //V90 Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 ) } hBitMap := ::aCheck[ If( Upper( uData ) == "T", 1, 2 ) ] nAlign := nMakeLong( DT_CENTER, DT_CENTER ) uData := "" ... METHOD Destroy() CLASS TSBrowse ... стало METHOD DrawLine( xRow ) CLASS TSBrowse ... Local aBitMaps, lCheckVal := .F. ... nVertText := 0 lCheck := oColumn:lCheckBox .and. ValType(uData) == "L" //V90 If lCheck cPicture := "" nVertText := If( uData, 3, 4 ) lCheckVal := uData EndIf ... If nJ == ::nColSel .and. ::uBmpSel != Nil .and. lSelected uBmpCell := ::uBmpSel nAlign := nMakeLong( LoWord( nAlign ), ::nAligBmp ) ElseIf oColumn:lBitMap .and. Valtype( uData ) == "N" aBitMaps := If( empty(oColumn:aBitMaps), ::aBitMaps, oColumn:aBitMaps ) If ! Empty( aBitMaps ) .and. uData > 0 .and. uData <= Len(aBitMaps) uBmpCell := aBitMaps[ uData ] endif nAlign := nMakeLong( oColumn:nAlign, oColumn:nAlign ) uData := "" ... If lCheck Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 )} If Valtype(oColumn:aCheck) == "A" hBitMap := oColumn:aCheck[ If( lCheckVal, 1, 2 ) ] Else hBitMap := ::aCheck[ If( lCheckVal, 1, 2 ) ] EndIf nAlign := nMakeLong( DT_CENTER, DT_CENTER ) uData := "" ... METHOD DrawSelect( xRow ) CLASS TSBrowse ... Local aBitMaps, lCheckVal := .F. ... lCheck := oColumn:lCheckBox .and. ValType( uData ) == "L" //V90 lNoLite := oColumn:lNoLite nVertText := 0 If lCheck cPicture := "" nVertText := If( uData, 3, 4 ) lCheckVal := uData EndIf ... If nJ == ::nColSel .and. ::uBmpSel != Nil .and. lSelected uBmpCell := ::uBmpSel nAlign := nMakeLong( LoWord( nAlign ), ::nAligBmp ) ElseIf oColumn:lBitMap .and. Valtype( uData ) == "N" aBitMaps := If( empty(oColumn:aBitMaps), ::aBitMaps, oColumn:aBitMaps ) If ! Empty( aBitMaps ) .and. uData > 0 .and. uData <= Len(aBitMaps) uBmpCell := aBitMaps[ uData ] endif nAlign := nMakeLong( LoWord( nAlign ), nAlign ) uData := "" ... If lCheck Default ::aCheck := { StockBmp( 6 ), StockBmp( 7 )} If Valtype(oColumn:aCheck) == "A" hBitMap := oColumn:aCheck[ If( lCheckVal, 1, 2 ) ] Else hBitMap := ::aCheck[ If( lCheckVal, 1, 2 ) ] EndIf nAlign := nMakeLong( DT_CENTER, DT_CENTER ) uData := "" ... METHOD Destroy() CLASS TSBrowse LOCAL i ... If Len(::aColumns) > 0 For i := 1 To Len(::aColumns) If Valtype(::aColumns[ i ]:aCheck) == "A" AEval(::aColumns[ i ]:aCheck, {|hBmp| If( empty(hBmp), , DeleteObject(hBmp) ) }) EndIf If Valtype(::aColumns[ i ]:aBitMaps) == "A" AEval(::aColumns[ i ]:aBitMaps, {|hBmp| If( empty(hBmp), , DeleteObject(hBmp) ) }) EndIf Next EndIf ... [/pre2]
SergKis: PS добавка в TSCOLUMN DATA aBitMaps DATA aCheck
gfilatov2002: SergKis пишет: обработка колонки с .T.\.F.\NIL Выполнил эти изменения, теперь нужен небольшой пример для проверки правильности их работы
SergKis: gfilatov2002 Сделал: click here
gfilatov2002: SergKis Благодарю за помощь! Пример работает нормально
SergKis: gfilatov2002 маленькая правка выделенным [pre2] METHOD HiliteCell( nCol, nColPix ) CLASS TSBrowse ... nOldPos := ::nCell If ::nFreeze > 0 .and. nOldPos < nNowPos .and. ::lLockFreeze // frozen col and going right nNowPos := nAbsCell lMove := ( nOldPos > ::nFreeze ) EndIf If nOldPos < nNowPos // going right ... [/pre2] сейчас при ::nFreeze := 7, ::nCell := 1, левый клик мыши на колонку < ::nFreze переключает фокус на колонку ::nFreeze, повторный клик ставит фокус на нужную колонку и так повторяется все время, добавка исправляет ситуацию
gfilatov2002: SergKis пишет: маленькая правка Благодарю за поправку - сделана
SergKis: gfilatov2002 еще мелочь [pre2] было METHOD DrawPressed( nCell, lPressed ) CLASS TSBrowse ... Local hDC := GetDC( ::hWnd ), ; ... If Empty( nCell ) .or. nCell > Len( ::aColumns ) .or. ! ::lDrawHeaders Return Self ElseIf ! lPressed .and. ! ::aColumns[ nCell ]:l3DLookHead ::DrawHeaders() Return Self EndIf nLeft := 0 ... ReleaseDC( ::hWnd, hDC ) ... стало Local hDC, ; ... If Empty( nCell ) .or. nCell > Len( ::aColumns ) .or. ! ::lDrawHeaders Return Self ElseIf ! lPressed .and. ! ::aColumns[ nCell ]:l3DLookHead ::DrawHeaders() Return Self EndIf hDC := GetDC( ::hWnd ) nLeft := 0 ... ReleaseDC( ::hWnd, hDC ) ... [/pre2]
gfilatov2002: SergKis пишет: еще мелочь OK Это исправляет возможную утечку памяти, и так - в коде у оригинального автора библиотеки
SergKis: gfilatov2002 еще для чистоты объекта[pre2] Static nLapsus, hPrvWnd, hWndParent можно убрать после изменений CLASS TSBrowse FROM TControl ... DATA nLapsus INIT 0 ... METHOD Default() CLASS TSBrowse ... ::nOldCell := ::nCell ::nLapsus := Seconds() If ::nLen == 0 //V90 ::nLen := If( ::bLogicLen == Nil, Eval( ::bLogicLen := {||( cAlias )->( LastRec() ) } ), Eval( ::bLogicLen ) ) EndIf //end Return Self ... METHOD Seek( nKey ) CLASS TSBrowse ... If ( Seconds() - ::nLapsus ) > 3 .or. ( Seconds() - ::nLapsus ) < 0 ::cSeek := cSeek := "" EndIf ::nLapsus := Seconds() cPrefix := If( ::cPrefix == Nil, "", If( ValType( ::cPrefix ) == "B", Eval( ::cPrefix, Self ), ::cPrefix ) ) ... METHOD VertLine( nColPixPos, nColInit, nGapp ) CLASS TSBrowse ... If nColInit != Nil nsCol := nColInit nsWidth := nColPixPos nGap := If( ! Empty( nGapp ), nGapp, 0 ) nsOldPixPos := 0 // hWndParent := 0 //V90 // hPrvWnd := 0 //V90 _InvertRect( ::hDC, { 0, nsWidth - ::aColSizes[ nsCol ] - 2, aRect[4], nsWidth - ::aColSizes[ nsCol ] + 2 } ) EndIf ... [/pre2]
gfilatov2002: SergKis пишет: для чистоты объекта Благодарю за помощь! Неиспользуемые переменные hPrvWnd и hWndParent убрал, а nLapsus оставил как статическую переменную (так - у автора )
SergKis: gfilatov2002 пишет:nLapsus оставил как статическую переменную (так - у автора ) но тогда нельзя наследовать класс - суть класса теряется
SergKis: PS имея на окне 4-е TSB METHOD Seek( nKey ) в каждом будет портить значение для другого, можно сказать, что значение не важное и каждые 3 сек. обновляется, но по сути ...
gfilatov2002: SergKis пишет: METHOD Seek( nKey ) в каждом будет портить значение для другого Благодарю за разъяснение Убрал эту статическую переменную и определил ее как переменную класса VAR nLapsus AS NUMERIC INIT 0 PROTECTED
SergKis: gfilatov2002 Обнаружил, что в MDI не работает WM_MOUSEWHEEL, у себя поборол так : [pre2] METHOD DrawHeaders( lFooters ) CLASS TSBrowse ... SetFocus(hWnd) Return Self METHOD DrawIcons() CLASS TSBrowse ... SetFocus(::hWnd) Return Nil METHOD DrawLine( xRow ) CLASS TSBrowse ... SetFocus(hWnd) Return Self METHOD DrawPressed( nCell, lPressed ) CLASS TSBrowse ... SetFocus(::hWnd) Return Self METHOD DrawSelect( xRow ) CLASS TSBrowse ... SetFocus(hWnd) Return Self METHOD DrawSuper() CLASS TSBrowse ... SetFocus(hWnd) Return Nil [/pre2] проверить TsB_Mdi.prg из Advanced\TsBrowse, установив, например Brw_1:nWheelLines := 10
SergKis: gfilatov2002 правка, снимающая некоторые вопросы высоты строк [pre2]было METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd,; ... If Valtype( ::oWnd:hWnd ) != 'U' ::Create(::cControlName) // т.к. ::hFont всегда NIL, то расчет высот происходит от 0, потом надо переустанавливать высоты. // ::hFont уст. в _DefineTsBrowse() после создания объекта If ::hFont != Nil ::SetFont( ::hFont ) EndIf ::nHeightFoot := 0 //JP ::nHeightCell := ::nHeightHead := SBGetHeight( ::hWnd, If( ::hFont != Nil, ::hFont, 0 ), 0 ) //JP ::nHeightSpecHd := IF(::lEditableHd,SBGetHeight( ::hWnd, If( ::hFont != Nil, ::hFont, 0 )),0) ... стало METHOD New( cControlName, nRow, nCol, nWidth, nHeight, bLine, aHeaders, aColSizes, cParentWnd, ; ... Local hFont ... If Valtype( ::oWnd:hWnd ) != 'U' ::Create(::cControlName) If ::hFont != Nil ::SetFont( ::hFont ) ::nHeightCell := ::nHeightHead := SBGetHeight( ::hWnd, If( ::hFont != Nil, ::hFont, 0 ) , 0 ) //JP Else hFont := InitFont(::cFont, ::nFontSize) ::nHeightCell := ::nHeightHead := GetTextHeight( 0, "B", hFont) + 5 DeleteObject ( hFont ) EndIf ::nHeightFoot := 0 //JP ::nHeightSpecHd := IF(::lEditableHd, ::nHeightCell, 0 ) ... [/pre2]
gfilatov2002: SergKis пишет: правка, снимающая некоторые вопросы высоты строк Благодарю за помощь! Это очень нужная поправка для учета высоты (и типа) шрифта, заданного при определении TBROWSE Для совместимости со старым кодом, чтобы не увеличивать высоту ячейки по умолчанию, сделал так: [pre] If ::hFont != Nil ::SetFont( ::hFont ) ::nHeightCell := ::nHeightHead := SBGetHeight( ::hWnd, ::hFont, 0 ) Else hFont := InitFont( ::cFont, ::nFontSize ) // SergKis addition ::nHeightCell := ::nHeightHead := GetTextHeight( 0, "B", hFont ) DeleteObject( hFont ) EndIf ::nHeightFoot := 0 ::nHeightSpecHd := If( ::lEditableHd, ::nHeightHead, 0 ) [/pre] SergKis пишет: в MDI не работает WM_MOUSEWHEEL Подтверждаю эту проблему, но предложенное решение создает другие проблемы с перерисовкой строк TBROWSE Поэтому лучше обойтись без прокрутки строк в MDI, чем создавать новые проблемы (вплоть до GPF) Либо надо искать другое решение для MDI
SergKis: gfilatov2002 пишет:но предложенное решение создает другие проблемы с перерисовкой строк TBROWSE Согласен, поэксперементировал и оставил только в DrawSelect (тоже не хорошо, но пока не находится место перекл.фокус с TSB на окно) If GetFocus() != hWnd SetFocus(hWnd) EndIf как следствие убрал из h_windowsMdi.prg, выделено цветом - вся обработка в Events(...). Мне надо несколько TSB на окне [pre2] FUNCTION MdiEvents ( hWnd, nMsg, wParam, lParam ) *-----------------------------------------------------------------------------* LOCAL i, x, ControlCount #ifdef _TSBROWSE_ LOCAL oGet #endif DO CASE #ifdef _TSBROWSE_ //********************************************************************** CASE nMsg == WM_KEYDOWN .OR. nMsg == WM_KEYUP //********************************************************************** // IF Type( '_TSB_aControlhWnd' ) == 'A' .AND. Len( _TSB_aControlhWnd ) > 0 // oGet := GetObjectByClientMDI( hWnd ) // IF ValType( oGet ) == 'O' // oGet:HandleEvent ( nMsg, wParam, lParam ) // ENDIF // ENDIF #endif //********************************************************************** CASE nMsg == WM_MDIACTIVATE [/pre2] т.к. oGet := GetObjectByClientMDI( hWnd ) работает только для одного TSB на окне (hWnd - handle child mdi окна)
SergKis: SergKis пишет:Мне надо несколько TSB на окне Без решения главной проблемы - фокуса, несколько TSB на окне реализовать не получается. Убрал из DrawSelect вставку WM_MOUSEWHEL сделал так h_windowsMdi.prg [pre2] Function MdiEvents(...) ... #ifdef _TSBROWSE_ *********************************************************************** case nMsg == WM_KEYDOWN .OR. nMsg == WM_KEYUP IF Type('_TSB_aControlhWnd') == 'A' .and. Len(_TSB_aControlhWnd) > 0 oGet := GetObjectByClientMDI(hWnd) IF ValType(oGet) == 'O' oGet:HandleEvent ( nMsg, wParam, lParam ) ENDIF ENDIF case nMsg == WM_MOUSEWHEEL IF Type('_TSB_aControlhWnd') == 'A' .and. Len(_TSB_aControlhWnd) > 0 oGet := GetObjectByClientMDI(hWnd) IF ValType(oGet) == 'O' x := oGet:HandleEvent ( nMsg, wParam, lParam ) if ValType(x) == 'N' IF x != 0 RETURN x ENDIF endif ENDIF ENDIF #endif *********************************************************************** case nMsg == WM_MDIACTIVATE ... [/pre2]
gfilatov2002: SergKis пишет: WM_MOUSEWHEL сделал так Благодарю за помощь - прокрутка строк TBROWSE в MDI дочерних окнах работает Планирую выпустить финальную сборку 16.03 на следующей неделе
полная версия страницы