Controle definido pelo usuário

[JoséQuintas]

Alguém aí já usou o controle definido pelo usuário?

HMG3: samples\advanced\user_components
HMG Extended: samples\basic\user_components

[JoséQuintas]

Esta aqui:

Código: Selecionar todos

#include "i_winuser.ch"

INIT PROCEDURE _InitHMGButton

   InstallEventHandler ( 'HMGButtonEventHandler' )
   InstallMethodHandler ( 'SetFocus', 'HMGButtonSetFocus' )
   InstallMethodHandler ( 'Enable', 'HMGButtonEnable' )
   InstallMethodHandler ( 'Disable', 'HMGButtonDisable' )
   InstallPropertyHandler ( 'Handle', 'SetHMGButtonHandle', 'GetHMGButtonHandle' )

   RETURN

PROCEDURE _DefineMixedButton ( ControlName, ParentForm, x, y, caption, ;
      ProcedureName, w, h, FontName, FontSize, tooltip, ;
      gotfocus, lostfocus, flat, notabstop, HelpId, ;
      invisible, bold, italic, underline, strikeout, ;
      picture, alignment, multiline, notrans )

   LOCAL ControlHandle, ParentFormHandle, k, cMacroVar, FontHandle, aRet

   IF _HMG_BeginWindowActive
      ParentForm := _HMG_ActiveFormName
   ENDIF

   IF .NOT. _IsWindowDefined ( ParentForm )
      MsgMiniGuiError( "Window: " + ParentForm + " is not defined." )
   ENDIF

   IF _IsControlDefined ( ControlName, ParentForm )
      MsgMiniGuiError ( "Control: " + ControlName + " Of " + ParentForm + " Already defined." )
   ENDIF

   DEFAULT w TO 100
   DEFAULT h TO 28
   DEFAULT lostfocus TO ""
   DEFAULT gotfocus TO ""
   DEFAULT invisible TO FALSE

   IF ( FontHandle := GetFontHandle( FontName ) ) != 0
      GetFontParamByRef( FontHandle, @FontName, @FontSize, @bold, @italic, @underline, @strikeout )
   ENDIF

   cMacroVar := '_' + ParentForm + '_' + ControlName
   k := _GetControlFree()
   ParentFormHandle := GetFormHandle ( ParentForm )
   //////////////////////////////////////////////////
   aRet := InitMixedButton ( ParentFormHandle, caption, 0, x, y, w, h, '', 0, FLAT, NOTABSTOP, invisible, picture, alignment, multiline, notrans )
   //////////////////////////////////////////////////

   ControlHandle := aRet[ 1 ]

   IF FontHandle != 0
      _SetFontHandle( ControlHandle, FontHandle )
   ELSE
      __defaultNIL( @FontName, _HMG_DefaultFontName )
      __defaultNIL( @FontSize, _HMG_DefaultFontSize )
      FontHandle := _SetFont ( ControlHandle, FontName, FontSize, bold, italic, underline, strikeout )
   ENDIF

   IF _HMG_BeginTabActive
      AAdd ( _HMG_ActiveTabCurrentPageMap, Controlhandle )
   ENDIF

   IF tooltip != NIL
      SetToolTip ( ControlHandle, tooltip, GetFormToolTipHandle ( ParentForm ) )
   ENDIF

#ifdef _NAMES_LIST_
   _SetNameList( cMacroVar, k )

#else
   PUBLIC &cMacroVar. := k

#endif

   _HMG_aControlType[ k ] := 'HMGBUTTON'
   _HMG_aControlNames[ k ] := ControlName
   _HMG_aControlHandles[ k ] := ControlHandle
   _HMG_aControlParenthandles[ k ] := ParentFormHandle
   _HMG_aControlIds[ k ] := 0
   _HMG_aControlProcedures[ k ] := ProcedureName
   _HMG_aControlPageMap[ k ] := {}
   _HMG_aControlValue[ k ] := NIL
   _HMG_aControlInputMask[ k ] := ""
   _HMG_aControllostFocusProcedure[ k ] := lostfocus
   _HMG_aControlGotFocusProcedure[ k ] := gotfocus
   _HMG_aControlChangeProcedure[ k ] := ""
   _HMG_aControlDeleted[ k ] := .F.
   _HMG_aControlBkColor[ k ] := NIL
   _HMG_aControlFontColor[ k ] := NIL
   _HMG_aControlDblClick[ k ] := notrans
   _HMG_aControlHeadClick[ k ] := {}
   _HMG_aControlRow[ k ] := y
   _HMG_aControlCol[ k ] := x
   _HMG_aControlWidth[ k ] := w
   _HMG_aControlHeight[ k ] := h
   _HMG_aControlSpacing[ k ] := alignment
   _HMG_aControlContainerRow[ k ] := -1
   _HMG_aControlContainerCol[ k ] := -1
   _HMG_aControlPicture[ k ] := picture
   _HMG_aControlContainerHandle[ k ] := 0
   _HMG_aControlFontName[ k ] := FontName
   _HMG_aControlFontSize[ k ] := FontSize
   _HMG_aControlFontAttributes[ k ] := { bold, italic, underline, strikeout }
   _HMG_aControlToolTip[ k ] := tooltip
   _HMG_aControlRangeMin[ k ] := 0
   _HMG_aControlRangeMax[ k ] := 0
   _HMG_aControlCaption[ k ] := caption
   _HMG_aControlVisible[ k ] := .T.
   _HMG_aControlHelpId[ k ] := HelpId
   _HMG_aControlFontHandle[ k ] := FontHandle
   _HMG_aControlBrushHandle[ k ] := aRet[ 2 ]
   _HMG_aControlEnabled[ k ] := .T.
   _HMG_aControlMiscData1[ k ] := 0
   _HMG_aControlMiscData2[ k ] := ''

   RETURN

