Отправлено: 29.01.08 13:59. Заголовок: Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)

Начало темы находится здесь, а теперь

АНОНС * АНОНС * АНОНС * АНОНС * АНОНС

Готовится к опубликованию новая сборка №48, которая выйдет в конце недели.
Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне

Кратко, что нового:

- исправление обнаруженных ошибок и неточностей кода;
- новый класс HEADERIMAGE для Grid и Browse;
- свойство Address в Hyperlink может теперь открывать папку или файл на диске;
- добавлен NOTABSTOP класс для Browse;
- поддержка пользовательских компонентов (заимствована из оффициального релиза);
- расширения и исправления в библиотеках TsBrowse и PropGrid;
- обновлены сборки Харбор и HMGS-IDE;
- новые и обновленные старые примеры (как обычно ).

 Отправлено: 08.06.18 20:23. Заголовок: PS Установка цвета в..

PS
Установка цвета в тсб так же как в TsColumn

 
 * METHOD TSBrowse:New() Version 9.0 Nov/30/2009 
 ... 
    If aColors != Nil 
       If HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) 
          FOR EACH aClr IN aColors 
              If HB_ISNUMERIC( aClr[1] ) .and. aClr[1] > 0 .and. aClr[1] <= Len( aTmpColor ) 
                 aTmpColor[ aClr[1] ] := aClr[2] 
              EndIf 
          NEXT 
       Else 
          Aeval( aColors, { |bColor,nEle| aTmpColor[ nEle ] := bColor } ) 
       EndIf 
 //      Aeval( aColors, { | bColor, nEle | aTmpColor[ nEle ] := bColor } ) 
    EndIf 
 ... 
 

 Отправлено: 08.06.18 20:32. Заголовок: SergKis пишет: ..

SergKis пишет:

цитата:

If HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] )

Этой проверки недостаточно для корректной работы.
Проверил, что Sample1 из базового примера в папке Advanced\TSBrowse вылетает на втором элементе массива.

 Отправлено: 08.06.18 20:47. Заголовок: gfilatov2002 Еще, н..

gfilatov2002
Еще, на мой взгляд неточность

 
 METHOD LoadRelated( cAlias, lEditable, aNames, aHeaders )              CLASS TSBrowse 
 ... 
 было 
       ATail( ::aColumns ):cData  := cAlias + "->" + FieldName( nE ) 
       ATail( ::aColumns ):cField := cAlias + "->" + FieldName( nE ) 
 надо 
       ATail( ::aColumns ):cData  := cAlias + "->" + ( cAlias )->( FieldName( nE ) ) 
       ATail( ::aColumns ):cField := cAlias + "->" + ( cAlias )->( FieldName( nE ) ) 
       ATail( ::aColumns ):cName  := cAlias + "->" + ( cAlias )->( FieldName( nE ) ) 
 ... 
 

 Отправлено: 08.06.18 20:58. Заголовок: SergKis пишет: Еще,..

SergKis пишет:

цитата:

Еще, на мой взгляд неточность

Спасибо, поправил

 Отправлено: 08.06.18 21:31. Заголовок: gfilatov2002 пишет Э..

gfilatov2002 пишет

цитата:

Этой проверки недостаточно для корректной работы. Проверил, что Sample1 из базового примера в папке Advanced\TSBrowse вылетает на втором элементе массива.

Упустил я изменения (передвигаюсь между своим проектом lib и 18.05, еще и внук отвлек)

 
 FUNCTION _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; 
 ... 
    LOCAL aTmpColor := Array( 20 ), lColors := .F., aClr 
 ... 
    IF aColors != NIL .AND. ValType( aColors ) == 'A' 
       If ( lColors := HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) ) 
          FOR EACH aClr IN aColors 
              If HB_ISNUMERIC( aClr[1] ) .and. aClr[1] > 0 .and. aClr[1] <= Len( aTmpColor ) 
                 aTmpColor[ aClr[1] ] := aClr[2] 
              EndIf 
          NEXT 
       Else 
          AEval( aColors, {| bColor, nEle | aTmpColor[ nEle ] := bColor } ) 
       EndIf 
    ENDIF 
    IF ValType( fontcolor ) != "U" 
       If lColors 
          AAdd(aTmpColor, { CLR_TEXT, RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) }) 
       Else 
          aTmpColor[ 1 ] := RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) 
       EndIf 
    ENDIF 
    IF ValType( backcolor ) != "U" 
       If lColors 
          AAdd(aTmpColor, { CLR_PANE, RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) }) 
       Else 
          aTmpColor[ 2 ] := RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) 
       EndIf 
    ENDIF 
 ... 
 

 Отправлено: 08.06.18 21:47. Заголовок: Упс. перегнул чуток ..

