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

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

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

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

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

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

 Отправлено: 16.07.19 22:24. Заголовок: Упс, промахнулся по ..

Упс, промахнулся по клавише.
PSP пишет

цитата:

hash-массив не поможет в этом случае?

 Отправлено: 17.07.19 07:26. Заголовок: Andrey пишет Правда ..

Andrey пишет

цитата:

Правда у меня на форме Form_Main включён таймер на каждую секунду (для тестирования). Может он влияет на псевдо-функции ThisWindow.Name, _HMG_ThisFormName ?

Предлагаю такую схему для TIMER на Form_Main

 
 Выполнение основного тела блока кода  перенести на событие приложения, т.е. 
 FUNCTION Main(...) 
 ... 
    SetsEnv() 
  
    WITH OBJECT oDlu2Pixel() 
    :Event( 1, {|| AEval(_ThisInfo(), {|xv,nv| _LogFile(.T., nv, cValToChar(xv)) }), ; 
                   SetProperty('Form_Main', 'Timer_1', 'Enabled', .T.) }) 
    END WITH 
 ... 
    DEFINE WINDOW Form_Main AT nY, nX WIDTH nW HEIGHT nH ; 
 ... 
         DEFINE TIMER Timer_1 INTERVAL 2000  ACTION ( This.Enabled := .F., oDlu2Pixel():Post(1) ) 
  
    END WINDOW 
 ... 
 

Работа блока кода Timer_1 будет оч. короткой, среда This восстановлена после него, какая была.
В установленном событии oDlu2Pixel():Event(1) This среда не важна, должна быть.

 Отправлено: 17.07.19 07:40. Заголовок: PS Точнее так WI..

PS
Точнее так

 
     WITH OBJECT oDlu2Pixel()  
     :Event( 1, {|| SetProperty('Form_Main', 'Timer_1', 'Enabled', .F.) ; 
                    AEval(_ThisInfo(), {|xv,nv| _LogFile(.T., nv, cValToChar(xv)) }), ;  
                    SetProperty('Form_Main', 'Timer_1', 'Enabled', .T.) })  
     END WITH  
  ...  
     DEFINE WINDOW Form_Main AT nY, nX WIDTH nW HEIGHT nH ;  
  ...  
          DEFINE TIMER Timer_1 INTERVAL 2000  ACTION oDlu2Pixel():Post(1) ) 
 

 Отправлено: 19.07.19 10:18. Заголовок: gfilatov2002 #xcom..

gfilatov2002

 
 #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; 
 ... 
        [ ON INIT <bInit> ] ; 
 ... 
     =>; 
 <obrw> :=_DefineTBrowse (<"name"> ,    ; 
 ... 
        [ <.lAutoCol.> ], [ \{<aColSel>\} ], ; 
          <bInit> );; // так лучше, по мне, чем <{bInit}> 
        with object <obrw> 
 ... 
 

Это видно на примере https://TransFiles.ru/uw4af

В моем варианте (исправленном ch) работают блоки кода

 
 *-----------------------------------------------------------------------------* 
 STAT FUNC Brw_Age( nY, nX, nW, nH ) 
 *-----------------------------------------------------------------------------* 
    LOCAL cBrw   := This.E0.Cargo 
    LOCAL aFont  := { GetFontHandle('FontBold'), GetFontHandle('FontBold') } 
    LOCAL aClr   := {} 
    LOCAL aDatos := AgeSelect(.T.)                                     // Init value 
    LOCAL oBrw 
    LOCAL bInit  := {|ob| Brw_Init(ob) } , ; 
          bEnd   := {|ob| Brw_End (ob) } 
 ... 
 

 Отправлено: 19.07.19 13:15. Заголовок: gfilatov2002 Так все..

gfilatov2002
Так все решается

 
 #xcommand DEFINE TBROWSE <name> ; 
 ... 
 #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; 
 ... 
        [ <.lAutoCol.> ], [ \{<aColSel>\} ], ; 
          iif( Valtype( <bInit> ) == 'B', <bInit>, <{bInit}> ) );; 
        with object <obrw> 
 ... 
 и 
 #command END TBROWSE ; 
        [ ON END <bInit> ] ; 
    =>; 
        _EndTBrowse ( iif( Valtype( <bInit> ) == 'B', <bInit>, <{bInit}> ) );; 
        end with 
 

 Отправлено: 19.07.19 13:53. Заголовок: SergKis пишет: В мо..

SergKis пишет:

цитата:

В моем варианте (исправленном ch) работают блоки кода

Это решается и без изменений в заголовке tsbrowse.ch
Попробуйте передавать эти блоки кода таким образом

цитата:

