Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
SergKis: Упс, промахнулся по клавише. PSP пишет hash-массив не поможет в этом случае?
SergKis: Andrey пишет Правда у меня на форме Form_Main включён таймер на каждую секунду (для тестирования). Может он влияет на псевдо-функции ThisWindow.Name, _HMG_ThisFormName ? Предлагаю такую схему для TIMER на Form_Main[pre2] Выполнение основного тела блока кода перенести на событие приложения, т.е. 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 ... [/pre2] Работа блока кода Timer_1 будет оч. короткой, среда This восстановлена после него, какая была. В установленном событии oDlu2Pixel():Event(1) This среда не важна, должна быть.
SergKis: PS Точнее так[pre2] 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) ) [/pre2]
SergKis: gfilatov2002 [pre2] #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; ... [ ON INIT <bInit> ] ; ... =>; <obrw> :=_DefineTBrowse (<"name"> , ; ... [ <.lAutoCol.> ], [ \{<aColSel>\} ], ; <bInit> );; // так лучше, по мне, чем <{bInit}> with object <obrw> ... [/pre2] Это видно на примере https://TransFiles.ru/uw4af В моем варианте (исправленном ch) работают блоки кода [pre2] *-----------------------------------------------------------------------------* 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) } ... [/pre2]
SergKis: gfilatov2002 Так все решается[pre2] #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 [/pre2]
gfilatov2002: 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 )
SergKis: gfilatov2002 пишет Попробуйте передавать эти блоки кода таким образом Вопрос стоит передаваемых параметров в блок кода. В таком виде Eval(bInit), Eval(bEnd) параметры ( ob переменная ) не передаются {|ob| Brw_...(ob) }
SergKis: PS Можно и без параметров отработать, для блоков кода создается среда This тек. TsBrowse[pre2] *-----------------------------------------------------------------------------* 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 ) [/pre2]
gfilatov2002: SergKis пишет: Можно и без параметров отработать Да, так работает
SergKis: gfilatov2002 пишет Да, так работает Вариант поинтересней, более "правильный"[pre2] ... 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 [/pre2] bInit и bEnd можно убрать везде
SergKis: PS Расширить настройку TsBrowse можно так[pre2] 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 [/pre2]
SergKis: gfilatov2002 Не работает This.ToolBar_1.Caption Правка[pre2] *-----------------------------------------------------------------------------* 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 [/pre2] Пример https://TransFiles.ru/8cp1d
SergKis: gfilatov2002 Может сделать в Tsb, чтобы не задумываться где какой элемент в :aSuperHead, так[pre2] 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 [/pre2] Используем вместо :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
gfilatov2002: SergKis пишет: Не работает This.ToolBar_1.Caption Правка Принято с благодарностью SergKis пишет: аналогичные методы с названием Set вместо Get Выбрал этот вариант Благодарю за подсказку
SergKis: gfilatov2002 Добавил в пример (выше) сохранение позиции курсора при повторном нажатии на одну и ту же кнопку (с перемещением курсора на др. страницы тсб). :GotoRec(...) не работает с массивом, может кому интересно будет Тут [pre2] *-----------------------------------------------------------------------------* 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 [/pre2]
SergKis: PS Строку [pre2] :nCell := nCol // :Refresh() If nPos > 1 [/pre2] убрать можно, оставил скорее по "привычке"
SergKis: gfilatov2002 Можно чуть поправить HMG_Alert(...)[pre2] 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 [/pre2] Разницы нет, а достраивать доп. контролами удобнее в такой комбинации строк.
gfilatov2002: SergKis пишет: чуть поправить HMG_Alert(...) Сделал, конечно. Благодарю за предложение
SergKis: gfilatov2002 Не нашел функций в lib для использования в блоках кода для работы с RGB. Приходится все время таскать ToRGB( aColor ), n2RGB( nColor ). Может сделать что то такое[pre2] *-----------------------------------------------------------------------------* 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 ) } [/pre2]
gfilatov2002: SergKis пишет: ToRGB( aColor ), n2RGB( nColor ) Псевдо-функция nRGB2Arr( nColor ) уже определена (и активно используется) в библиотеке и примерах. SetProperty( cFormName, "BackColor", nRGB2Arr( GetSysColor( COLOR_WINDOW ) ) ) А предложенная функция HMG_RGB2n() - это просто обертка для псевдо-функции RGB(). Если что-то неправильно понял - аргументируйте...
полная версия страницы