Упс. перегнул чуток

 
    LOCAL aTmpColor := Array( 20 ), lColors := .F., aClr 
 ... 
       If ( lColors := HB_ISARRAY( aColors ) .and. Len( aColors ) > 0 .and. HB_ISARRAY( aColors[1] ) ) 
 ... 
    IF ValType( fontcolor ) != "U" 
       If lColors 
          AAdd(aTmpColor, { CLR_TEXT, RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) }) 
       Else 
          aTmpColor[ 1 ] := RGB( fontcolor[ 1 ], fontcolor[ 2 ], fontcolor[ 3 ] ) 
       EndIf 
    ENDIF 
    IF ValType( backcolor ) != "U" 
       If lColors 
          AAdd(aTmpColor, { CLR_PANE, RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) }) 
       Else 
          aTmpColor[ 2 ] := RGB( backcolor[ 1 ], backcolor[ 2 ], backcolor[ 3 ] ) 
       EndIf 
    ENDIF 
 ... 
 lColors не нужна 
 

 Отправлено: 08.06.18 22:29. Заголовок: SergKis пишет: FUNC..

SergKis пишет:

цитата:

FUNCTION _DefineTBrowse

Благодарю за помощь!
С этим исправлением контрольный пример работает

 Отправлено: 08.06.18 22:29. Заголовок: SergKis пишет: еще ..

SergKis пишет:

цитата:

еще и внук отвлек

SergKis пишет:

цитата:

Упс. перегнул чуток

Отдохни , утро вечера мудренее

 Отправлено: 08.06.18 23:25. Заголовок: Dima Спасибо, уже п..

Dima
Спасибо, уже пооошееел.
Только мысли не отпускают , надо базу колонок сделать и из нее создавать тсб.
Массивами наглядно, но они, паразиты, улазят за экран .
Вот и полез ...

 Отправлено: 09.06.18 10:24. Заголовок: gfilatov2002 пишет С..

gfilatov2002 пишет

цитата:

С этим исправлением контрольный пример работает

Так тоже работает

 
     Local aColors := {} 
 ... 
                 AAdd( aColors, { 5, CLR_BLACK} ) 
                 AAdd( aColors, { 2, CLR_NBLUE} ) 
                 AAdd( aColors, { 1, CLR_BLACK} ) 
                 AAdd( aColors, { 3, CLR_WHITE} ) 
                 AAdd( aColors, {13, CLR_WHITE} ) 
                 AAdd( aColors, {15, CLR_BLACK} ) 
  
                 DEFINE TBROWSE Brw_1 AT 0, 0 ALIAS "Employee" ; 
                     COLORS aColors ; 
                     WIDTH nBrwWidth HEIGHT nBrwHeight ; 
 ... 
                     :SetColor( { 6 }, {{ CLR_WHITE, CLR_BLACK }} ) // degraded cursor background color 
 /*                  :SetColor( { 1, 3, 5, 6, 13, 15 }, ; 
                                { CLR_BLACK, CLR_WHITE, CLR_BLACK, ; 
                                { CLR_WHITE, CLR_BLACK }, ; // degraded cursor background color 
                                 CLR_WHITE, CLR_BLACK } )  // text colors 
 */ 
 ... 
 вариант такой не сработал (пока не смотрел), добавить 
                 AAdd( aColors, { 6, { CLR_WHITE, CLR_BLACK }} ) 
 убрать 
 //                    :SetColor( { 6 }, {{ CLR_WHITE, CLR_BLACK }} ) // degraded cursor background color 
 

 Отправлено: 09.06.18 11:54. Заголовок: SergKis пишет вариан..

SergKis пишет

цитата:

вариант такой не сработал

Надо добавить

 
 FUNCTION _DefineTBrowse ( ControlName, ParentFormName, nCol, nRow, nWidth, nHeight, ; 
 ... 
    IF ValType( aColSel ) != 'U' .AND. ValType( aColSel ) == 'A' 
       IF ValType( aColSel[ 1 ] ) == 'A' 
          aColSel := aColSel[ 1 ] 
       ENDIF 
    ENDIF 
  
    IF HB_ISARRAY(aColors) .and. Len( aColors ) > 0 .AND. ValType( aColors[ 1 ] ) == 'A' 
       aColors := aColors[ 1 ] 
    ENDIF 
  
    IF ValType( uWhen ) == 'B'                                        /* BK    18.05.2015 */ 
 ... 
 тогда работает 
                 AAdd( aColors, { 5, CLR_BLACK} ) 
                 AAdd( aColors, { 2, CLR_NBLUE} ) 
                 AAdd( aColors, { 1, CLR_BLACK} ) 
                 AAdd( aColors, { 3, CLR_WHITE} ) 
                 AAdd( aColors, {13, CLR_WHITE} ) 
                 AAdd( aColors, {15, CLR_BLACK} ) 
                 AAdd( aColors, { 6, { CLR_WHITE, CLR_BLACK }} ) 
                 AAdd( aColors, { 2, { CLR_WHITE, CLR_NBLUE }} ) 
                 AAdd( aColors, { 4, { CLR_WHITE, CLR_BLACK }} ) 
                 AAdd( aColors, {14, { CLR_HRED, CLR_BLACK  }} )  
  
                 DEFINE TBROWSE Brw_1 AT 0, 0 ALIAS "Employee" ; 
                     COLORS aColors ; 
                     WIDTH nBrwWidth HEIGHT nBrwHeight ; 
                     MESSAGE "Cell height idependent of the font size using oBrw:nHeightCell. " +; 
                             "Also try multi-select feature by double clicking." 
  
  
                     :LoadFields( .F. ) 
 /*                  :SetColor( { 1, 3, 5, 6, 13, 15 }, ; 
                                { CLR_BLACK, CLR_WHITE, CLR_BLACK, ; 
                                { CLR_WHITE, CLR_BLACK }, ; // degraded cursor background color 
                                 CLR_WHITE, CLR_BLACK } )  // text colors 
  
                     :SetColor( { 2, 4, 14 }, ; 
                           { { CLR_WHITE, CLR_NBLUE }, ;  // degraded cells background color 
                             { CLR_WHITE, CLR_BLACK }, ;  // degraded headers backgroud color 
                             { CLR_HRED, CLR_BLACK } } )  // degraded order column background color 
 */ 
 ... 
 

 Отправлено: 09.06.18 12:47. Заголовок: gfilatov2002 В TsCo..

gfilatov2002
В TsColumn добавить методы

 
     METHOD SetProperty ( cName, xVal ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, '_'+cName, xVal ), Nil ) 
     METHOD GetProperty ( cName       ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, cName ), Nil ) 
  
 использовать 
     DEFINE COLUMN oC1 DATA 'R_1'                NAME 'KOD' ALIAS U08 
     DEFINE COLUMN oC2 DATA 'R_2'                NAME 'NAM' ALIAS U08  
     DEFINE COLUMN oC3 DATA FieldBlock("Field1") NAME 'KEY' ALIAS U04 
     DEFINE COLUMN oC4 DATA 'R_1+R_2'            NAME 'KDM' ALIAS U08  
    
     FOR EACH o IN {oC1, oC2, oC3, oC4}  
         a := o:SaveProperty()  
         msglog(o, o:ClassName, a, '------------')  
         AEval(a, {|av,nv| msglog( nv, av[1], valtype(av[2]), av[2]) })  
         o:SetProperty('cData', '') 
         AEval({'cData', 'cField'}, {|cv,nv| msglog( nv, o:GetProperty(cv)) })  
     NEXT  
 

 Отправлено: 09.06.18 13:07. Заголовок: SergKis пишет: FOR ..

SergKis пишет:

цитата:

FOR EACH o IN {oC1, oC2, oC3, oC4} a := o:SaveProperty()