DEFINE TBROWSE &cBrw OBJ oBrw AT nY, nX WIDTH nW HEIGHT nH CELL ; COLORS aColor ON INIT Eval( bInit ) ... END TBROWSE ON END Eval( bEnd )

 Отправлено: 19.07.19 14:17. Заголовок: gfilatov2002 пишет П..

gfilatov2002 пишет

цитата:

Попробуйте передавать эти блоки кода таким образом

Вопрос стоит передаваемых параметров в блок кода.
В таком виде Eval(bInit), Eval(bEnd) параметры ( ob переменная ) не передаются {|ob| Brw_...(ob) }

 Отправлено: 19.07.19 14:48. Заголовок: PS Можно и без парам..

PS
Можно и без параметров отработать, для блоков кода создается среда This тек. TsBrowse

 
 *-----------------------------------------------------------------------------* 
 STAT FUNC Brw_Age( nY, nX, nW, nH ) 
 *-----------------------------------------------------------------------------* 
 ... 
    LOCAL bInit  := {|| Brw_Age_Init() }  
    LOCAL bEnd   := {|| Brw_Age_End () }  
  
 *-----------------------------------------------------------------------------* 
 STATIC FUNC Brw_Age_Init() 
 *-----------------------------------------------------------------------------* 
  
    WITH OBJECT (This.Object):Tsb 
 ... 
 *-----------------------------------------------------------------------------* 
 STATIC FUNC Brw_Age_End() 
 *-----------------------------------------------------------------------------* 
  
    WITH OBJECT (This.Object):Tsb 
 ... 
 и 
    DEFINE TBROWSE &cBrw OBJ oBrw AT nY, nX WIDTH nW HEIGHT nH CELL ; 
           COLORS aColor ON INIT  Eval( bInit ) 
 ... 
    END TBROWSE ON END Eval( bEnd ) 
 

 Отправлено: 19.07.19 17:42. Заголовок: SergKis пишет: Можн..

SergKis пишет:

цитата:

Можно и без параметров отработать

Да, так работает

 Отправлено: 20.07.19 08:15. Заголовок: gfilatov2002 пишет Д..

gfilatov2002 пишет

цитата:

Да, так работает

Вариант поинтересней, более "правильный"

 
 ... 
 	DEFINE WINDOW &cWnd AT 0,0 WIDTH 980 HEIGHT 650 ; 
 ... 
       WITH OBJECT This.Object 
       :StatusBar:Say(MiniGUIVersion(), 3) 
       :Event(  1, {|ow,ky,ap| AgeReport(ow, ky, ap) } ) 
       :Event( 91, {|oc      | Brw_Age_Init(oc:Tsb)  } ) 
       :Event( 92, {|oc      | Brw_Age_End (oc:Tsb)  } ) 
       :Event( 99, {|ow      | ow:Release()          } ) 
       END WITH                 
 ... 
 *-----------------------------------------------------------------------------* 
 STATIC FUNC Brw_Age_Init( oBrw ) 
 *-----------------------------------------------------------------------------* 
    DEFAULT oBrw := (This.Object):Tsb 
  
    WITH OBJECT oBrw 
 ... 
 *-----------------------------------------------------------------------------* 
 STATIC FUNC Brw_Age_End( oBrw ) 
 *-----------------------------------------------------------------------------* 
    DEFAULT oBrw := (This.Object):Tsb 
  
    WITH OBJECT oBrw 
 ... 
    DEFINE TBROWSE &cBrw OBJ oBrw AT nY, nX WIDTH nW HEIGHT nH CELL ; 
           COLORS aColor ON INIT  _wPost( 91, This.Index ) 
           DO EVENTS    
 ... 
    END TBROWSE ON END _wPost( 92, This.Index ) 
        DO EVENTS 
 

bInit и bEnd можно убрать везде

 Отправлено: 20.07.19 08:48. Заголовок: PS Расширить настрой..

