Автор | Сообщение |
gfilatov
|
| модератор
|
Пост N: 699
Зарегистрирован: 25.05.05
|
|
Отправлено: 29.01.08 13:59. Заголовок: Новая версия Расширенного релиза библиотеки MiniGUI (часть V) (продолжение)
Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
|
|
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|
SergKis
|
| постоянный участник
|
Пост N: 888
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.03.16 11:38. Заголовок: gfilatov2002 Предло..
gfilatov2002 Предложение такое, снимает\упрощает некоторые решения, в том числе и обработка колонки с .T.\.F.\NIL Скрытый текст
было 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 ...
|
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 889
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.03.16 11:41. Заголовок: PS добавка в TSCOLUM..
PS добавка в TSCOLUMN DATA aBitMaps DATA aCheck
|
|
|
gfilatov2002
|
| moderator
|
Пост N: 895
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.03.16 12:59. Заголовок: SergKis пишет: обра..
SergKis пишет: цитата: | обработка колонки с .T.\.F.\NIL |
| Выполнил эти изменения, теперь нужен небольшой пример для проверки правильности их работы
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 890
Зарегистрирован: 17.02.12
|
|
Отправлено: 05.03.16 21:11. Заголовок: gfilatov2002 Сделал..
|
|
|
gfilatov2002
|
| moderator
|
Пост N: 896
Зарегистрирован: 11.02.10
|
|
Отправлено: 05.03.16 22:04. Заголовок: SergKis Благодарю з..
SergKis Благодарю за помощь! Пример работает нормально
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 891
Зарегистрирован: 17.02.12
|
|
Отправлено: 09.03.16 12:44. Заголовок: gfilatov2002 малень..
gfilatov2002 маленькая правка выделенным 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 ... сейчас при ::nFreeze := 7, ::nCell := 1, левый клик мыши на колонку < ::nFreze переключает фокус на колонку ::nFreeze, повторный клик ставит фокус на нужную колонку и так повторяется все время, добавка исправляет ситуацию
|
|
|
gfilatov2002
|
| moderator
|
Пост N: 897
Зарегистрирован: 11.02.10
|
|
Отправлено: 09.03.16 13:34. Заголовок: SergKis пишет: мале..
SergKis пишет: Благодарю за поправку - сделана
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 892
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.03.16 09:10. Заголовок: gfilatov2002 еще ме..
gfilatov2002 еще мелочь было 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 ) ...
|
|
|
gfilatov2002
|
| moderator
|
Пост N: 898
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.03.16 11:17. Заголовок: SergKis пишет: еще ..
SergKis пишет: OK Это исправляет возможную утечку памяти, и так - в коде у оригинального автора библиотеки
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 893
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.03.16 12:43. Заголовок: gfilatov2002 еще дл..
gfilatov2002 еще для чистоты объекта 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 ...
|
|
|
gfilatov2002
|
| moderator
|
Пост N: 899
Зарегистрирован: 11.02.10
|
|
Отправлено: 10.03.16 13:35. Заголовок: SergKis пишет: для ..
SergKis пишет: Благодарю за помощь! Неиспользуемые переменные hPrvWnd и hWndParent убрал, а nLapsus оставил как статическую переменную (так - у автора )
|
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 894
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.03.16 13:42. Заголовок: gfilatov2002 пишет:n..
gfilatov2002 пишет: цитата: | nLapsus оставил как статическую переменную (так - у автора ) |
| но тогда нельзя наследовать класс - суть класса теряется
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 895
Зарегистрирован: 17.02.12
|
|
Отправлено: 10.03.16 13:58. Заголовок: PS имея на окне 4-е ..
PS имея на окне 4-е TSB METHOD Seek( nKey ) в каждом будет портить значение для другого, можно сказать, что значение не важное и каждые 3 сек. обновляется, но по сути ...
|
|
|
gfilatov2002
|
| moderator
|
Пост N: 900
Зарегистрирован: 11.02.10
|
|
Отправлено: 11.03.16 11:01. Заголовок: SergKis пишет: METH..
SergKis пишет: цитата: | METHOD Seek( nKey ) в каждом будет портить значение для другого |
| Благодарю за разъяснение Убрал эту статическую переменную и определил ее как переменную класса цитата: | VAR nLapsus AS NUMERIC INIT 0 PROTECTED |
|
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 896
Зарегистрирован: 17.02.12
|
|
Отправлено: 14.03.16 21:16. Заголовок: gfilatov2002 Обнару..
gfilatov2002 Обнаружил, что в MDI не работает WM_MOUSEWHEEL, у себя поборол так : 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 проверить TsB_Mdi.prg из Advanced\TsBrowse, установив, например Brw_1:nWheelLines := 10
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 897
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.03.16 13:46. Заголовок: gfilatov2002 правка..
gfilatov2002 правка, снимающая некоторые вопросы высоты строк было 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 ) ...
|
|
|
gfilatov2002
|
| moderator
|
Пост N: 901
Зарегистрирован: 11.02.10
|
|
Отправлено: 15.03.16 15:28. Заголовок: SergKis пишет: прав..
SergKis пишет: цитата: | правка, снимающая некоторые вопросы высоты строк |
| Благодарю за помощь! Это очень нужная поправка для учета высоты (и типа) шрифта, заданного при определении TBROWSE Для совместимости со старым кодом, чтобы не увеличивать высоту ячейки по умолчанию, сделал так: 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 ) SergKis пишет: цитата: | в MDI не работает WM_MOUSEWHEEL |
| Подтверждаю эту проблему, но предложенное решение создает другие проблемы с перерисовкой строк TBROWSE Поэтому лучше обойтись без прокрутки строк в MDI, чем создавать новые проблемы (вплоть до GPF) Либо надо искать другое решение для MDI
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 898
Зарегистрирован: 17.02.12
|
|
Отправлено: 15.03.16 19:02. Заголовок: gfilatov2002 пишет:н..
gfilatov2002 пишет: цитата: | но предложенное решение создает другие проблемы с перерисовкой строк TBROWSE |
| Согласен, поэксперементировал и оставил только в DrawSelect (тоже не хорошо, но пока не находится место перекл.фокус с TSB на окно) If GetFocus() != hWnd SetFocus(hWnd) EndIf как следствие убрал из h_windowsMdi.prg, выделено цветом - вся обработка в Events(...). Мне надо несколько TSB на окне 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 т.к. oGet := GetObjectByClientMDI( hWnd ) работает только для одного TSB на окне (hWnd - handle child mdi окна)
|
|
|
SergKis
|
| постоянный участник
|
Пост N: 899
Зарегистрирован: 17.02.12
|
|
Отправлено: 16.03.16 09:06. Заголовок: SergKis пишет:Мне на..
SergKis пишет: цитата: | Мне надо несколько TSB на окне |
| Без решения главной проблемы - фокуса, несколько TSB на окне реализовать не получается. Убрал из DrawSelect вставку WM_MOUSEWHEL сделал так h_windowsMdi.prg 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 ...
|
|
|
gfilatov2002
|
| moderator
|
Пост N: 902
Зарегистрирован: 11.02.10
|
|
Отправлено: 16.03.16 11:46. Заголовок: SergKis пишет: WM_M..
SergKis пишет: Благодарю за помощь - прокрутка строк TBROWSE в MDI дочерних окнах работает Планирую выпустить финальную сборку 16.03 на следующей неделе
|
|
|
Ответов - 300
, стр:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
All
[только новые]
|
|