Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть V) (продолжение) » тема закрыта
	перенос

Автор

Сообщение

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
Сделал: click here

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 пишет:

цитата:

еще мелочь

Это исправляет возможную утечку памяти, и так - в коде у оригинального автора библиотеки

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 пишет:

цитата:

WM_MOUSEWHEL сделал так

Благодарю за помощь - прокрутка строк TBROWSE в MDI дочерних окнах работает

Планирую выпустить финальную сборку 16.03 на следующей неделе

Ответов - 300 , стр: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 All [только новые]

Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть V) (продолжение) » тема закрыта

Тему читают:

- участник сейчас на форуме

- участник вне форума

Все даты в формате GMT 3 час. Хитов сегодня: 253
Права: смайлы да, картинки да, шрифты да, голосования нет
аватары да, автозамена ссылок вкл, премодерация откл, правка нет

Создай свой форум на сервисе Borda.ru
Форум находится на 59 месте в рейтинге
Текстовая версия