PS
Расширить настройку TsBrowse можно так

 
       WITH OBJECT This.Object 
       :StatusBar:Say(MiniGUIVersion(), 3) 
       :Event(  1, {|ow,ky,ap| AgeReport(ow, ky, ap) } ) 
       :Event( 91, {|oc      | Brw_Age_Init(oc:Tsb)  } ) 
       :Event( 92, {|oc      | Brw_Age_End (oc:Tsb)  } ) 
       :Event( 93, {|oc      | Brw_Age_Body(oc:Tsb)  } ) 
       :Event( 99, {|ow      | ow:Release()          } ) 
       END WITH                 
 ... 
 *-----------------------------------------------------------------------------* 
 STATIC FUNC Brw_Age_Body( oBrw ) 
 *-----------------------------------------------------------------------------* 
  
    WITH OBJECT oBrw 
  
 // эти строки перенесены из функции Brw_Age_Init(...) для примера 
    :nHeightCell  += 5 
    :nHeightHead  := :nHeightCell + 2 
    :nHeightFoot  := :nHeightCell + 2   
  
    END WITH 
  
 RETURN Nil 
 ... 
    DEFINE TBROWSE &cBrw OBJ oBrw AT nY, nX WIDTH nW HEIGHT nH CELL ; 
           COLORS aColor ON INIT  _wPost( 91, This.Index ) 
           DO EVENTS    
  
       :SetArrayTo(aArray, aFont, aHead, aSize, aFoot, aPict, aAlign, aName) 
  
        AEval(:aColumns,  {|oc| oc:lEmptyValToChar := .T., oc:lFixLite := .T. }) 
  
        _wSend( 93, GetControlIndex( :cControlName, :cParentWnd ) ) 
  
          If lAdj 
       :AdjColumns() 
          EndIf 
  
       :ResetVScroll( .T. ) 
       :oHScroll:SetRange(0,0) 
                       
    END TBROWSE ON END _wPost( 92, This.Index ) 
        DO EVENTS 
 

 Отправлено: 20.07.19 10:45. Заголовок: gfilatov2002 Не рабо..

gfilatov2002
Не работает This.ToolBar_1.Caption
Правка

 
 *-----------------------------------------------------------------------------* 
 FUNCTION _GetCaption ( ControlName , ParentForm ) 
 *-----------------------------------------------------------------------------* 
    LOCAL cRetVal As String 
    LOCAL i 
  
    IF ( i := GetControlIndex ( ControlName , ParentForm ) ) > 0 
  
       IF _HMG_aControlType [ i ] == 'TOOLBAR' .OR. _HMG_aControlType [ i ] == 'TOOLBUTTON' .OR. ; 
          _HMG_aControlType [ i ] == 'MENU'    .OR. _HMG_aControlType [ i ] == 'RADIOGROUP' 
 ... 
 RETURN cRetVal 
 

Пример https://TransFiles.ru/8cp1d

 Отправлено: 20.07.19 11:21. Заголовок: gfilatov2002 Может ..

gfilatov2002
Может сделать в Tsb, чтобы не задумываться где какой элемент в :aSuperHead, так

 
 METHOD cTextSupHdGet( nCol, aSuperHead, cText ) CLASS TSBrowse 
  
    LOCAL xDef := '', xVal 
    Default nCol := 1, aSuperHead := ::aSuperHead 
     
    If nCol > 0 .and. nCol <= Len( aSuperHead ) 
       xVal := ::GetValProp( aSuperHead[ nCol, 3 ], xDef, nCol ) 
       If HB_ISCHAR(cText) 
          ::aSuperHead[ nCol, 3 ] := cText 
       EndIf 
    EndIf 
  
    If xVal == Nil; xVal := xDef 
    EndIf 
  
 RETURN xVal 
 

Используем вместо
:aSuperHead[1][3] := This.ToolBar_1.Caption + ' ' + cCapt
так
:cTextSupHdGet( 1, , This.ToolBar_1.Caption + ' ' + cCapt )

Аналогично можно сделать в методах
METHOD hFontSupHdGet( nCol, aSuperHead, uFont ) CLASS TSBrowse
METHOD nForeSupHdGet( nCol, aSuperHead, nClrText ) CLASS TSBrowse
METHOD nBackSupHdGet( nCol, aSuperHead, nClrPane ) CLASS TSBrowse
METHOD nAlignSupHdGet( nCol, lHAlign, aSuperHead, nHAlign ) CLASS TSBrowse
или аналогичные методы с названием Set вместо Get

 Отправлено: 20.07.19 20:58. Заголовок: SergKis пишет: Не р..

SergKis пишет:

цитата:

Не работает This.ToolBar_1.Caption Правка

Принято с благодарностью

SergKis пишет:

цитата:

аналогичные методы с названием Set вместо Get

Выбрал этот вариант
Благодарю за подсказку

 Отправлено: 21.07.19 13:34. Заголовок: gfilatov2002 Добави..

gfilatov2002
Добавил в пример (выше) сохранение позиции курсора при повторном нажатии на одну и ту же кнопку (с перемещением курсора на др. страницы тсб). :GotoRec(...) не работает с массивом, может кому интересно будет
Тут Скрытый текст