FUNCTION HMGButtonEventhandler ( hWnd, nMsg, wParam, lParam )

   LOCAL i
   LOCAL RetVal := NIL

   hWnd := NIL // Unused variable
   IF nMsg == WM_COMMAND
      i := AScan ( _HMG_aControlHandles, lParam )
      IF i > 0 .AND. _HMG_aControlType[ i ] == 'HMGBUTTON'
         * Button Click ........................................
         IF HiWord ( wParam ) == BN_CLICKED
            RetVal := 0
            _DoControlEventProcedure ( _HMG_aControlProcedures[ i ], i )
         ENDIF
         * Button LostFocus ....................................
         IF HiWord ( wParam ) == BN_KILLFOCUS
            RetVal := 0
            _DoControlEventProcedure ( _HMG_aControllostFocusProcedure [i] , i )
         ENDIF
         * Button GotFocus .....................................
         IF HiWord ( wParam ) == BN_SETFOCUS
            RetVal := 0
            _DoControlEventProcedure ( _HMG_aControlGotFocusProcedure [i] , i )
         ENDIF
      ENDIF
   ENDIF

   RETURN RetVal

PROCEDURE HMGButtonSetFocus ( cWindow, cControl )

   LOCAL hWnd, ParentFormHandle
   LOCAL ControlCount
   LOCAL x

   IF GetControlType ( cControl, cWindow ) == 'HMGBUTTON'

      _HMG_UserComponentProcess := .T.

      hWnd := GetControlHandle ( cControl, cWindow )
      ControlCount := Len ( _HMG_aControlNames )
      ParentFormHandle := _HMG_aControlParentHandles[ GetControlIndex ( cControl, cWindow ) ]
      FOR x := 1 TO ControlCount
         IF _HMG_aControlType[ x ] == 'HMGBUTTON'
            IF _HMG_aControlParentHandles[ x ] == ParentFormHandle
               SendMessage ( _HMG_aControlHandles[ x ], BM_SETSTYLE, LOWORD ( BS_PUSHBUTTON ), 1 )
            ENDIF
         ENDIF
      NEXT
      SetFocus( hWnd )
      SendMessage ( hWnd, BM_SETSTYLE, LOWORD ( BS_DEFPUSHBUTTON ), 1 )
   ELSE
      _HMG_UserComponentProcess := .F.
   ENDIF

   RETURN

PROCEDURE HMGButtonEnable ( cWindow, cControl )

   IF GetControlType ( cControl, cWindow ) == 'HMGBUTTON'
      EnableWindow ( GetControlHandle ( cControl, cWindow ) )
      _HMG_UserComponentProcess := .T.
   ELSE
      _HMG_UserComponentProcess := .F.
   ENDIF

   RETURN

PROCEDURE HMGButtonDisable ( cWindow, cControl )

   IF GetControlType ( cControl, cWindow ) == 'HMGBUTTON'
      DisableWindow ( GetControlHandle ( cControl, cWindow ) )
      _HMG_UserComponentProcess := .T.
   ELSE
      _HMG_UserComponentProcess := .F.
   ENDIF

   RETURN

FUNCTION SetHMGButtonHandle ( cWindow, cControl )

   IF GetControlType ( cControl, cWindow ) == 'HMGBUTTON'
      MsgExclamation ( 'This Property is Read Only!', 'Warning' )
      _HMG_UserComponentProcess := .T.
   ELSE
      _HMG_UserComponentProcess := .F.
   ENDIF

   RETURN NIL

FUNCTION GetHMGButtonHandle ( cWindow, cControl )

   LOCAL RetVal := NIL

   IF GetControlType ( cControl, cWindow ) == 'HMGBUTTON'
      _HMG_UserComponentProcess := .T.
      RetVal := GetControlHandle ( cControl, cWindow )
   ELSE
      _HMG_UserComponentProcess := .F.
   ENDIF

   RETURN RetVal

FUNCTION SetHMGButtonCaption ( cWindow, cControl, cProperty, cValue )

   cProperty := NIL // Unused variable

   IF GetControlType ( cControl, cWindow ) == 'HMGBUTTON'
      _HMG_UserComponentProcess := .T.
      SetWindowText ( GetControlHandle ( cControl, cWindow ), cValue )
   ELSE
      _HMG_UserComponentProcess := .F.
   ENDIF

   RETURN NIL

FUNCTION GetHMGButtonCaption ( cWindow, cControl )

   LOCAL RetVal := NIL

   IF GetControlType ( cControl, cWindow ) == 'HMGBUTTON'
      _HMG_UserComponentProcess := .T.
      RetVal := GetWindowText ( GetControlHandle ( cControl, cWindow ) )
   ELSE
      _HMG_UserComponentProcess := .F.
   ENDIF

   RETURN RetVal

Já imaginam né... uma janela GTWVG como controle da HMG.

Também já imagino que mesmo que dê certo, vai dar errado.
O mesmo problema de GUI em GTWVG: o foco
Mesmo assim quero tentar.

Só testando possibilidades, antes de começar pra valer.