Форум » GUI » Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение) » Ответить
Новая версия Расширенного релиза библиотеки MiniGUI (часть VI ) (продолжение)
gfilatov: Начало темы находится здесь, а теперь АНОНС * АНОНС * АНОНС * АНОНС * АНОНС Готовится к опубликованию новая сборка №48, которая выйдет в конце недели. Если у Вас есть интересные наработки для включения в новый релиз, то сейчас самое удобное время для их отправки мне Кратко, что нового: - исправление обнаруженных ошибок и неточностей кода; - новый класс HEADERIMAGE для Grid и Browse; - свойство Address в Hyperlink может теперь открывать папку или файл на диске; - добавлен NOTABSTOP класс для Browse; - поддержка пользовательских компонентов (заимствована из оффициального релиза); - расширения и исправления в библиотеках TsBrowse и PropGrid; - обновлены сборки Харбор и HMGS-IDE; - новые и обновленные старые примеры (как обычно ).
SergKis: PPS ON DBLCLICK (ThisWindow.Object):Post(12, This.Text_8.Index) ; //DublClick2Get() ; Такая форма записи, а не This.Index, исп. по причине отсутствия инф. о контроле, т.к. блок кода выполняется в TGET. Переданный индекс контрола, в событии создает среду This для указанного контрола. Если не передавать индекс, то среда This будет только для окна
SergKis: gfilatov2002 [pre2] можно зарезервировать для исп. в событиях о Петра MESSAGEONLY _App_Wnd_App_ EVENTS _App_Wnd_Events_ TO h и METHOD PostMsg( nKey, nPar ) INLINE PostMessage( ::hWnd, WM_APP_LAUNCH, nKey, hb_defaultValue( nPar, 0 ) ) METHOD SendMsg( nKey, nPar ) INLINE SendMessage( ::hWnd, WM_APP_LAUNCH, nKey, hb_defaultValue( nPar, 0 ) ) #define WM_WND_LAUNCH (WM_USER+1044) #define WM_CTL_LAUNCH (WM_USER+1045) #define WM_APP_LAUNCH (WM_USER+1046) [/pre2]
SergKis: gfilatov2002 Исправление, что бы в приоритете был индекс контрола, потом handle (было наоборот) [pre2] METHOD DoEvent ( Key, nHandle ) CLASS TWndData LOCAL o := Self LOCAL i := o:Index LOCAL w := o:IsWindow LOCAL p := o:oParam:Get(Key) IF ! Empty( nHandle ) IF nHandle > 0 .and. nHandle <= Len( _HMG_aControlHandles ) // control index IF hmg_IsWindowObject( _HMG_aControlHandles[ nHandle ] ) o := hmg_GetWindowObject( _HMG_aControlHandles[ nHandle ] ) i := o:Index w := o:IsWindow ELSE i := nHandle w := .F. ENDIF ELSEIF hmg_IsWindowObject( nHandle ) // control handle o := hmg_GetWindowObject( nHandle ) i := o:Index w := o:IsWindow ENDIF ENDIF IF w RETURN Do_WindowEventProcedure ( ::oEvent:Get( Key ), i, o, Key, p ) ENDIF RETURN Do_ControlEventProcedure( ::oEvent:Get( Key ), i, o, Key, p ) [/pre2]
SergKis: gfilatov2002 Еще, измените код, а то мелькает в левом верхнем углу [pre2] FUNCTION HMG_Alert( cMsg, aOptions, cTitle, nType, cIcoFile, nIcoSize ) ... DEFINE WINDOW oDlg WIDTH 0 HEIGHT 0 ; TITLE cTitle ; MODAL NOSIZE // ON INIT FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize ) END WINDOW FillDlg( cMsg, aOptions, nLineas, cIcoFile, nIcoSize ) ACTIVATE WINDOW oDlg ... [/pre2]
gfilatov2002: SergKis пишет: можно зарезервировать Cделал SergKis пишет: что бы в приоритете был индекс контрола Принято SergKis пишет: мелькает в левом верхнем углу Благодарю за помощь!
SergKis: gfilatov2002 пишет Сделал Спасибо. Вот что получилось с примером (h_objects.prg свежий) https://my-files.ru/v1kc9m
SergKis: gfilatov2002 Предложение. Вынести за скобки #ifdef _OBJECT_ процедуры 1. FUNCTION Do_WindowEventProcedure( bBlock, i, p1, p2, p3, p4 ) FUNCTION Do_ControlEventProcedure( bBlock, i, p1, p2, p3, p4 ) [pre2] 2. #command ACTIVATE WINDOW <name, ...> [ <nowait: NOWAIT> ] ; [ INIT <bInit> ] ; => ; _ActivateWindow ( \{<(name)>\}, <.nowait.>, , <{bInit}> ) #command ACTIVATE WINDOW ALL [ INIT <bInit> ] ; => ; _ActivateAllWindows ( <{bInit}> ) 3. *-----------------------------------------------------------------------------* FUNCTION _ActivateWindow ( aForm, lNoWait, lDebugger, bInit ) *-----------------------------------------------------------------------------* ... * Look For Main Window FOR EACH FormName IN aForm i := GetFormIndex ( FormName ) IF HB_ISBLOCK( bInit ) Do_WindowEventProcedure( bInit, i, 'WINDOW_ACTIVATE' ) ENDIF IF _HMG_aFormType [ i ] == 'A' MainFound := .T. EXIT ENDIF NEXT ... *-----------------------------------------------------------------------------* FUNCTION _ActivateAllWindows ( bInit ) *-----------------------------------------------------------------------------* ... AAdd ( aForm, MainName ) _ActivateWindow ( aForm, , , bInit ) RETURN NIL ... Использовать после END WINDOW среду This. Form_1.Center // Form_1.Activate ACTIVATE WINDOW Form_1 INIT _logfile(.T., This.Name, _HMG_Value()) ... [/pre2]
SergKis: gfilatov2002 Правка. [pre2] CLASS TDlu2Pix ... ASSIGN Handle( hWnd ) INLINE ( ::hWnd := hWnd, ::lError := Empty( hWnd ), ; iif( ::lError, MsgMiniGuiError("Application events are not created !"), ) ) ACCESS IsError INLINE ::lError ACCESS Wm_nApp INLINE WM_APP_LAUNCH ACCESS IsMsg INLINE ( ::lAction .and. ! ::lError ) ... METHOD Post ( nKey, nPar, xPar ) INLINE ::PostMsg( nKey, nPar, xPar ) METHOD PostMsg( nKey, nPar, xPar ) INLINE ( nPar := hb_defaultValue(nPar, 0), ; iif( ::IsMsg, ( ::oParam:Set( nKey, xPar ), ; PostMessage( ::hWnd, ::Wm_nApp, nKey, nPar ) ), Nil ) ) METHOD Send ( nKey, nPar, xPar ) INLINE ::SendMsg( nKey, nPar, xPar ) METHOD SendMsg( nKey, nPar, xPar ) INLINE ( nPar := hb_defaultValue(nPar, 0), ; iif( ::IsMsg, ( ::oParam:Set( nKey, xPar ), ; SendMessage( ::hWnd, ::Wm_nApp, nKey, nPar ) ), Nil ) ) ... [/pre2]
gfilatov2002: SergKis пишет: Предложение. Сделал, конечно. Только изменил кодовое слово INIT на ON INIT SergKis пишет: Правка Благодарю за помощь
SergKis: gfilatov2002 Еще, если добавить [pre2] CLASS TWndData ... ACCESS App INLINE ::oApp ACCESS AO INLINE ::oApp:oCargo ACCESS AP INLINE ::oApp:oProp ... можно писать короче 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 [/pre2]
gfilatov2002: SergKis пишет: ACCESS AO INLINE ::oApp:oCargo ACCESS AP INLINE ::oApp:oProp OK
SergKis: gfilatov2002 Пропустил строки [pre2] CLASS TDlu2Pix ... ACCESS IsMsg INLINE ( ::lAction .and. ! ::lError ) ACCESS Action INLINE ::lAction ASSIGN Action( lAction ) INLINE ::lAction := !( Empty( lAction ) ) ... [/pre2]
gfilatov2002: SergKis пишет: ACCESS Action INLINE ::lAction ASSIGN Action( lAction ) INLINE ::lAction := !( Empty( lAction ) ) OK
SergKis: gfilatov2002 Небольшая правка [pre2] CLASS TDlu2Pix ... METHOD Event( Key, Block, p2, p3 ) INLINE iif( HB_ISBLOCK( Block ), ; ::oEvent:Set( Key, Block ), ; ( Block := hb_defaultValue(Block, ::oParam:Get( Key)), ; ::oEvent:Do ( Key, Block, p2, p3 ) ) ) ... [/pre2] и пример https://my-files.ru/em7ci6
gfilatov2002: SergKis пишет: Небольшая правка Добавил Но модуль h_objects.prg в Вашем примере - без последних изменений
SergKis: gfilatov2002 Сори, забыл заменить. Тут https://my-files.ru/42c6pn
SergKis: gfilatov2002 Можно добавить [pre2] CLASS TDlu2Pix ... VAR nL INIT 0 VAR nT INIT 0 VAR nR INIT 0 VAR nB INIT 0 ... _METHOD GetGaps( aGaps, oWnd ) _METHOD D ( nKfc ) ... ACCESS Bottom INLINE ::MH() ACCESS LTRB INLINE { ::nL, ::nT, ::nR, ::nB } ... METHOD GetGaps( aGaps, oWnd ) CLASS TDlu2Pix LOCAL oApp, nGapW, nGapH, n If HB_ISCHAR(oWnd); oWnd := _WindowObj(oWnd) EndIf oApp := iif( Empty(oWnd), Self , oWnd:App ) nGapW := iif( Empty(oWnd), oApp:GapsWidth , oWnd:GapsWidth ) nGapH := iif( Empty(oWnd), oApp:GapsHeight, oWnd:GapsHeight ) If HB_ISNUMERIC(aGaps) n := aGaps aGaps := array(4) AFill(aGaps, n) EndIf DEFAULT aGaps := { 0, 0, nGapW, nGapH } ::nL := 0 ::nT := 0 ::nR := 0 ::nB := 0 If Len(aGaps) == 2 If ! HB_ISNUMERIC(aGaps[1]); aGaps[1] := nGapW EndIf If ! HB_ISNUMERIC(aGaps[2]); aGaps[2] := nGapH EndIf ::nL := aGaps[1] ::nR := aGaps[1] ::nT := aGaps[2] ::nB := aGaps[2] Else If Len(aGaps) != 4; ASize(aGaps, 4) EndIf If ! HB_ISNUMERIC(aGaps[1]); aGaps[1] := nGapW EndIf If ! HB_ISNUMERIC(aGaps[2]); aGaps[2] := nGapH EndIf If ! HB_ISNUMERIC(aGaps[3]); aGaps[3] := nGapW EndIf If ! HB_ISNUMERIC(aGaps[4]); aGaps[4] := nGapH EndIf ::nL := aGaps[1] ::nT := aGaps[2] ::nR := aGaps[3] ::nB := aGaps[4] EndIf If '.' $ hb_ntos(::nL); ::nL := oApp:GW( ::nL ) EndIf If '.' $ hb_ntos(::nT); ::nT := oApp:GH( ::nT ) EndIf If '.' $ hb_ntos(::nR); ::nR := oApp:GW( ::nR ) EndIf If '.' $ hb_ntos(::nB); ::nB := oApp:GH( ::nB ) EndIf aGaps[1] := ::nL aGaps[2] := ::nT aGaps[3] := ::nR aGaps[4] := ::nB RETURN aGaps ... Тогда в примере demo_misc.prg #include "demo.ch" *-----------------------------------------------------------------------------* FUNCTION _SetGaps( aGaps, oWnd ) *-----------------------------------------------------------------------------* RETURN (App.Object):GetGaps( aGaps, oWnd ) ... [/pre2] Пример https://my-files.ru/nljgq8
gfilatov2002: SergKis пишет: Можно добавить OK
SergKis: gfilatov2002 Мысли вслух. Если вынести oDlu2Pixel(...) и класс TDlu2Pix за скобки #ifdef _OBJECT_, то можно [pre2] i_altsyntax.ch #xcommand END BUTTON [ ON INIT <bInit> ] ; ... _HMG_ActiveControlId, ; <bInit> ) ) ... #xcommand END BUTTONEX [ ON INIT <bInit> ] ; ... _HMG_ActiveControlHorizontal,; <bInit> ) ... #xcommand END GETBOX [<o: OBJ,OBJECT> <var>] [ ON INIT <binit> ] ; ... .NOT. _HMG_ActiveControlBorder,; <binit> ) ... #xcommand END LABEL [ ON INIT <bInit> ] ; ... _HMG_ActiveControlId,; <bInit> ) ... i_button.ch ... #xcommand @ <row>,<col> BUTTONEX <name> ; ... [ <default: DEFAULT> ] ; [ ON INIT <bInit> ] ; ... <imageheight>, <aGradInfo>, <.horizontal.>, <bInit> ) ... i_getbox.ch ... #command @ <row>, <col> GETBOX <name> ; ... [ HELPID <helpid> ] ; [ ON INIT <bInit> ] ; ... <{action2}>, <abitmap>, <btnwidth>, <.nominus.>, <.noborder.>, <bInit> ) ... i_label.ch ... #command @ <row>,<col> LABEL <name> ; ... [ <noprefix: NOPREFIX> ] ; [ ON INIT <bInit> ] ; ... <nId>, ; <bInit> ) ... h_button.prg ... FUNCTION _DefineOwnerButton ( ControlName, ParentForm, x, y, Caption, ; ... ladjust, handcursor, imagewidth, imageheight, aGradInfo, lhorizontal, bInit ) ... LOCAL k LOCAL oc, ow ... IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentForm ) oc := _ControlObj( ControlHandle ) ENDIF Do_ControlEventProcedure ( bInit, k, oc, ow ) RETURN Nil ... h_getbox.prg ... FUNCTION _DefineGetBox ( ControlName, ParentFormName, x, y, w, h, Value, ; ... when, ProcedureName, ProcedureName2, abitmap, BtnWidth, lNoMinus, noborder, ; bInit ) ... LOCAL k, Style, aPicData, oGet LOCAL oc, ow ... IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentFormHandle ) oc := _ControlObj( ControlHandle ) ENDIF Do_ControlEventProcedure ( bInit, k, oGet, oc, ow ) RETURN oGet ... h_label.prg ... FUNCTION _DefineLabel ( ControlName, ParentFormName, x, y, Caption, w, h, ; ... LOCAL lDialogInMemory LOCAL oc, ow ... IF autosize == .T. .AND. .NOT. lDialogInMemory _SetControlWidth ( ControlName , ParentFormName , GetTextWidth( NIL, Caption, FontHandle ) + ; iif( bold == .T. .OR. italic == .T., GetTextWidth( NIL, " ", FontHandle ), 0 ) ) _SetControlHeight ( ControlName , ParentFormName , FontSize + iif( FontSize < 14, 12, 16 ) ) ENDIF IF _HMG_lOOPEnabled Eval ( _HMG_bOnControlInit, k, mVar ) ow := _WindowObj ( ParentFormHandle ) oc := _ControlObj( ControlHandle ) ENDIF Do_ControlEventProcedure ( bInit, k, oc, ow ) RETURN Nil ... и т.д. Тогда в примере так пишем demo.prg ... // :Y += :GapsHeight :X := :Left DEFINE GETBOX Text_2c // Alternate Syntax ROW :Y += :GapsHeight COL :X WIDTH :W() HEIGHT :H() VALUE "MyPass" PICTURE "@K !!!!!!!!!" BACKCOLOR :O:BColorGet FONTCOLOR :O:FColorGet VALID {|| ( len(alltrim(This.Value)) >= 4)} TOOLTIP "Character input PASSWORD clause is set" VALIDMESSAGE "Password must contains minimum 4 characters" MESSAGE "Enter password (min 4 char.) " PASSWORD .T. END GETBOX ON INIT {|og,oc,ow| ow:Y += This.Height + ow:GapsHeight } // :Y += This.Text_2c.Height + :GapsHeight :O:aFrm[4] := :Y - :O:aFrm[1] ... По др. контролам аналогично. Используется среда контрола в ON INIT. [/pre2]
SergKis: PS Оборвалась передача, пропала ссылка на пример с указанными изменениями Пример тут https://my-files.ru/2iogvt
полная версия страницы