*-----------------------------------------------------------------------------* STATIC FUNC AgeReport( oWnd, nEvent, aSelect ) *-----------------------------------------------------------------------------* LOCAL aDatos, aArray, aSize LOCAL cCapt := 'All' LOCAL cBrw := This.E0.Cargo // TsBrowse name LOCAL nRec, nPos, nCol, cBtnC nEvent := Val( This.Name ) // Button name oWnd:Action := .F. oWnd:StatusBar:Say('W A I T') If aSelect[1] != Nil cCapt := hb_ntos(aSelect[1])+'-'+hb_ntos(aSelect[2]) EndIf cBtnC := This.E0.Caption This.E0.Caption := cCapt ; DO EVENTS aDatos := AgeSelect( aSelect[1], aSelect[2] ) aArray := aDatos[1] aSize := aDatos[3] WITH OBJECT (This.&(cBrw).Object):Tsb // oWnd:GetObj(cBrw):Tsb :Hide() nRec := :nAt nPos := :nRowPos nCol := :nCell AEval(:aColumns, {|oc,nc| oc:nWidth := aSize[ nc ] }) :HideColumns( 'STREET', ! 'All' $ cCapt ) // :cTextSupHdSet( 1, This.ToolBar_1.Caption + ' ' + cCapt ) :aSuperHead[1][3] := This.ToolBar_1.Caption + ' ' + cCapt :Display() :AdjColumns() DO EVENTS :SetArray(aArray, .T.) :Reset() :GetColumn('AGE'):cFooting := hb_ntos(:nLen) :ResetVScroll( .T. ) :oHScroll:SetRange(0,0) DO EVENTS If cCapt == cBtnC // нажали ту же кнопку, удерживаем курсор как был If nPos <= :nRowCount() .and. :nLen <= :nRowCount() :GoPos( nPos, nCol ) Else // :nLen > :nRowCount() :Skip(nRec-nPos) :nCell := nCol :Refresh() If nPos > 1 WHILE nPos-- > 1 :GoDown() ENDDO EndIf EndIf EndIf :Show() DO EVENTS :SetFocus() END WITH oWnd:StatusBar:Say('') oWnd:Action := .T. RETURN Nil

 Отправлено: 21.07.19 13:41. Заголовок: PS Строку ..

PS
Строку

 
           :nCell := nCol 
 //          :Refresh() 
           If nPos > 1 
 

убрать можно, оставил скорее по "привычке"

 Отправлено: 23.07.19 19:53. Заголовок: gfilatov2002 Можно ..

gfilatov2002
Можно чуть поправить HMG_Alert(...)

 
    DEFINE WINDOW &cForm WIDTH 0 HEIGHT 0 TITLE cTitle MODAL NOSIZE BACKCOLOR aBackColor ; 
       ON INTERACTIVECLOSE ( lPressButton .OR. lClosable ) ; 
       ON RELEASE iif( ! lPressButton .AND. lClosable, _HMG_ModalDialogReturn := 0, NIL ) 
  
       FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable ) 
  
    END WINDOW 
  
 //   ACTIVATE WINDOW &cForm ON INIT FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize, aBtnColors, bInit, lClosable ) 
    ACTIVATE WINDOW &cForm  
 

Разницы нет, а достраивать доп. контролами удобнее в такой комбинации строк.

 Отправлено: 23.07.19 20:24. Заголовок: SergKis пишет: чуть..

SergKis пишет:

цитата:

чуть поправить HMG_Alert(...)

Сделал, конечно.
Благодарю за предложение

 Отправлено: 24.07.19 13:07. Заголовок: gfilatov2002 Не наш..

gfilatov2002
Не нашел функций в lib для использования в блоках кода для работы с RGB.
Приходится все время таскать ToRGB( aColor ), n2RGB( nColor ).
Может сделать что то такое

 
 *-----------------------------------------------------------------------------* 
 FUNCTION HMG_RGB2n( p1, p2, p3 ) 
 *-----------------------------------------------------------------------------* 
  
    If     HB_ISARRAY  ( p1 ); RETURN RGB( p1[1], p1[2], p1[3] ) 
    ElseIf HB_ISNUMERIC( p2 ); RETURN RGB( p1   , p2   , p3    ) 
    EndIf 
  
 RETURN p1 
  
 *-----------------------------------------------------------------------------* 
 FUNCTION HMG_n2RGB( nColor ) 
 *-----------------------------------------------------------------------------* 
 RETURN { GetRed( nColor ), GetGreen( nColor ), GetBlue( nColor ) } 
 

 Отправлено: 24.07.19 13:42. Заголовок: SergKis пишет: ToRG..

SergKis пишет:

цитата:

ToRGB( aColor ), n2RGB( nColor )

Псевдо-функция nRGB2Arr( nColor ) уже определена (и активно используется) в библиотеке и примерах.

цитата:

SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) )

А предложенная функция HMG_RGB2n() - это просто обертка для псевдо-функции RGB().

Если что-то неправильно понял - аргументируйте...