Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
SergKis: PPS опять 504 Gateway Time-out, но передача прошла.
SergKis: gfilatov2002 Привел в соответствие свойства классов. В примере поправил StatusBar https://my-files.ru/n8l6pu
krutoff: Давно борюсь с ситуацией, когда у GetBox не работает вызов VALID в окне PANEL. Вышел на h_getbox.prg строка 528: IF _IsChildOfActiveWindow( hWnd ) .AND. !readonly .AND. lAllowEdit Если я закоментирую вызов функции _IsChildOfActiveWindow -> то VALID отрабатывает! IF /*_IsChildOfActiveWindow( hWnd ) .AND.*/ !readonly .AND. lAllowEdit Я не совсем понимаю, что эта функция делает, но функция присутствует в h_window.prg и вызывается только один раз и только для GetBox. Для показа этой ситуации можно в примере MiniGUI\SAMPLES\BASIC\CONTAINERS\Panel\demo1.prg в строке 50 вместо TEXTBOX изменить DEFINE TEXTBOX TEXT_1 на: 120,10 GETBOX GET_1 VALUE 'GetBox' VALID {|| MsgYesNo('GetValid: '+Win_2.Get_1.Value)}
SergKis: krutoff пишет Если я закоментирую вызов функции _IsChildOfActiveWindow Есть такая блокировка работы GetBox, возможно оправданная. К примеру имеем не менее 3-х окон MdiChild и ввод в GetBox на одном из окон, после Enter focus улетает на др. окна. Используйте TEXTBOX с такой конструкцией[pre2] DEFINE TEXTBOX TEXT_1 ROW 120 COL 10 VALUE 'Test' ON CHANGE {|| This.Cargo := .T. } ON LOSTFOCUS {|| Valid1() } ON ENTER {|| _PushKey(VK_TAB) } END TEXTBOX This.TEXT_1.Cargo := .F. // no change ... STAT FUNC Valid1() If This.Cargo // change textbox If 'get' $ This.Value MsgBox('Error value '+ This.Value, 'ERROR') This.SetFocus Else This.Cargo := .F. EndIf EndIf RETURN Nil [/pre2]
SergKis: PS c GetBox-сами проверку valid надо проделывать на кнопке OK, пробежав по всем и переключая фокус на Getbox с ошибкой
gfilatov2002: SergKis пишет: В примере поправил StatusBar При попытке скачать этот пример получаю 502 Bad Gateway Можно повторно выложить этот архив
SergKis: gfilatov2002 Тут https://transfiles.ru/bf6j5
gfilatov2002: SergKis пишет: Тут Спасибо! С этими изменениями пример у меня отработал нормально, надписи в статусбаре не искажаются
gfilatov2002: SergKis пишет: Мысли вслух. Если вынести oDlu2Pixel(...) и класс TDlu2Pix за скобки SergKis пишет: Используется среда контрола в ON INIT Не уверен, что требуются такие изменения во всех контролах
SergKis: gfilatov2002 Обратите внимание на [pre2] DEFINE GETBOX Text_2c // Alternate Syntax ... END GETBOX ON INIT {|| :Y += This.Height + :GapsHeight } // ON INIT {|og,ow,oc| ow:Y += oc:Height + ow:GapsHeight } // :Y += This.Text_2c.Height + :GapsHeight // !!! это использовать, убрав выше ... [/pre2] Пробовал "Мысли в слух". Для сборки надо убрать ON INIT, открыв строку приращения координаты
gfilatov2002: SergKis пишет: Для сборки надо убрать ON INIT Благодарю за напоминание Да, конечно, я это сделал - иначе бы пример не запустился
SergKis: gfilatov2002 пишет Не уверен, что требуются такие изменения во всех контролах В своей версии 2.07 сделал контролы, перечисленные выше + в TsBrowse сделал [pre2] #xcommand DEFINE TBROWSE <name> OBJ <obrw> ; ... [ ON INIT> <bInit> ] ; ... [ <.lAutoCol.> ], [ \{<aColSel>\} ], ; <{bInit}> );; with object <obrw> ... #command END TBRW [ ON INIT> <bInit> ] ; =>; _EndTBrowse( <{bInit}> );; end with ... Поменял объявление и вызов Local oc, ow := oDlu2Pixel() ... Do_ControlEventProcedure ( bInit, k, ow, oc ) ... Для GetBox добавил [ <GotFocusSelect: GOTFOCUSSELECT> ] ; ... ..., <.GotFocusSelect.>, <{bInit}> ) ... FUNCTION _DefineGetBox ( ControlName, ParentFormName, x, y, w, h, Value, ; ... If HB_ISCHAR( cPicture ) .and. ! Empty(cPicture) .and. '@K ' $ cPicture GotFocusSelect := .T. EndIf If ! Empty( GotFocusSelect ) .and. Empty( uGotFocus ) If ValType( Value ) == "C" _HMG_aControlGotFocusProcedure[k] := {|| SendMessage( _HMG_aControlHandles[k], EM_SETSEL, 0, If( Empty(Value), -1, Len(Trim(Value))) ) } ElseIf ValType( Value ) $ "ND" _HMG_aControlGotFocusProcedure[k] := {|| SendMessage( _HMG_aControlHandles[k], EM_SETSEL, 0, -1 ) } EndIf EndIf IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentFormHandle ) oc := _ControlObj( ControlHandle ) ENDIF Do_ControlEventProcedure ( bInit, k, oGet, ow, oc ) RETURN oGet [/pre2] Получилось 1. без SET OOP ON делаем (можем) WITH OBJECT App.Object с SET OOP ON делаем WITH OBJECT ThisWindow.Object работаем в одинаковых переменных 2. С использованием ON INIT практически все команды между _Define...(...) уходят в них и работа с This... обезличенно. Возможна упрощенная автоматизация, убрав лишнее в блоки кода (не надо делать как в demo.ch из примера) При работе с сообщениями удобнее устанавливать eventы на контролы. 3. Старый стиль написания остается Попробовал пока немного на GetBox
SergKis: PS[pre2] *-----------------------------------------------------------------------------* FUNCTION _EndTBrowse( bInit ) *-----------------------------------------------------------------------------* LOCAL i, oBrw LOCAL oc, ow := oDlu2Pixel() IF _HMG_BeginTBrowseActive i := AScan ( _HMG_aControlHandles, _HMG_ActiveTBrowseHandle ) IF i > 0 oBrw := _HMG_aControlIds[ i ] IF _HMG_lOOPEnabled ow := _WindowObj ( _HMG_aControlParenthandles[ i ] ) oc := _ControlObj( _HMG_aControlHandles [ i ] ) ENDIF Do_ControlEventProcedure ( bInit, i, oBrw, ow, oc ) oBrw:lRePaint := .T. oBrw:Display() _HMG_ActiveTBrowseName := "" _HMG_ActiveTBrowseHandle := 0 _HMG_BeginTBrowseActive := .F. ENDIF ENDIF RETURN NIL [/pre2]
SergKis: В продолжении примера, промежутков между контролами (GapsWidth, GapsHeight), оказалось удобным при Resize окон. В задаче окно разделено на 2-е части: - контролы Label, Getbox слева вертикально в плотном заполнении, 2 pixel в Normalize + кнопка Save - справа Tbrowse 60% окна. При Resize с ним ясно все. По контролам - персчитываю новое значение по вертикали GapsHeight, GapsWidth не меняю, т.е. левый X tsb тот же - меняю Y у контролов Текст из задачи как есть (кому интересно) [pre2] * ----------------------------------------------------------------------------------- * STATIC FUNCTION DokRetResize( oBrw ) * ----------------------------------------------------------------------------------- * LOCAL nW := This.ClientWidth - oBrw:nLeft LOCAL nH := This.ClientHeight, y, x, w, h, g LOCAL oWnd, aPar, nAlC, hSpl, nAlH, nGaH, nSpH oBrw:OnResize( nW, nH ) IF _HMG_MouseState == 0 oWnd := This.Object aPar := oWnd:GetProp(0) nAlC := aPar[4] hSpl := aPar[5] nAlH := aPar[6] nGaH := aPar[7] nSpH := GetWindowHeight(hSpl) h := nH - nSpH - nAlH // остаток высоты без контролов g := int( h / nAlC ) // GapsHeight new y := nSpH + g // Y start AEval( oWnd:GetObj4Type('LABEL,GETBOX,OBUTTON'), {|oc| oc:Hide() } ) This.K_1.Row := y; y += This.K_1.Height + g This.K_2.Row := y; y += This.K_2.Height + g This.K_3.Row := y This.K_4.Row := y; y += This.K_4.Height + g This.K_5.Row := y This.K_6.Row := y; y += This.K_6.Height + g This.K_7.Row := y; y += This.K_7.Height + g This.K_8.Row := y; y += This.K_8.Height + g This.K_9.Row := y; y += This.K_9.Height + g This.K_A.Row := y; y += This.K_A.Height + g This.K_B.Row := y This.K_C.Row := y; y += This.K_C.Height + g This.K_D.Row := y This.K_E.Row := y; y += This.K_E.Height + g This.K_F.Row := y This.K_G.Row := y; y += This.K_G.Height + g This.K_H.Row := y This.K_I.Row := y; y += This.K_I.Height + g This.O_1.Row := y; y += This.O_1.Height + g This.O_2.Row := y; y += This.O_2.Height + g This.O_3.Row := y This.O_4.Row := y; y += This.O_4.Height + g This.O_5.Row := y This.O_6.Row := y; y += This.O_6.Height + g This.O_7.Row := y This.O_8.Row := y; y += This.O_8.Height + g This.O_D.Row := y This.O_E.Row := y; y += This.O_E.Height + g This.O_F.Row := y This.O_G.Row := y; y += This.O_G.Height + g This.O_H.Row := y This.O_I.Row := y; y += This.O_I.Height + g This.Save.Row := y AEval( oWnd:GetObj4Type('LABEL,GETBOX,OBUTTON'), {|oc| oc:Show() } ) oBrw:AdjColumns() oBrw:SetFocus() ENDIF RETURN NIL [/pre2]
SergKis: gfilatov2002 Попробовал Tsb с on init ( пример Tsb_addRecord ) [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" #include "tsbrowse.ch" FIELD id, info *----------------------------------- PROCEDURE Main *----------------------------------- LOCAL i, obrw IF !hb_FileExists( "datab.dbf" ) dbCreate( "datab", { { "ID", "N", 5, 0 }, { "INFO", "C", 15, 0 } } ) ENDIF USE datab ALIAS base NEW INDEX ON id TO datab temporary IF LastRec() == 0 FOR i := 1 TO 100 APPEND BLANK REPLACE id WITH RecNo(), info WITH "record " + hb_ntos( RecNo(), 4 ) NEXT ENDIF DEFINE WINDOW win_1 AT 0, 0 WIDTH 400 HEIGHT 500 ; MAIN TITLE "TSBrowse Add Record Demo" NOMAXIMIZE NOSIZE @06, 10 BUTTON BRUN CAPTION "Add Record" ACTION AddRecord( obrw ) // DEFAULT DEFINE TBROWSE obrw AT 40, 10 GRID ALIAS "base" WIDTH 370 HEIGHT 418 ; ON INIT {|ob| InitTsb( .F., ob ) } END TBROWSE ON INIT {|ob| InitTsb( .T., ob ) } END WINDOW CENTER WINDOW win_1 ACTIVATE WINDOW win_1 RETURN *----------------------------------- STAT FUNC InitTsb( lEnd, obrw ) *----------------------------------- If ! lEnd ADD COLUMN TO obrw HEADER "ID" SIZE 100 DATA FieldWBlock( "id" , Select( "base" ) ) ADD COLUMN TO obrw HEADER "INFO" SIZE 150 DATA FieldWBlock( "info", Select( "base" ) ) obrw:lNoHScroll := .T. obrw:SetColor( { 2 }, { {|| iif( base->( ordKeyNo() ) % 2 == 0, RGB( 255, 255, 255 ), RGB( 230, 230, 230 ) ) } } ) Else obrw:SetNoHoles() obrw:SetFocus() EndIf RETURN NIL *----------------------------------- PROCEDURE AddRecord( obrw ) *----------------------------------- APPEND BLANK REPLACE id WITH RecNo(), info WITH "record " + hb_ntos( RecNo(), 4 ) obrw:GoToRec( base->( RecNo() ), .T. ) obrw:SetFocus() RETURN [/pre2] Был не прав с EndTbrowse сделал так [pre2] *-----------------------------------------------------------------------------* FUNCTION _EndTBrowse( bInit ) *-----------------------------------------------------------------------------* LOCAL i, oBrw LOCAL oc, ow := oDlu2Pixel() IF _HMG_BeginTBrowseActive i := AScan ( _HMG_aControlHandles, _HMG_ActiveTBrowseHandle ) IF i > 0 oBrw := _HMG_aControlIds[ i ] oBrw:lRePaint := .T. oBrw:Display() _HMG_ActiveTBrowseName := "" _HMG_ActiveTBrowseHandle := 0 _HMG_BeginTBrowseActive := .F. IF _HMG_lOOPEnabled ow := _WindowObj ( _HMG_aControlParenthandles[ i ] ) oc := _ControlObj( _HMG_aControlHandles [ i ] ) ENDIF Do_ControlEventProcedure ( bInit, i, oBrw, ow, oc ) ENDIF ENDIF RETURN NIL [/pre2]
gfilatov2002: SergKis пишет: Получилось 1. без SET OOP ON делаем (можем) WITH OBJECT App.Object с SET OOP ON делаем WITH OBJECT ThisWindow.Object работаем в одинаковых переменных Это очень интересно. Можно получить пример 1 для GetBox App_OopGetBox без установки SET OOP ON и для сравнения пример 3 App_OopGetBox3 с SET OOP ON SergKis пишет: 2. С использованием ON INIT практически все команды между _Define...(...) уходят в них и работа с This... обезличенно. Возможна упрощенная автоматизация, убрав лишнее в блоки кода (не надо делать как в demo.ch из примера) Очень хорошо SergKis пишет: 3. Старый стиль написания остается Отлично SergKis пишет: Попробовал Tsb с on init Спасибо! У меня такой пример тоже сработал (см. ниже) /* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" #include "tsbrowse.ch" FIELD id, info *---------------------------------------- PROCEDURE Main *---------------------------------------- LOCAL i, obrw IF !hb_FileExists( "datab.dbf" ) dbCreate( "datab", { { "ID", "N", 5, 0 }, { "INFO", "C", 15, 0 } } ) ENDIF USE datab ALIAS base NEW INDEX ON id TO datab temporary IF LastRec() == 0 FOR i := 1 TO 100 APPEND BLANK REPLACE id WITH RecNo(), info WITH "record " + hb_ntos( RecNo(), 4 ) NEXT ENDIF DEFINE WINDOW win_1 AT 0, 0 WIDTH 400 HEIGHT 500 ; MAIN TITLE "TSBrowse Add Record Demo" NOMAXIMIZE NOSIZE @06, 10 BUTTON brun CAPTION "Add Record" ACTION AddRecord( obrw ) DEFINE TBROWSE obrw AT 40, 10 GRID ALIAS "base" ; WIDTH 370 HEIGHT 418 ; ON INIT {|ob| TsbCreate( ob, .T. ) } END TBROWSE ON END {|ob| TsbCreate( ob, .F. ) } END WINDOW CENTER WINDOW win_1 ACTIVATE WINDOW win_1 RETURN *---------------------------------------- STATIC PROCEDURE TsbCreate( obrw, lInit ) *---------------------------------------- IF lInit ADD COLUMN TO obrw HEADER "ID" ; SIZE 100 ; DATA FieldWBlock( "id", Select( "base" ) ) ADD COLUMN TO obrw HEADER "INFO" ; SIZE 150 ; DATA FieldWBlock( "info", Select( "base" ) ) obrw:lNoHScroll := .T. obrw:SetColor( { 2 }, { {|| iif( base->( ordKeyNo() ) % 2 == 0, RGB( 255, 255, 255 ), RGB( 230, 230, 230 ) ) } } ) ELSE obrw:SetNoHoles() obrw:SetFocus() ENDIF RETURN *---------------------------------------- PROCEDURE AddRecord( obrw ) *---------------------------------------- APPEND BLANK REPLACE id WITH RecNo(), info WITH "record " + hb_ntos( RecNo(), 4 ) obrw:GoToRec( base->( RecNo() ), .T. ) obrw:SetFocus() RETURN
SergKis: gfilatov2002 Пример для SET OOP ON\OFF https://TransFiles.ru/wyxjd Если SET OOP ON -> убираем коменты у строк[pre2] WITH OBJECT App.Object //------------------------------------------ for SET OOP ON // WITH OBJECT This.Object // :O:BColorGet := :AO:BColorGet // (App.Object):O:BColorGet // :O:FColorGet := :AO:FColorGet // (App.Object):O:FColorGet // :O:FColor1 := :AO:FColor1 // (App.Object):O:FColor1 // :O:FColor2 := :AO:FColor2 // (App.Object):O:FColor2 //------------------------------------------ ставим коментарий у WITH OBJECT App.Object собран пример в режиме SET OOP OFF Небольшая правка CLASS TDlu2Pix ... заменить METHOD Event( Key, p1, p2, p3 ) INLINE iif( HB_ISBLOCK( p1 ), ; ::oEvent:Set( Key, p1 ), ; ( p2 := hb_defaultValue(p2, ::oParam:Get( Key)), ; ::oEvent:Do ( Key, p1, p2, p3 ) ) ) ... CLASS TWndData ... METHOD GetGaps( aGaps, oWnd ) INLINE ::oApp:GetGaps( aGaps, oWnd ) METHOD W ( nKfc ) INLINE ::oApp:W ( nKfc ) ... [/pre2]
SergKis: gfilatov2002 В App_OopGetbox2 правка[pre2] :Event( 1, {|| HMG_Alert("MessageBox Info", , "Information", ICON_INFORMATION) } ) :Event( 2, {|oa,ky,np,cp| ShellExecute( , 'open', App.ExeName, cp, , np ), ; ReleaseAllWindows() } ) :Event( 3, {|oa,ky,np,xp| _LogFile(.T., oa, ky, np, xp, oa:ClassName) } ) [/pre2]
gfilatov2002: SergKis пишет: собран пример в режиме SET OOP OFF Благодарю за скорую помощь
SergKis: gfilatov2002 В пример 3 правка [pre2] @ :Y, :X GETBOX Text_2b WIDTH :O:nDefLen HEIGHT :H1 ; ... ON CHANGE (App.Object):Send(This.Cargo, 300) ; //{|| TONE(300)}; ... @ :Y, :X BUTTONEX OButton_4 WIDTH :O:nDefLen HEIGHT :H1 * 2 ; ... ACTION ( (App.Object):Send(This.Cargo[1], 800), ; // TONE(800) (App.Object):Post(This.Cargo[2]) ) ; [/pre2]
полная версия страницы