Опечатка?

 Отправлено: 09.06.18 13:08. Заголовок: PSP пишет: Опечатка..

PSP пишет:

цитата:

Опечатка?

Это снова внук видимо

 Отправлено: 09.06.18 15:48. Заголовок: Dima пишет Опечатка ..

Dima пишет

цитата:

Опечатка ?

Нет. Добавлены методы сохранить в массив переменные колонки или восстановить из массива

 
 CLASS TSColumn   
  ...   
      METHOD SaveProperty( aExcept )        INLINE  __objGetValueList( Self, aExcept )  
      METHOD RestProperty( aProp   )        INLINE  __objSetValueList( Self, aProp   )  
 добавил еще (проще небольшие замены\получения значений делать)  
      METHOD SetProperty ( cName, xVal ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, '_'+cName, xVal ), Nil )  
      METHOD GetProperty ( cName       ) INLINE iif( __objHasData( Self, cName ), __objSendMsg( Self, cName ), Nil )  
 Переменных в массиве много и исп. aExcept (массив исключаемых свойств\переменных) можно, но накладно ... 
 Надо еще Clone сделать, но пока не у того компа. 
 Двигаю базу колонок на DFINE COLUMN ..., как выше, потом для конкр. тсб набирать из базы объекты, чуть поправил и в тсб отбравил типа так 
 AEval({oC1, ...., oCn}, {|ocol| oBrw:AddColumn(ocol) }) 
 И массив цветов, практически, глобальный на задачу, чуть подправить, если что 
 

 Отправлено: 09.06.18 18:44. Заголовок: gfilatov2002 Добави..

gfilatov2002
Добавить в TSColumn

 
     METHOD Clone()                     INLINE __objClone( Self ) 
 

Интересный вывод по установке в колонку cAlias, для себя сделал.
Не использовать метод LoadRelated (и ранее не использовал).
Не использовать в :bData FieldWBlock с привязкой к workarea (использовал) !
Применять FieldBlock для полей и hb_MacroBlock для выражений из полей (типа trim(R_34)+' '+...).
Ставить в каждую колонку нужный алиас, повторяя oBrw:cAlias или другой workarea.
В результате будем иметь в тсб uData := ( oCol:cAlias )->( EVal( oCol:bData ) )
Кое что упрощается.

 Отправлено: 09.06.18 19:44. Заголовок: SergKis пишет: Доба..

SergKis пишет:

цитата:

Добавить в TSColumn

Все поправки и дополнения, кроме

цитата:

IF HB_ISARRAY(aColors) .and. Len( aColors ) > 0 .AND. ValType( aColors[ 1 ] ) == 'A' aColors := aColors[ 1 ] ENDIF

были приняты

 Отправлено: 09.06.18 20:17. Заголовок: gfilatov2002 пишет к..

gfilatov2002 пишет

цитата:

кроме

Там же препроцессор добавляет лишние { }

 Отправлено: 10.06.18 23:52. Заголовок: gfilatov2002 Добави..

gfilatov2002
Добавил

 
 CLASS TSBrowse FROM TControl 
 ... 
    METHOD SetValue ( xCol, xVal )     INLINE ::Value( xCol, xVal ) 
    METHOD GetValue ( xCol       )     INLINE ::Value( xCol       ) 
    METHOD bDataEval( oCol )           INLINE  iif( empty( oCol:cAlias ) .or. '->' $ oCol:cField, ; 
                                     EVal( oCol:bData ), ( oCol:cAlias )->( EVal( oCol:bData ) ) ) 
 ... 
 Static Function SetHeights( oBrw ) 
 ... 
    For nEle := 1 TO Len( oBrw:aColumns ) 
       oColumn  := oBrw:aColumns[ nEle ] 
       cHeading := oBrw:bDataEval( oColumn ) 
 //      cHeading := Eval( oColumn:bData ) 
 ... 
 

Начал тестировать. Набросок примера http://my-files.ru/qqjal9

 Отправлено: 11.06.18 09:52. Заголовок: SergKis пишет: Доба..

SergKis пишет:

цитата:

Добавил

Принято, благодарю за помощь

SergKis пишет:

цитата:

Набросок примера

Супер