FiveTech Software tech support forums

www.FiveTechSoft.com
https://forums.fivetechsupport.com/

Multiget con color cuando esta deshabilitado

https://forums.fivetechsupport.com/viewtopic.php?f=6&t=44423

Page 1 of 2

Multiget con color cuando esta deshabilitado

PostPosted: Sun Apr 14, 2024 6:10 pm
by carlos vargas
Estimados, en fwh los get cuando están deshabilitados (when .f.) se les puede indicar un color por defecto
Code: Select all  Expand view
  tGet():bColorBlock := { |oGet| IIf( oGet:lFocused, { CLR_BLACK, CLR_MENTA }, IIf( !oGet:lActive, { CLR_BLUE, CLR_SOFTYELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
 

pero para los multiget (memo gets) no es posible. (en igual forma los combobox)
existe alguna manera de hacerlo?

Re: Multiget con color cuando esta deshabilitado

PostPosted: Mon Apr 15, 2024 11:58 am
by Antonio Linares
Estimado Carlos,

Aqui tienes la clase TMultiGet modificada para que se comporte igual que la clase TGet y un ejempo para que la pruebes.

Hemos intentado mantener la compatibilidad con la versión anterior para que no afecte a ningún usuario. Lo único que falta es
el color del texto en MultiLines deshabilitados. A ver si lo solucionamos rápido.

Ejemplo:
Code: Select all  Expand view
#include "FiveWin.ch"

function Main()

    local oDlg, oGet1, oGet3
    local cTest1, cTest2, cTest3, cTest4

    cTest1 := cTest2 := cTest3 := cTest4 := PadR( "Hello world", 30 )

    TGet():bColorBlock := { |oGet| If( oGet:lFocused, { CLR_BLACK, CLR_GREEN },;
                                   If( ! oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
    TMultiGet():bColorBlock := { |oGet| If( oGet:lFocused, { CLR_BLACK, CLR_GREEN },;
                                        If( ! oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }

    DEFINE DIALOG oDlg SIZE 500, 300

    @ 1, 1 GET oGet1 VAR cTest1

    @ 2, 1 GET cTest2

    @ 3, 1 GET oGet3 VAR cTest3 MULTILINE SIZE 240, 30

    @ 6, 1 GET cTest4 MULTILINE SIZE 240, 30

    ACTIVATE DIALOG oDlg CENTERED ;
        ON INIT ( oGet1:Disable(), oGet3:Disable(), .T. )

return nil    

mget.prg
Code: Select all  Expand view
#include "FiveWin.ch"
#include "Constant.ch"
#include "Set.ch"
#include "print.ch"

#ifdef __CLIPPER__
   #define EM_GETSEL       (WM_USER+0)
   #define EM_SETSEL       (WM_USER+1)
   #define EM_UNDO         (WM_USER+23)
   #define EM_LINEFROMCHAR (WM_USER+25)
   #define EM_GETLINECOUNT (WM_USER+10)
   #define EM_LINEINDEX    (WM_USER+11)
   #define EM_CANUNDO      (WM_USER+22)
#else
   #define EM_GETSEL               176
   #define EM_SETSEL               177
   #define EM_UNDO                 199
   #define EM_LINEFROMCHAR         201
   #define EM_LINESCROLL           182
   #define EM_GETLINECOUNT         186
   #define EM_LINEINDEX            187
   #define EM_CANUNDO              198

   #ifdef __XPP__
      #define ::Super  ::TControl
      #define New    _New
      #define GetNew _GetNew
      #define GetDelSel _GetDelSel
   #endif
#endif

#define COLOR_WINDOW              5
#define COLOR_WINDOWTEXT          8

#define ES_CENTER                 1

#define WM_ERASEBKGND            20
#define WM_SETFONT               48
#define WM_CUT                  768   //  0x300
#define WM_PASTE                770   //  0x302
#define WM_CLEAR                771   //  0x303

#define CW_USEDEFAULT         32768

#define GWL_STYLE             ( -16)

#define EM_LIMITTEXT            197
#define EM_SCROLLCARET        ( WM_USER + 49 )

#define WS_EX_CLIENTEDGE        512

#define EM_SETLIMITTEXT      0x00C5

static tmp

//----------------------------------------------------------------------------//

CLASS TMultiGet FROM TControl

   DATA   lReadOnly
   DATA   nPos
   DATA   hHeap
   DATA   nOldClrPane // Old background color, if color changed with focus

   DATA bColor
   ACCESS aColor INLINE ( tmp := Eval( ::bColor, Self ), If( HB_ISARRAY( tmp ), AClone( tmp ), { tmp, ::nClrPane } ) )

   CLASSDATA lClrFocus  INIT .F. // change GET color when focused
   CLASSDATA nClrFocus  INIT nRGB( 235, 235, 145 ) // color to use when GET is focused and lClrFocus is .T.

   CLASSDATA lChangeCaret INIT .T.
   CLASSDATA bColorBlock

   METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, oFont, lHScroll,;
               nClrFore, nClrBack, oCursor, lPixel, cMsg, lUpdate,;
               bWhen, lCenter, lRight, lReadOnly, bValid, bChanged,;
               lDesign, lNoBorder, lNoVScroll ) CONSTRUCTOR

   METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, nClrFore, nClrBack, oFont,;
                    oCursor, cMsg, lUpdate, bWhen, lReadOnly, bValid,;
                    bChanged ) CONSTRUCTOR

   METHOD AdjClient() INLINE ::Super:AdjClient(), MoveGet( ::hWnd )

   #ifndef __HARBOUR__
      METHOD Append( cText, nLen ) INLINE ;
                     nLen := ::Len()  ,;
                     SendMessage( ::hWnd, EM_SETSEL, 0,;
                                  nMakeLong( nLen, nLen ) ),;
                     ::Replace( cText )
   #else
      METHOD Append( cText, nLen ) INLINE ;
                     nLen := ::Len()  ,;
                     SendMessage( ::hWnd, EM_SETSEL, nLen, nLen ),;
                     ::Replace( cText )
   #endif

   METHOD cToChar() INLINE  ::Super:cToChar( "EDIT" )

   METHOD Copy()

   METHOD Create( cClsName )

   METHOD Cut()

   METHOD Del()

   METHOD Default()

   METHOD DelLine( nLine )

   METHOD Destroy()

   #ifndef __C3__
      METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 1
   #endif

   METHOD DlgGoLine()

   METHOD EraseBkGnd() INLINE 1

   METHOD Find( cText ) INLINE  DlgFindText( cText, Self )

   METHOD GetLine( nLine ) INLINE MGetLine( ::hWnd, nLine )

   METHOD GetLineCount() INLINE SendMessage( ::hWnd, EM_GETLINECOUNT )

   METHOD GotFocus()

   METHOD GetRow()
   METHOD GetCol()

   #ifdef __CLIPPER__
      METHOD GoBottom() INLINE ::SetPos( Len( AllTrim( ::GetText() ) ) + 1 )
   #else
      METHOD GoBottom() INLINE ( ::SetPos( Len( AllTrim( ::GetText() ) ) + 1 ),;
                                 ::SendMsg( EM_LINESCROLL, 0, ::GetLineCount() ) )
   #endif

   METHOD GoTo( nLine ) INLINE ;
                ::SetPos( SendMessage( ::hWnd, EM_LINEINDEX, nLine, 0 ) )

   METHOD HideSel() INLINE ::SetSel( -1, 0 )

   METHOD Initiate( hDlg )

   METHOD LButtonDown( nRow, nCol, nFlags, lTouch )

   METHOD LButtonUp( nRow, nCol, nFlags )

   METHOD Len() INLINE GetWinTxtLenght( ::hWnd )

   // Call this method to use unlimited text size
   METHOD LimitText( nChars ) INLINE SendMessage( ::hWnd, EM_LIMITTEXT, If( Empty( nChars ), 0, nChars ), 0 )

   METHOD LineIndex( nLine ) INLINE ::SendMsg( EM_LINEINDEX, nLine )

   METHOD LostFocus( hCtlFocus )

   METHOD MouseMove( nRow, nCol, nKeyFlags )

   METHOD Move( nTop, nLeft, nBottom, nRight, lRepaint )

   METHOD cText( cText ) SETGET

   METHOD Paint()

   METHOD Paste( cText )

   METHOD Print()

   METHOD RButtonDown( nRow, nCol, nFlags )

   METHOD Refresh() BLOCK { | Self, nStart, nEnd | ::GetSelPos( @nStart, @nEnd ),;
                          ::SetText( cValToChar( Eval( ::bSetGet ) ) ),;
                          ::SetPos( nStart, nEnd ) }

   METHOD Replace( cText ) INLINE ;
                           MGetReplace( ::hWnd, cText ),;
                           Eval( ::bSetGet, ::GetText() )

   METHOD SaveToFile( cFileName ) INLINE MemoWrit( cFileName, ::GetText() )

   METHOD SelectAll() INLINE ::SetSel( 0, -1 )

   METHOD SetCoors( oRect )

   #ifdef __CLIPPER__
   METHOD SetSel( nStart, nEnd ) INLINE ;
                  nStart := If( nStart == nil, 1, nStart ),;
                  nEnd   := If( nEnd == nil, nStart, nEnd ),;
                  SendMessage( ::hWnd, EM_SETSEL, 0,;
                  nMakeLong( nStart - If( nStart > 0, 1, 0 ),;
                  nEnd - If( nEnd > 0, 1, 0 ) ) ),;
                  ::nPos := nStart
   #else
   METHOD SetSel( nStart, nEnd ) INLINE ;
                  nStart := If( nStart == nil, 1, nStart ),;
                  nEnd   := If( nEnd == nil, nStart, nEnd ),;
                  SendMessage( ::hWnd, EM_SETSEL, nStart, nEnd ),;
                  ::nPos := nStart
   #endif

   METHOD VScroll( nWParam, nLParam ) VIRTUAL

   METHOD HScroll( nWParam, nLParam ) VIRTUAL

   METHOD GetSel()
   METHOD GetSelPos( nStart, nEnd )

   METHOD KeyChar( nKey, nFlags )

   METHOD KeyDown( nKey, nFlags )

   METHOD SetColorFocus( nClrFocus )

   #ifdef __CLIPPER__
   METHOD SetPos( nStart, nEnd ) INLINE ;
                 nEnd := If( nEnd == nil, nStart, nEnd ),;
                 ::SendMsg( EM_SETSEL, 0, nMakeLong( nStart, nEnd ) ),;
                 ::nPos := nStart
   #else
   METHOD SetPos( nStart, nEnd ) INLINE ;
                 nEnd := If( nEnd == nil, nStart, nEnd ),;
                 ::SendMsg( EM_SETSEL, nStart, nEnd ),;
                 ::nPos := nStart,;
                 SendMessage(::hWnd, EM_SCROLLCARET, 0, 0)
   #endif

   METHOD UnDo() INLINE ::SendMsg( EM_UNDO ),;
                        Eval( ::bSetGet, ::GetText() )

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, oFont, lHScroll,;
            nClrFore, nClrBack, oCursor, lPixel, cMsg, lUpdate,;
            bWhen, lCenter, lRight, lReadOnly, bValid, bChanged,;
            lDesign, lNoBorder, lNoVScroll ) CLASS TMultiGet

   DEFAULT lHScroll   := .f.,;
           nClrFore   := GetSysColor( COLOR_WINDOWTEXT ),;
           nClrBack   := GetSysColor( COLOR_WINDOW ),;
           lPixel     := .f., lUpdate := .f.,;
           lCenter    := .f., lRight := .f.,;
           lReadOnly  := .f., lDesign := .f.,;
           oWnd       := GetWndDefault(),;
           nRow       := 0, nCol := 0,;
           lNoVScroll := .f., lNoBorder := .f.

   ::lUnicode  = FW_SetUnicode()
   if bSetGet != nil
      ::cCaption = cValToChar( Eval( bSetGet ) )
   else
      ::cCaption = ""
   endif

   ::nTop     = nRow * If( lPixel, 1, MGET_CHARPIX_H )  //13
   ::nLeft    = nCol * If( lPixel, 1, MGET_CHARPIX_W )   // 8
   ::nBottom  = If( nHeight == nil, ::nTop + 11, ::nTop + nHeight )
   ::nRight   = If( nWidth == nil, ::nLeft + Len( ::cCaption ) * 3.5, ;
                    ::nLeft + nWidth )
   ::bSetGet  = bSetGet
   ::uOriginalValue = Eval( ::bSetGet )
   ::oWnd     = oWnd
   ::nStyle   = nOR( WS_CHILD, WS_VISIBLE, ES_LEFT,;
                     ES_WANTRETURN, ES_MULTILINE,;
                     If( ! lReadOnly, WS_TABSTOP, 0 ),;
                     If( ! lNoVScroll, WS_VSCROLL, 0 ),;
                     If( lDesign, WS_CLIPSIBLINGS, 0 ),;
                     If( lHScroll, WS_HSCROLL, 0 ),;
                     If( lCenter, ES_CENTER, If( lRight, ES_RIGHT, ES_LEFT ) ) )

   #ifdef __CLIPPER__
      if ! lNoBorder
         ::nStyle = nOr( ::nStyle, WS_BORDER )
      endif
   #else
      if ! IsAppThemed()
         if ! lNoBorder
            ::nStyle = nOr( ::nStyle, WS_BORDER )
         endif
      else
         if ! lNoBorder
            ::nStyle = nOr( ::nStyle, If( oWnd:IsKindOf( "TDIALOG" ), WS_BORDER, 0 ) )
            ::nExStyle = WS_EX_CLIENTEDGE
         endif
      endif
   #endif

   ::nId       = ::GetNewId()
   ::cCaption  = RTrim( ::cCaption )
   ::lDrag     = lDesign
   ::lCaptured = .f.
   ::oCursor   = oCursor
   if oFont != nil
      oFont:nCount++
      ::oFont     = oFont
   endif
   ::cMsg      = cMsg
   ::lUpdate   = lUpdate
   ::bWhen     = bWhen
   ::bValid    = bValid
   ::lReadOnly = lReadOnly
   ::nPos      = 0
   ::bChange   = bChanged

   if ! Empty( oWnd:hWnd )
      ::cCaption  := Left( ::cCaption, 20000 )
      ::Create( "EDIT" )
      ::LimitText( 0 )
      if Len( ::cCaption ) == 20000
         ::SetText( cValToChar( Eval( ::bSetGet ) ) )
      endif
/*
      if ::oFont != nil .or. ::oWnd:oFont != nil
         PostMessage( ::hWnd, WM_SETFONT,;
                      If( oFont != nil, oFont:hFont,;
                          ::oWnd:oFont:hFont ) )
      endif
*/
      if ::oFont == nil
         ::GetFont()
      else
         ::SetFont( ::oFont )
      endif
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

   ::GetFont()

   DEFAULT ::bColor := ::bColorBlock

   if Empty( ::bColor )
      ::SetColor( ::nClrText, nClrBack )
   else
      tmp = ::aColor
      ::nClrText = tmp[ 1 ]
      ::nClrPane = tmp[ 2 ]
      ::oBrush = TBrush():New( , ::nClrPane )
      ::Refresh()
   endif      

   if lDesign
      ::CheckDots()
   endif

   ::SendMsg( EM_SETLIMITTEXT, -1 ) // Unlimited text length

return Self

//----------------------------------------------------------------------------//

METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, nClrFore, nClrBack, oFont,;
             oCursor, cMsg, lUpdate, bWhen, lReadOnly, bValid, bChanged ) CLASS TMultiGet

   DEFAULT nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
           nClrBack := GetSysColor( COLOR_WINDOW ),;
           lUpdate  := .f., lReadOnly := .f.,;
           oWnd     := GetWndDefault()

   ::lUnicode  = FW_SetUnicode()
   ::nId       = nId
   ::bSetGet   = bSetGet
   ::uOriginalValue = Eval( ::bSetGet )
   ::oWnd      = oWnd
   ::nHelpId   = nHelpId
   ::lDrag     = .f.
   ::lCaptured = .f.
   if oFont != nil
      oFont:nCount++
      ::oFont     = oFont
   endif
   ::oCursor   = oCursor
   ::cMsg      = cMsg
   ::lUpdate   = lUpdate
   ::bWhen     = bWhen
   ::bValid    = bValid
   ::lReadOnly = lReadOnly
   ::nPos      = 0
   ::bChange   = bChanged

   DEFAULT ::bColor := ::bColorBlock

   if Empty( ::bColor )
      ::SetColor( nClrFore, nClrBack )
   else
      tmp = ::aColor
      ::nClrText = tmp[ 1 ]
      ::nClrPane = tmp[ 2 ]
      ::oBrush = TBrush():New( , ::nClrPane )
   endif      

   oWnd:DefControl( Self )

return Self

//----------------------------------------------------------------------------//

METHOD Initiate( hDlg ) CLASS TMultiGet

   ::LimitText()
   ::Super:Initiate( hDlg )
   ::SetText( cValToChar( Eval( ::bSetGet ) ) )
   ::Default()

return nil

//----------------------------------------------------------------------------//

METHOD cText( cText ) CLASS TMultiGet

   if PCount() == 1
      ::SetText( cText )
      Eval( ::bSetGet, cText )
   endif

return ::GetText()

//----------------------------------------------------------------------------//

METHOD Copy() CLASS TMultiGet

   local oClp

   #ifdef __XPP__
      #undef New
   #endif

   DEFINE CLIPBOARD oClp OF Self ;
      FORMAT TEXT

   if oClp:Open()
      oClp:Clear()
      oClp:SetText( ::GetSel() )
      oClp:End()
   else
      MsgAlert( "The clipboard is not available now!" )
   endif

return nil

//---------------------------------------------------------------------------//

METHOD Create( cClsName ) CLASS TMultiGet

   local hHeap

   DEFAULT cClsName := ::ClassName(), ::cCaption := "",;
           ::nStyle := WS_OVERLAPPEDWINDOW,;
           ::nTop   := 0, ::nLeft := 0, ::nBottom := 10, ::nRight := 10,;
           ::nId    := 0

   if ::oWnd != nil
      ::nStyle = nOR( ::nStyle, WS_CHILD )
   endif

   if ::nBottom != CW_USEDEFAULT
      ::hWnd = MGetCreate( cClsName, ::cCaption, ::nStyle, ;
                           ::nLeft, ::nTop, ::nRight - ::nLeft + 1, ;
                           ::nBottom - ::nTop + 1, ;
                           If( ::oWnd != nil, ::oWnd:hWnd, 0 ), ;
                           ::nId, @hHeap, ::nExStyle )
    else
      ::hWnd = MGetCreate( cClsName, ::cCaption, ::nStyle, ;
                           ::nLeft, ::nTop, ::nRight, ::nBottom, ;
                           If( ::oWnd != nil, ::oWnd:hWnd, 0 ), ;
                           ::nId, @hHeap, ::nExStyle )
    endif

   if ::hWnd == 0
      WndCreateError( Self )
   else
      ::Link()
      if ::oFont != nil
         ::SetFont( ::oFont )
      endif
      ::hHeap = hHeap
   endif

return nil

//----------------------------------------------------------------------------//

METHOD Cut() CLASS TMultiGet

   if ::lReadOnly
      MsgAlert( "The get is read only!", "Can't cut" )
      return nil
   endif

   ::SendMsg( WM_CUT )
   Eval( ::bSetGet, ::GetText() )

   // EMW - the text has been changed!
   if ::bChange != nil
       Eval( ::bChange,,, Self )
   endif

return nil

//*** EMW - Added method to delete selected text without affecting clipboard
//---------------------------------------------------------------------------//

METHOD Del() CLASS TMultiGet

   if ::lReadOnly
      MsgAlert( "The get is read only!", "Can't delete" )
      return nil
   endif

   ::SendMsg( WM_CLEAR )
   Eval( ::bSetGet, ::GetText() )

   if ::bChange != nil
       Eval( ::bChange,,, Self )
   endif

return nil
//*** EMW - End of addition

//----------------------------------------------------------------------------//

METHOD DelLine( nLine ) CLASS TMultiGet

   DEFAULT nLine := ::GetRow()

   ::SendMsg( EM_SETSEL, .f.,;
              nMakeLong( ::SendMsg( EM_LINEINDEX, nLine - 1 ),;
                         ::SendMsg( EM_LINEINDEX, nLine ) ) )
   ::Cut()
   Eval( ::bSetGet, ::GetText()  )

   // EMW - the text has been changed!
   if ::bChange != nil
       Eval( ::bChange,,, Self )
   endif

return nil

//---------------------------------------------------------------------------//

METHOD Destroy() CLASS TMultiGet

   if ::hHeap != 0
      // LocalShrink( ::hHeap, 0 )
      ::hHeap = 0
   endif

return ::Super:Destroy()

//---------------------------------------------------------------------------//

METHOD DlgGoLine() CLASS TMultiGet

   local oDlgGoLine, nLine := ::GetRow()

   DEFINE DIALOG oDlgGoLine FROM 5,5 TO 10,29 TITLE "Go To"
   oDlgGoLine:lTruePixel := .f.

   @ 0.5, 2 SAY "Line:" OF oDlgGoLine
   @ 0.5, 5 GET nLine OF oDlgGoLine PICTURE "99999" SIZE 25, 11

   @ 1.3, 2 BUTTON "&Ok"  OF oDlgGoLine SIZE 32, 11 ;
      ACTION ( ::GoTo( nLine ), oDlgGoLine:End() ) DEFAULT

   @ 1.3, 9.5 BUTTON "&Cancel" OF oDlgGoLine SIZE 32, 11 ;
      ACTION oDlgGoLine:End()

   ACTIVATE DIALOG oDlgGoLine CENTERED

return nil

//---------------------------------------------------------------------------//

METHOD GetSel() CLASS TMultiGet

   local n      := ::SendMsg( EM_GETSEL )
   local nStart := nLoWord( n )
   local nEnd   := nHiWord( n )

   if ::lUnicode
      return If( nStart != nEnd, HB_UTF8SUBSTR( ::cText, nStart + 1, nEnd - nStart ), "" )
   endif

return If( nStart != nEnd, SubStr( ::cText, nStart + 1, nEnd - nStart ), "" )

//----------------------------------------------------------------------------//

METHOD GetSelPos( nStart, nEnd ) CLASS TMultiGet

   local n := ::SendMsg( EM_GETSEL )
   nStart  := nLoWord( n )
   nEnd    := nHiWord( n )

return nil

//----------------------------------------------------------------------------//

METHOD GetRow() CLASS TMultiGet

return ::SendMsg( EM_LINEFROMCHAR,;
                  nLoWord( ::SendMsg( EM_GETSEL ) ) ) + 1

//----------------------------------------------------------------------------//

METHOD GetCol() CLASS TMultiGet

return nLoWord( ::SendMsg( EM_GETSEL ) ) - ;
       ::SendMsg( EM_LINEINDEX, ::GetRow() -1 , 0 ) + 1

//----------------------------------------------------------------------------//

METHOD LButtonDown( nRow, nCol, nFlags, lTouch ) CLASS TMultiGet

   ::nPos = nLoWord( ::PostMsg( EM_GETSEL ) )

return ::Super:LButtonDown( nRow, nCol, nFlags, lTouch )

//----------------------------------------------------------------------------//

METHOD LButtonUp( nRow, nCol, nFlags ) CLASS TMultiGet

   if ::lDrag
      ::Super:LButtonUp( nRow, nCol, nFlags )
      SysRefresh()
      ::Refresh()
      return 0
   endif

return ::Super:LButtonUp( nRow, nCol, nFlags )

//----------------------------------------------------------------------------//

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TMultiGet

   if ::lDrag
      return ::Super:MouseMove( nRow, nCol, nKeyFlags )
   else
      ::oWnd:SetMsg( ::cMsg )
      if ::oCursor != nil
         SetCursor( ::oCursor:hCursor )
      else
         CursorIBeam()
      endif

      ::CheckToolTip()

      if ::bMMoved != nil
         Eval( ::bMMoved, nRow, nCol, nKeyFlags )
      endif
   endif

return nil      // We want standard MultiLine Get behavior !!!

//---------------------------------------------------------------------------//

METHOD KeyDown( nKey, nFlags ) CLASS TMultiGet

   do case
      case ( nKey == VK_INSERT .and. GetKeyState( VK_SHIFT ) ) .or. ;
           ( nKey == ASC("V") .and. GetKeyState( VK_CONTROL ) ) .or. ;
           ( nKey == ASC('X') .and. GetKeyState( VK_CONTROL ) )

          if !::lReadOnly
             CallWindowProc( ::nOldProc, ::hWnd, WM_KEYDOWN, nKey, nFlags )
             if ::bChange != nil
                Eval( ::bChange, nKey, nFlags, Self )
             endif
          endif

          return 0

      case nKey == VK_DELETE
           if ::lReadOnly
              return 0
           endif
           if ::bChange != nil
              Eval( ::bChange, nKey, nFlags, Self )
           endif
   endcase

return ::Super:KeyDown( nKey, nFlags )

//---------------------------------------------------------------------------//

METHOD KeyChar( nKey, nFlags ) CLASS TMultiGet

   local bKeyAction := SetKey( nKey )

   if bKeyAction != nil .and. lAnd( nFlags, 16777216 ) // function Key
      Eval( bKeyAction, ProcName( 4 ), ProcLine( 4 ), Self )
      return 0         // Already processed, API do nothing
   endif

   if ::lReadOnly
      if nKey == VK_RETURN
         ::oWnd:GoNextCtrl( ::hWnd )
      endif
      return 0
   endif

   if nKey == VK_RETURN .and. ;
      lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), ES_WANTRETURN )
      ::oWnd:nLastKey = 0
      if ::bChange != nil
         Eval( ::bChange, nKey, nFlags, Self )
      endif
      return nil
   endif

   if nKey == VK_TAB
      return ::Super:KeyChar( nKey, nFlags )
   endif

   if !::lReadOnly
      CallWindowProc( ::nOldProc, ::hWnd, WM_CHAR, nKey, nFlags )
      Eval( ::bSetGet, ::GetText() )
      if ::bChange != nil
         Eval( ::bChange, nKey, nFlags, Self )
      endif
      return 0
   endif

return ::Super:KeyChar( nKey, nFlags )

//---------------------------------------------------------------------------//

METHOD Paint() CLASS TMultiGet

   local aInfo := ::DispBegin()

   if ! Empty( ::bColor )
      tmp = ::aColor
      ::nClrText = tmp[ 1 ]
      ::nClrPane = tmp[ 2 ]
      if ! Empty( ::oBrush )
         ::oBrush:End()
      endif  
      ::oBrush = TBrush():New( , ::nClrPane )
   endif      

   if ::oBrush != nil
      FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
   else
      CallWindowProc( ::nOldProc, ::hWnd, WM_ERASEBKGND, ::hDC, 0 )
   endif

   CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hDC, 0 )

   if ValType( ::bPainted ) == "B"
      Eval( ::bPainted, ::hDC, ::cPS, Self )
   endif

   ::DispEnd( aInfo )

return 1

//----------------------------------------------------------------------------//


METHOD Paste( cText ) CLASS TMultiGet

   local oClp, cFile

   #ifdef __XPP__
      #undef New
   #endif

   DEFINE CLIPBOARD oClp OF Self FORMAT TEXT

   if Empty( cText ) .and. GetClipContentFormat( 15 ) == 15
      cFile    := oClp:GetFiles()[ 1 ]
      cText    := MEMOREAD( cFile )
      if IsBinaryData( cText )
         cText := cFile
      endif
   endif

   if ! Empty( cText )
      oClp:SetText( cText )
   endif

   ::SendMsg( WM_PASTE )
   Eval( ::bSetGet, ::GetText() )

   if ::bChange != nil
       Eval( ::bChange,,, Self )
   endif

   oClp:End()

return nil

//----------------------------------------------------------------------------//

METHOD RButtonDown( nRow, nCol, nFlags ) CLASS TMultiGet

   local oMenu, oClp

   if GetFocus() != ::hWnd
      ::SetFocus()
      SysRefresh()            // In case there is a VALID somewhere
      if GetFocus() != ::hWnd
         return nil
      endif
   endif

   #ifdef __XPP__
      #undef New
   #endif

   if ::bRClicked != nil
      return Eval( ::bRClicked, nRow, nCol, nFlags )
   endif

   DEFINE CLIPBOARD oClp OF Self FORMAT TEXT

   MENU oMenu POPUP
      MENUITEM FWString( "&Undo" ) ACTION ( oMenuItem, ::UnDo() ) WHEN ( oMenuItem, ::SendMsg( EM_CANUNDO ) != 0 )
      SEPARATOR
      MENUITEM FWString( "Cu&t" ) ACTION ( oMenuItem, ::Cut() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) .and. !::lReadOnly )
      MENUITEM FWString( "&Copy" ) ACTION ( oMenuItem, ::Copy() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) )
//      MENUITEM FWString( "&Paste" ) ACTION ( oMenuItem, ::Paste() ) WHEN ( oMenuItem, ! Empty( oClp:GetText() ) .and. !::lReadOnly )
      MENUITEM FWString( "&Paste" ) ACTION ( oMenuItem, ::Paste() ) WHEN ( oMenuItem, GetClipContentFormat( 13, 1, 15 ) > 0 .and. !::lReadOnly )
      MENUITEM FWString( "&Delete" ) ACTION ( oMenuItem, ::Del() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) .and. !::lReadOnly )
      if Upper( ::ClassName() ) == "TRICHEDIT"
         SEPARATOR
         MENUITEM FWString( "&Font" ) ACTION ( oMenuItem, ::SetCharFormat() )
      endif
      SEPARATOR
      MENUITEM FWString( "P&rint" ) ACTION ( oMenuItem, ::Print() )
      SEPARATOR
      MENUITEM FWString( "Select &All" ) ACTION ( oMenuItem, ::SelectAll() )
   ENDMENU

   oClp:End()

   ACTIVATE POPUP oMenu AT nRow - 60, nCol OF Self

return 0             // Message already processed

//----------------------------------------------------------------------------//

METHOD GotFocus() CLASS TMultiGet

   ::Super:GotFocus()

   // ::SetPos( ::nPos )
   CallWindowProc( ::nOldProc, ::hWnd, WM_SETFOCUS )

   if Set( _SET_INSERT )
      DestroyCaret()
      CreateCaret( ::hWnd, 0, If( ::lChangeCaret, 6, 1 ),;
                   ::nGetChrHeight() )
      ShowCaret( ::hWnd )
   endif

    if ::lClrFocus
       ::nOldClrPane = ::nClrPane
       ::SetColor( ::nClrText,;
          If( ValType( ::nClrFocus ) == "B", Eval( ::nClrFocus ), ::nClrFocus ) )
    else
       if ! Empty( ::bColor )
          tmp = ::aColor
          ::nClrText = tmp[ 1 ]
          ::nClrPane = tmp[ 2 ]
          ::oBrush:End()
          ::oBrush = TBrush():New( , ::nClrPane )
          ::Refresh()
       endif          
    endif

return 0

//----------------------------------------------------------------------------//

METHOD LostFocus( hCtlFocus ) CLASS TMultiGet

   ::Super:LostFocus( hCtlFocus )

   if ::bSetGet != nil
      Eval( ::bSetGet, ::GetText()  )
   endif

   ::nPos = nLoWord( ::SendMsg( EM_GETSEL ) )

   if ::lClrFocus
      if ::nOldClrPane != nil
         ::SetColor( ::nClrText, ::nOldClrPane )
      endif
   else
      if ! Empty( ::bColor )
         tmp = ::aColor
         ::nClrText = tmp[ 1 ]
         ::nClrPane = tmp[ 2 ]
         ::oBrush:End()
         ::oBrush = TBrush():New( , ::nClrPane )
         ::Refresh()
        ::Refresh()
     endif      
   endif

return nil

//----------------------------------------------------------------------------//

METHOD Default() CLASS TMultiGet

return nil

//---------------------------------------------------------------------------//

METHOD Move( nTop, nLeft, nBottom, nRight, lRepaint ) CLASS TMultiGet

   ::Super:Move( nTop, nLeft, nBottom, nRight, lRepaint )
   MoveGet( ::hWnd )

return nil

//----------------------------------------------------------------------------//

METHOD SetCoors( oRect ) CLASS TMultiGet

   ::Super:SetCoors( oRect )
   MoveGet( ::hWnd )

return nil

//----------------------------------------------------------------------------//

METHOD Print() CLASS TMultiGet

   local oPrn, oFont
   local nRowStep
   local nRow := 0, nCol := 0, n, n1 := 0
   local nLines := ::GetLineCount()

   PRINT oPrn  NAME "Notes"

      if Empty( oPrn:hDC )
         MsgStop( "Printer not ready!" )
         return self
      endif

      CursorWait()

      DEFINE FONT oFont NAME GetSysFont() SIZE 0, -11 OF oPrn

      nRowStep = oPrn:nVertRes() / 60   // We want 60 rows

      PAGE
         for n = 1 to nLines  // rows
             oPrn:Say( nRow, nCol, ::GetLine( n ), oFont )
             nRow += nRowStep
             n1 ++
             IF n1 == 60
                nRow := 0
                n1 := 0
                ENDPAGE
                PAGE
             ENDIF
         next
      ENDPAGE
   ENDPRINT

   oFont:End()      // Destroy the font object
   CursorArrow()

return nil

//----------------------------------------------------------------------------//

METHOD SetColorFocus( nClrFocus ) CLASS TMultiGet

   local nOldClrFocus := ::nClrFocus

   ::lClrFocus = .T.

   if nClrFocus != nil
      ::nClrFocus = nClrFocus
   endif

return nOldClrFocus

//----------------------------------------------------------------------------//

function SetMGetColorFocus( nClrFocus )

return TMultiGet():SetColorFocus( nClrFocus )

//----------------------------------------------------------------------------//
 

Re: Multiget con color cuando esta deshabilitado

PostPosted: Tue Apr 16, 2024 1:03 am
by carlos vargas
funciono ok, antonio, ya quedaria lo del color del texto en disable.

Re: Multiget con color cuando esta deshabilitado

PostPosted: Tue Apr 16, 2024 4:59 am
by Antonio Linares
Carlos,

Esta versión parece funcionar bien. Te adjunto el ejemplo modificado para ver mejor el comportamiento.

Gracias por tus pruebas

getclr.prg
Code: Select all  Expand view
#include "FiveWin.ch"

function Main()

    local oDlg, oGet1, oGet3
    local cTest1, cTest2, cTest3, cTest4

    cTest1 := cTest2 := cTest3 := cTest4 := PadR( "Hello world" + CRLF + CRLF + "another", 30 )

    TGet():bColorBlock := { |oGet| If( oGet:lFocused, { CLR_WHITE, CLR_GREEN },;
                                   If( ! oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }
    TMultiGet():bColorBlock := { |oGet| If( oGet:lFocused, { CLR_WHITE, CLR_GREEN },;
                                        If( ! oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }

    DEFINE DIALOG oDlg SIZE 500, 300

    @ 1, 1 GET oGet1 VAR cTest1

    @ 2, 1 GET cTest2

    @ 3, 1 GET oGet3 VAR cTest3 MULTILINE SIZE 240, 30

    @ 6, 1 GET cTest4 MULTILINE SIZE 240, 30

    ACTIVATE DIALOG oDlg CENTERED ;
        ON INIT ( oGet1:Disable(), oGet3:Disable(), .T. )

return nil    

mget.prg
Code: Select all  Expand view
#include "FiveWin.ch"
#include "Constant.ch"
#include "Set.ch"
#include "print.ch"

#ifdef __CLIPPER__
   #define EM_GETSEL       (WM_USER+0)
   #define EM_SETSEL       (WM_USER+1)
   #define EM_UNDO         (WM_USER+23)
   #define EM_LINEFROMCHAR (WM_USER+25)
   #define EM_GETLINECOUNT (WM_USER+10)
   #define EM_LINEINDEX    (WM_USER+11)
   #define EM_CANUNDO      (WM_USER+22)
#else
   #define EM_GETSEL               176
   #define EM_SETSEL               177
   #define EM_UNDO                 199
   #define EM_LINEFROMCHAR         201
   #define EM_LINESCROLL           182
   #define EM_GETLINECOUNT         186
   #define EM_LINEINDEX            187
   #define EM_CANUNDO              198

   #ifdef __XPP__
      #define ::Super  ::TControl
      #define New    _New
      #define GetNew _GetNew
      #define GetDelSel _GetDelSel
   #endif
#endif

#define COLOR_WINDOW              5
#define COLOR_WINDOWTEXT          8

#define ES_CENTER                 1

#define WM_ERASEBKGND            20
#define WM_SETFONT               48
#define WM_CUT                  768   //  0x300
#define WM_PASTE                770   //  0x302
#define WM_CLEAR                771   //  0x303

#define CW_USEDEFAULT         32768

#define GWL_STYLE             ( -16)

#define EM_LIMITTEXT            197
#define EM_SCROLLCARET        ( WM_USER + 49 )

#define WS_EX_CLIENTEDGE        512

#define EM_SETLIMITTEXT      0x00C5

#define ETO_OPAQUE                2
#define ETO_CLIPPED               4
#define TRANSPARENT               1

#define DT_WORDBREAK             16
#define DT_CALCRECT            1024

static tmp

//----------------------------------------------------------------------------//

CLASS TMultiGet FROM TControl

   DATA   lReadOnly
   DATA   nPos
   DATA   hHeap
   DATA   nOldClrPane // Old background color, if color changed with focus

   DATA bColor
   ACCESS aColor INLINE ( tmp := Eval( ::bColor, Self ), If( HB_ISARRAY( tmp ), AClone( tmp ), { tmp, ::nClrPane } ) )

   CLASSDATA lClrFocus  INIT .F. // change GET color when focused
   CLASSDATA nClrFocus  INIT nRGB( 235, 235, 145 ) // color to use when GET is focused and lClrFocus is .T.

   CLASSDATA lChangeCaret INIT .T.
   CLASSDATA bColorBlock

   METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, oFont, lHScroll,;
               nClrFore, nClrBack, oCursor, lPixel, cMsg, lUpdate,;
               bWhen, lCenter, lRight, lReadOnly, bValid, bChanged,;
               lDesign, lNoBorder, lNoVScroll ) CONSTRUCTOR

   METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, nClrFore, nClrBack, oFont,;
                    oCursor, cMsg, lUpdate, bWhen, lReadOnly, bValid,;
                    bChanged ) CONSTRUCTOR

   METHOD AdjClient() INLINE ::Super:AdjClient(), MoveGet( ::hWnd )

   #ifndef __HARBOUR__
      METHOD Append( cText, nLen ) INLINE ;
                     nLen := ::Len()  ,;
                     SendMessage( ::hWnd, EM_SETSEL, 0,;
                                  nMakeLong( nLen, nLen ) ),;
                     ::Replace( cText )
   #else
      METHOD Append( cText, nLen ) INLINE ;
                     nLen := ::Len()  ,;
                     SendMessage( ::hWnd, EM_SETSEL, nLen, nLen ),;
                     ::Replace( cText )
   #endif

   METHOD cToChar() INLINE  ::Super:cToChar( "EDIT" )

   METHOD Copy()

   METHOD Create( cClsName )

   METHOD Cut()

   METHOD Del()

   METHOD Default()

   METHOD DelLine( nLine )

   METHOD Destroy()

   #ifndef __C3__
      METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 1
   #endif

   METHOD DlgGoLine()

   METHOD EraseBkGnd() INLINE 1

   METHOD Find( cText ) INLINE  DlgFindText( cText, Self )

   METHOD GetLine( nLine ) INLINE MGetLine( ::hWnd, nLine )

   METHOD GetLineCount() INLINE SendMessage( ::hWnd, EM_GETLINECOUNT )

   METHOD GotFocus()

   METHOD GetRow()
   METHOD GetCol()

   #ifdef __CLIPPER__
      METHOD GoBottom() INLINE ::SetPos( Len( AllTrim( ::GetText() ) ) + 1 )
   #else
      METHOD GoBottom() INLINE ( ::SetPos( Len( AllTrim( ::GetText() ) ) + 1 ),;
                                 ::SendMsg( EM_LINESCROLL, 0, ::GetLineCount() ) )
   #endif

   METHOD GoTo( nLine ) INLINE ;
                ::SetPos( SendMessage( ::hWnd, EM_LINEINDEX, nLine, 0 ) )

   METHOD HideSel() INLINE ::SetSel( -1, 0 )

   METHOD Initiate( hDlg )

   METHOD LButtonDown( nRow, nCol, nFlags, lTouch )

   METHOD LButtonUp( nRow, nCol, nFlags )

   METHOD Len() INLINE GetWinTxtLenght( ::hWnd )

   // Call this method to use unlimited text size
   METHOD LimitText( nChars ) INLINE SendMessage( ::hWnd, EM_LIMITTEXT, If( Empty( nChars ), 0, nChars ), 0 )

   METHOD LineIndex( nLine ) INLINE ::SendMsg( EM_LINEINDEX, nLine )

   METHOD LostFocus( hCtlFocus )

   METHOD MouseMove( nRow, nCol, nKeyFlags )

   METHOD Move( nTop, nLeft, nBottom, nRight, lRepaint )

   METHOD cText( cText ) SETGET

   METHOD Paint()

   METHOD Paste( cText )

   METHOD Print()

   METHOD RButtonDown( nRow, nCol, nFlags )

   METHOD Refresh() BLOCK { | Self, nStart, nEnd | ::GetSelPos( @nStart, @nEnd ),;
                          ::SetText( cValToChar( Eval( ::bSetGet ) ) ),;
                          ::SetPos( nStart, nEnd ) }

   METHOD Replace( cText ) INLINE ;
                           MGetReplace( ::hWnd, cText ),;
                           Eval( ::bSetGet, ::GetText() )

   METHOD SaveToFile( cFileName ) INLINE MemoWrit( cFileName, ::GetText() )

   METHOD SelectAll() INLINE ::SetSel( 0, -1 )

   METHOD SetCoors( oRect )

   #ifdef __CLIPPER__
   METHOD SetSel( nStart, nEnd ) INLINE ;
                  nStart := If( nStart == nil, 1, nStart ),;
                  nEnd   := If( nEnd == nil, nStart, nEnd ),;
                  SendMessage( ::hWnd, EM_SETSEL, 0,;
                  nMakeLong( nStart - If( nStart > 0, 1, 0 ),;
                  nEnd - If( nEnd > 0, 1, 0 ) ) ),;
                  ::nPos := nStart
   #else
   METHOD SetSel( nStart, nEnd ) INLINE ;
                  nStart := If( nStart == nil, 1, nStart ),;
                  nEnd   := If( nEnd == nil, nStart, nEnd ),;
                  SendMessage( ::hWnd, EM_SETSEL, nStart, nEnd ),;
                  ::nPos := nStart
   #endif

   METHOD VScroll( nWParam, nLParam ) VIRTUAL

   METHOD HScroll( nWParam, nLParam ) VIRTUAL

   METHOD GetSel()
   METHOD GetSelPos( nStart, nEnd )

   METHOD KeyChar( nKey, nFlags )

   METHOD KeyDown( nKey, nFlags )

   METHOD SetColorFocus( nClrFocus )

   #ifdef __CLIPPER__
   METHOD SetPos( nStart, nEnd ) INLINE ;
                 nEnd := If( nEnd == nil, nStart, nEnd ),;
                 ::SendMsg( EM_SETSEL, 0, nMakeLong( nStart, nEnd ) ),;
                 ::nPos := nStart
   #else
   METHOD SetPos( nStart, nEnd ) INLINE ;
                 nEnd := If( nEnd == nil, nStart, nEnd ),;
                 ::SendMsg( EM_SETSEL, nStart, nEnd ),;
                 ::nPos := nStart,;
                 SendMessage(::hWnd, EM_SCROLLCARET, 0, 0)
   #endif

   METHOD UnDo() INLINE ::SendMsg( EM_UNDO ),;
                        Eval( ::bSetGet, ::GetText() )

ENDCLASS

//----------------------------------------------------------------------------//

METHOD New( nRow, nCol, bSetGet, oWnd, nWidth, nHeight, oFont, lHScroll,;
            nClrFore, nClrBack, oCursor, lPixel, cMsg, lUpdate,;
            bWhen, lCenter, lRight, lReadOnly, bValid, bChanged,;
            lDesign, lNoBorder, lNoVScroll ) CLASS TMultiGet

   DEFAULT lHScroll   := .f.,;
           nClrFore   := GetSysColor( COLOR_WINDOWTEXT ),;
           nClrBack   := GetSysColor( COLOR_WINDOW ),;
           lPixel     := .f., lUpdate := .f.,;
           lCenter    := .f., lRight := .f.,;
           lReadOnly  := .f., lDesign := .f.,;
           oWnd       := GetWndDefault(),;
           nRow       := 0, nCol := 0,;
           lNoVScroll := .f., lNoBorder := .f.

   ::lUnicode  = FW_SetUnicode()
   if bSetGet != nil
      ::cCaption = cValToChar( Eval( bSetGet ) )
   else
      ::cCaption = ""
   endif

   ::nTop     = nRow * If( lPixel, 1, MGET_CHARPIX_H )  //13
   ::nLeft    = nCol * If( lPixel, 1, MGET_CHARPIX_W )   // 8
   ::nBottom  = If( nHeight == nil, ::nTop + 11, ::nTop + nHeight )
   ::nRight   = If( nWidth == nil, ::nLeft + Len( ::cCaption ) * 3.5, ;
                    ::nLeft + nWidth )
   ::bSetGet  = bSetGet
   ::uOriginalValue = Eval( ::bSetGet )
   ::oWnd     = oWnd
   ::nStyle   = nOR( WS_CHILD, WS_VISIBLE, ES_LEFT,;
                     ES_WANTRETURN, ES_MULTILINE,;
                     If( ! lReadOnly, WS_TABSTOP, 0 ),;
                     If( ! lNoVScroll, WS_VSCROLL, 0 ),;
                     If( lDesign, WS_CLIPSIBLINGS, 0 ),;
                     If( lHScroll, WS_HSCROLL, 0 ),;
                     If( lCenter, ES_CENTER, If( lRight, ES_RIGHT, ES_LEFT ) ) )

   #ifdef __CLIPPER__
      if ! lNoBorder
         ::nStyle = nOr( ::nStyle, WS_BORDER )
      endif
   #else
      if ! IsAppThemed()
         if ! lNoBorder
            ::nStyle = nOr( ::nStyle, WS_BORDER )
         endif
      else
         if ! lNoBorder
            ::nStyle = nOr( ::nStyle, If( oWnd:IsKindOf( "TDIALOG" ), WS_BORDER, 0 ) )
            ::nExStyle = WS_EX_CLIENTEDGE
         endif
      endif
   #endif

   ::nId       = ::GetNewId()
   ::cCaption  = RTrim( ::cCaption )
   ::lDrag     = lDesign
   ::lCaptured = .f.
   ::oCursor   = oCursor
   if oFont != nil
      oFont:nCount++
      ::oFont     = oFont
   endif
   ::cMsg      = cMsg
   ::lUpdate   = lUpdate
   ::bWhen     = bWhen
   ::bValid    = bValid
   ::lReadOnly = lReadOnly
   ::nPos      = 0
   ::bChange   = bChanged

   if ! Empty( oWnd:hWnd )
      ::cCaption  := Left( ::cCaption, 20000 )
      ::Create( "EDIT" )
      ::LimitText( 0 )
      if Len( ::cCaption ) == 20000
         ::SetText( cValToChar( Eval( ::bSetGet ) ) )
      endif
/*
      if ::oFont != nil .or. ::oWnd:oFont != nil
         PostMessage( ::hWnd, WM_SETFONT,;
                      If( oFont != nil, oFont:hFont,;
                          ::oWnd:oFont:hFont ) )
      endif
*/
      if ::oFont == nil
         ::GetFont()
      else
         ::SetFont( ::oFont )
      endif
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

   ::GetFont()

   DEFAULT ::bColor := ::bColorBlock

   if Empty( ::bColor )
      ::SetColor( ::nClrText, nClrBack )
   else
      tmp = ::aColor
      ::nClrText = tmp[ 1 ]
      ::nClrPane = tmp[ 2 ]
      ::oBrush = TBrush():New( , ::nClrPane )
      ::Refresh()
   endif      

   if lDesign
      ::CheckDots()
   endif

   ::SendMsg( EM_SETLIMITTEXT, -1 ) // Unlimited text length

return Self

//----------------------------------------------------------------------------//

METHOD ReDefine( nId, bSetGet, oWnd, nHelpId, nClrFore, nClrBack, oFont,;
             oCursor, cMsg, lUpdate, bWhen, lReadOnly, bValid, bChanged ) CLASS TMultiGet

   DEFAULT nClrFore := GetSysColor( COLOR_WINDOWTEXT ),;
           nClrBack := GetSysColor( COLOR_WINDOW ),;
           lUpdate  := .f., lReadOnly := .f.,;
           oWnd     := GetWndDefault()

   ::lUnicode  = FW_SetUnicode()
   ::nId       = nId
   ::bSetGet   = bSetGet
   ::uOriginalValue = Eval( ::bSetGet )
   ::oWnd      = oWnd
   ::nHelpId   = nHelpId
   ::lDrag     = .f.
   ::lCaptured = .f.
   if oFont != nil
      oFont:nCount++
      ::oFont     = oFont
   endif
   ::oCursor   = oCursor
   ::cMsg      = cMsg
   ::lUpdate   = lUpdate
   ::bWhen     = bWhen
   ::bValid    = bValid
   ::lReadOnly = lReadOnly
   ::nPos      = 0
   ::bChange   = bChanged

   DEFAULT ::bColor := ::bColorBlock

   if Empty( ::bColor )
      ::SetColor( nClrFore, nClrBack )
   else
      tmp = ::aColor
      ::nClrText = tmp[ 1 ]
      ::nClrPane = tmp[ 2 ]
      ::oBrush = TBrush():New( , ::nClrPane )
   endif      

   oWnd:DefControl( Self )

return Self

//----------------------------------------------------------------------------//

METHOD Initiate( hDlg ) CLASS TMultiGet

   ::LimitText()
   ::Super:Initiate( hDlg )
   ::SetText( cValToChar( Eval( ::bSetGet ) ) )
   ::Default()

return nil

//----------------------------------------------------------------------------//

METHOD cText( cText ) CLASS TMultiGet

   if PCount() == 1
      ::SetText( cText )
      Eval( ::bSetGet, cText )
   endif

return ::GetText()

//----------------------------------------------------------------------------//

METHOD Copy() CLASS TMultiGet

   local oClp

   #ifdef __XPP__
      #undef New
   #endif

   DEFINE CLIPBOARD oClp OF Self ;
      FORMAT TEXT

   if oClp:Open()
      oClp:Clear()
      oClp:SetText( ::GetSel() )
      oClp:End()
   else
      MsgAlert( "The clipboard is not available now!" )
   endif

return nil

//---------------------------------------------------------------------------//

METHOD Create( cClsName ) CLASS TMultiGet

   local hHeap

   DEFAULT cClsName := ::ClassName(), ::cCaption := "",;
           ::nStyle := WS_OVERLAPPEDWINDOW,;
           ::nTop   := 0, ::nLeft := 0, ::nBottom := 10, ::nRight := 10,;
           ::nId    := 0

   if ::oWnd != nil
      ::nStyle = nOR( ::nStyle, WS_CHILD )
   endif

   if ::nBottom != CW_USEDEFAULT
      ::hWnd = MGetCreate( cClsName, ::cCaption, ::nStyle, ;
                           ::nLeft, ::nTop, ::nRight - ::nLeft + 1, ;
                           ::nBottom - ::nTop + 1, ;
                           If( ::oWnd != nil, ::oWnd:hWnd, 0 ), ;
                           ::nId, @hHeap, ::nExStyle )
    else
      ::hWnd = MGetCreate( cClsName, ::cCaption, ::nStyle, ;
                           ::nLeft, ::nTop, ::nRight, ::nBottom, ;
                           If( ::oWnd != nil, ::oWnd:hWnd, 0 ), ;
                           ::nId, @hHeap, ::nExStyle )
    endif

   if ::hWnd == 0
      WndCreateError( Self )
   else
      ::Link()
      if ::oFont != nil
         ::SetFont( ::oFont )
      endif
      ::hHeap = hHeap
   endif

return nil

//----------------------------------------------------------------------------//

METHOD Cut() CLASS TMultiGet

   if ::lReadOnly
      MsgAlert( "The get is read only!", "Can't cut" )
      return nil
   endif

   ::SendMsg( WM_CUT )
   Eval( ::bSetGet, ::GetText() )

   // EMW - the text has been changed!
   if ::bChange != nil
       Eval( ::bChange,,, Self )
   endif

return nil

//*** EMW - Added method to delete selected text without affecting clipboard
//---------------------------------------------------------------------------//

METHOD Del() CLASS TMultiGet

   if ::lReadOnly
      MsgAlert( "The get is read only!", "Can't delete" )
      return nil
   endif

   ::SendMsg( WM_CLEAR )
   Eval( ::bSetGet, ::GetText() )

   if ::bChange != nil
       Eval( ::bChange,,, Self )
   endif

return nil
//*** EMW - End of addition

//----------------------------------------------------------------------------//

METHOD DelLine( nLine ) CLASS TMultiGet

   DEFAULT nLine := ::GetRow()

   ::SendMsg( EM_SETSEL, .f.,;
              nMakeLong( ::SendMsg( EM_LINEINDEX, nLine - 1 ),;
                         ::SendMsg( EM_LINEINDEX, nLine ) ) )
   ::Cut()
   Eval( ::bSetGet, ::GetText()  )

   // EMW - the text has been changed!
   if ::bChange != nil
       Eval( ::bChange,,, Self )
   endif

return nil

//---------------------------------------------------------------------------//

METHOD Destroy() CLASS TMultiGet

   if ::hHeap != 0
      // LocalShrink( ::hHeap, 0 )
      ::hHeap = 0
   endif

return ::Super:Destroy()

//---------------------------------------------------------------------------//

METHOD DlgGoLine() CLASS TMultiGet

   local oDlgGoLine, nLine := ::GetRow()

   DEFINE DIALOG oDlgGoLine FROM 5,5 TO 10,29 TITLE "Go To"
   oDlgGoLine:lTruePixel := .f.

   @ 0.5, 2 SAY "Line:" OF oDlgGoLine
   @ 0.5, 5 GET nLine OF oDlgGoLine PICTURE "99999" SIZE 25, 11

   @ 1.3, 2 BUTTON "&Ok"  OF oDlgGoLine SIZE 32, 11 ;
      ACTION ( ::GoTo( nLine ), oDlgGoLine:End() ) DEFAULT

   @ 1.3, 9.5 BUTTON "&Cancel" OF oDlgGoLine SIZE 32, 11 ;
      ACTION oDlgGoLine:End()

   ACTIVATE DIALOG oDlgGoLine CENTERED

return nil

//---------------------------------------------------------------------------//

METHOD GetSel() CLASS TMultiGet

   local n      := ::SendMsg( EM_GETSEL )
   local nStart := nLoWord( n )
   local nEnd   := nHiWord( n )

   if ::lUnicode
      return If( nStart != nEnd, HB_UTF8SUBSTR( ::cText, nStart + 1, nEnd - nStart ), "" )
   endif

return If( nStart != nEnd, SubStr( ::cText, nStart + 1, nEnd - nStart ), "" )

//----------------------------------------------------------------------------//

METHOD GetSelPos( nStart, nEnd ) CLASS TMultiGet

   local n := ::SendMsg( EM_GETSEL )
   nStart  := nLoWord( n )
   nEnd    := nHiWord( n )

return nil

//----------------------------------------------------------------------------//

METHOD GetRow() CLASS TMultiGet

return ::SendMsg( EM_LINEFROMCHAR,;
                  nLoWord( ::SendMsg( EM_GETSEL ) ) ) + 1

//----------------------------------------------------------------------------//

METHOD GetCol() CLASS TMultiGet

return nLoWord( ::SendMsg( EM_GETSEL ) ) - ;
       ::SendMsg( EM_LINEINDEX, ::GetRow() -1 , 0 ) + 1

//----------------------------------------------------------------------------//

METHOD LButtonDown( nRow, nCol, nFlags, lTouch ) CLASS TMultiGet

   ::nPos = nLoWord( ::PostMsg( EM_GETSEL ) )

return ::Super:LButtonDown( nRow, nCol, nFlags, lTouch )

//----------------------------------------------------------------------------//

METHOD LButtonUp( nRow, nCol, nFlags ) CLASS TMultiGet

   if ::lDrag
      ::Super:LButtonUp( nRow, nCol, nFlags )
      SysRefresh()
      ::Refresh()
      return 0
   endif

return ::Super:LButtonUp( nRow, nCol, nFlags )

//----------------------------------------------------------------------------//

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TMultiGet

   if ::lDrag
      return ::Super:MouseMove( nRow, nCol, nKeyFlags )
   else
      ::oWnd:SetMsg( ::cMsg )
      if ::oCursor != nil
         SetCursor( ::oCursor:hCursor )
      else
         CursorIBeam()
      endif

      ::CheckToolTip()

      if ::bMMoved != nil
         Eval( ::bMMoved, nRow, nCol, nKeyFlags )
      endif
   endif

return nil      // We want standard MultiLine Get behavior !!!

//---------------------------------------------------------------------------//

METHOD KeyDown( nKey, nFlags ) CLASS TMultiGet

   do case
      case ( nKey == VK_INSERT .and. GetKeyState( VK_SHIFT ) ) .or. ;
           ( nKey == ASC("V") .and. GetKeyState( VK_CONTROL ) ) .or. ;
           ( nKey == ASC('X') .and. GetKeyState( VK_CONTROL ) )

          if !::lReadOnly
             CallWindowProc( ::nOldProc, ::hWnd, WM_KEYDOWN, nKey, nFlags )
             if ::bChange != nil
                Eval( ::bChange, nKey, nFlags, Self )
             endif
          endif

          return 0

      case nKey == VK_DELETE
           if ::lReadOnly
              return 0
           endif
           if ::bChange != nil
              Eval( ::bChange, nKey, nFlags, Self )
           endif
   endcase

return ::Super:KeyDown( nKey, nFlags )

//---------------------------------------------------------------------------//

METHOD KeyChar( nKey, nFlags ) CLASS TMultiGet

   local bKeyAction := SetKey( nKey )

   if bKeyAction != nil .and. lAnd( nFlags, 16777216 ) // function Key
      Eval( bKeyAction, ProcName( 4 ), ProcLine( 4 ), Self )
      return 0         // Already processed, API do nothing
   endif

   if ::lReadOnly
      if nKey == VK_RETURN
         ::oWnd:GoNextCtrl( ::hWnd )
      endif
      return 0
   endif

   if nKey == VK_RETURN .and. ;
      lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), ES_WANTRETURN )
      ::oWnd:nLastKey = 0
      if ::bChange != nil
         Eval( ::bChange, nKey, nFlags, Self )
      endif
      return nil
   endif

   if nKey == VK_TAB
      return ::Super:KeyChar( nKey, nFlags )
   endif

   if !::lReadOnly
      CallWindowProc( ::nOldProc, ::hWnd, WM_CHAR, nKey, nFlags )
      Eval( ::bSetGet, ::GetText() )
      if ::bChange != nil
         Eval( ::bChange, nKey, nFlags, Self )
      endif
      return 0
   endif

return ::Super:KeyChar( nKey, nFlags )

//---------------------------------------------------------------------------//

METHOD Paint() CLASS TMultiGet

   local aInfo := ::DispBegin(), nOldMode, hOldFont

   if ! Empty( ::bColor )
      tmp = ::aColor
      ::nClrText = tmp[ 1 ]
      ::nClrPane = tmp[ 2 ]
      if ! Empty( ::oBrush )
         ::oBrush:End()
      endif  
      ::oBrush = TBrush():New( , ::nClrPane )
   endif      

   if ::oBrush != nil
      FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
   else
      CallWindowProc( ::nOldProc, ::hWnd, WM_ERASEBKGND, ::hDC, 0 )
   endif

   if Empty( ::bColor ) .or. ::lActive
      CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hDC, 0 )
   else
      FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
      SetTextColor( ::hDC, ::nClrText )
      SetBkColor( ::hDC, ::nClrPane )
      if ::oFont != nil
         hOldFont = SelectObject( ::hDC, ::oFont:hFont )
      endif      
      nOldMode = SetBkMode( ::hDC, TRANSPARENT )
      DrawTextEx( ::hDC, GetWindowText( ::hWnd ),;
         { 2, 3, ::nHeight(), ::nWidth() }, DT_WORDBREAK )
      SetBkMode( ::hDC, nOldMode )
      if ::oFont != nil
         SelectObject( ::hDC, hOldFont )
      endif      
   endif      

   if ValType( ::bPainted ) == "B"
      Eval( ::bPainted, ::hDC, ::cPS, Self )
   endif

   ::DispEnd( aInfo )

return 1

//----------------------------------------------------------------------------//


METHOD Paste( cText ) CLASS TMultiGet

   local oClp, cFile

   #ifdef __XPP__
      #undef New
   #endif

   DEFINE CLIPBOARD oClp OF Self FORMAT TEXT

   if Empty( cText ) .and. GetClipContentFormat( 15 ) == 15
      cFile    := oClp:GetFiles()[ 1 ]
      cText    := MEMOREAD( cFile )
      if IsBinaryData( cText )
         cText := cFile
      endif
   endif

   if ! Empty( cText )
      oClp:SetText( cText )
   endif

   ::SendMsg( WM_PASTE )
   Eval( ::bSetGet, ::GetText() )

   if ::bChange != nil
       Eval( ::bChange,,, Self )
   endif

   oClp:End()

return nil

//----------------------------------------------------------------------------//

METHOD RButtonDown( nRow, nCol, nFlags ) CLASS TMultiGet

   local oMenu, oClp

   if GetFocus() != ::hWnd
      ::SetFocus()
      SysRefresh()            // In case there is a VALID somewhere
      if GetFocus() != ::hWnd
         return nil
      endif
   endif

   #ifdef __XPP__
      #undef New
   #endif

   if ::bRClicked != nil
      return Eval( ::bRClicked, nRow, nCol, nFlags )
   endif

   DEFINE CLIPBOARD oClp OF Self FORMAT TEXT

   MENU oMenu POPUP
      MENUITEM FWString( "&Undo" ) ACTION ( oMenuItem, ::UnDo() ) WHEN ( oMenuItem, ::SendMsg( EM_CANUNDO ) != 0 )
      SEPARATOR
      MENUITEM FWString( "Cu&t" ) ACTION ( oMenuItem, ::Cut() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) .and. !::lReadOnly )
      MENUITEM FWString( "&Copy" ) ACTION ( oMenuItem, ::Copy() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) )
//      MENUITEM FWString( "&Paste" ) ACTION ( oMenuItem, ::Paste() ) WHEN ( oMenuItem, ! Empty( oClp:GetText() ) .and. !::lReadOnly )
      MENUITEM FWString( "&Paste" ) ACTION ( oMenuItem, ::Paste() ) WHEN ( oMenuItem, GetClipContentFormat( 13, 1, 15 ) > 0 .and. !::lReadOnly )
      MENUITEM FWString( "&Delete" ) ACTION ( oMenuItem, ::Del() ) WHEN ( oMenuItem, ! Empty( ::GetSel() ) .and. !::lReadOnly )
      if Upper( ::ClassName() ) == "TRICHEDIT"
         SEPARATOR
         MENUITEM FWString( "&Font" ) ACTION ( oMenuItem, ::SetCharFormat() )
      endif
      SEPARATOR
      MENUITEM FWString( "P&rint" ) ACTION ( oMenuItem, ::Print() )
      SEPARATOR
      MENUITEM FWString( "Select &All" ) ACTION ( oMenuItem, ::SelectAll() )
   ENDMENU

   oClp:End()

   ACTIVATE POPUP oMenu AT nRow - 60, nCol OF Self

return 0             // Message already processed

//----------------------------------------------------------------------------//

METHOD GotFocus() CLASS TMultiGet

   ::Super:GotFocus()

   // ::SetPos( ::nPos )
   CallWindowProc( ::nOldProc, ::hWnd, WM_SETFOCUS )

   if Set( _SET_INSERT )
      DestroyCaret()
      CreateCaret( ::hWnd, 0, If( ::lChangeCaret, 6, 1 ),;
                   ::nGetChrHeight() )
      ShowCaret( ::hWnd )
   endif

    if ::lClrFocus
       ::nOldClrPane = ::nClrPane
       ::SetColor( ::nClrText,;
          If( ValType( ::nClrFocus ) == "B", Eval( ::nClrFocus ), ::nClrFocus ) )
    else
       if ! Empty( ::bColor )
          tmp = ::aColor
          ::nClrText = tmp[ 1 ]
          ::nClrPane = tmp[ 2 ]
          ::oBrush:End()
          ::oBrush = TBrush():New( , ::nClrPane )
          ::Refresh()
       endif          
    endif

return 0

//----------------------------------------------------------------------------//

METHOD LostFocus( hCtlFocus ) CLASS TMultiGet

   ::Super:LostFocus( hCtlFocus )

   if ::bSetGet != nil
      Eval( ::bSetGet, ::GetText()  )
   endif

   ::nPos = nLoWord( ::SendMsg( EM_GETSEL ) )

   if ::lClrFocus
      if ::nOldClrPane != nil
         ::SetColor( ::nClrText, ::nOldClrPane )
      endif
   else
      if ! Empty( ::bColor )
         tmp = ::aColor
         ::nClrText = tmp[ 1 ]
         ::nClrPane = tmp[ 2 ]
         ::oBrush:End()
         ::oBrush = TBrush():New( , ::nClrPane )
         ::Refresh()
        ::Refresh()
     endif      
   endif

return nil

//----------------------------------------------------------------------------//

METHOD Default() CLASS TMultiGet

return nil

//---------------------------------------------------------------------------//

METHOD Move( nTop, nLeft, nBottom, nRight, lRepaint ) CLASS TMultiGet

   ::Super:Move( nTop, nLeft, nBottom, nRight, lRepaint )
   MoveGet( ::hWnd )

return nil

//----------------------------------------------------------------------------//

METHOD SetCoors( oRect ) CLASS TMultiGet

   ::Super:SetCoors( oRect )
   MoveGet( ::hWnd )

return nil

//----------------------------------------------------------------------------//

METHOD Print() CLASS TMultiGet

   local oPrn, oFont
   local nRowStep
   local nRow := 0, nCol := 0, n, n1 := 0
   local nLines := ::GetLineCount()

   PRINT oPrn  NAME "Notes"

      if Empty( oPrn:hDC )
         MsgStop( "Printer not ready!" )
         return self
      endif

      CursorWait()

      DEFINE FONT oFont NAME GetSysFont() SIZE 0, -11 OF oPrn

      nRowStep = oPrn:nVertRes() / 60   // We want 60 rows

      PAGE
         for n = 1 to nLines  // rows
             oPrn:Say( nRow, nCol, ::GetLine( n ), oFont )
             nRow += nRowStep
             n1 ++
             IF n1 == 60
                nRow := 0
                n1 := 0
                ENDPAGE
                PAGE
             ENDIF
         next
      ENDPAGE
   ENDPRINT

   oFont:End()      // Destroy the font object
   CursorArrow()

return nil

//----------------------------------------------------------------------------//

METHOD SetColorFocus( nClrFocus ) CLASS TMultiGet

   local nOldClrFocus := ::nClrFocus

   ::lClrFocus = .T.

   if nClrFocus != nil
      ::nClrFocus = nClrFocus
   endif

return nOldClrFocus

//----------------------------------------------------------------------------//

function SetMGetColorFocus( nClrFocus )

return TMultiGet():SetColorFocus( nClrFocus )

//----------------------------------------------------------------------------//
 

Re: Multiget con color cuando esta deshabilitado

PostPosted: Fri Apr 19, 2024 11:29 pm
by carlos vargas
De 10 antonio, excelente.
los combobox si es posible, para que quede homogeneo.
Gracias.

Re: Multiget con color cuando esta deshabilitado

PostPosted: Mon Apr 22, 2024 11:58 am
by karinha
Estimado Carlos, ¿sería muy inconveniente pedir un ejemplo completo de cómo funciona multi GET? Nunca lo he usado y me gustaría aprender. Si te molesta, no te preocupes, es sólo curiosidad.

Tks,

Regards, saludos.

Re: Multiget con color cuando esta deshabilitado

PostPosted: Mon Apr 22, 2024 12:01 pm
by Antonio Linares
Estimado Joao,

En los mensajes anteriores en esta conversación tienes un ejemplo getclr.prg

Re: Multiget con color cuando esta deshabilitado

PostPosted: Mon Apr 22, 2024 1:59 pm
by karinha
Antonio Linares wrote:Estimado Joao,

En los mensajes anteriores en esta conversación tienes un ejemplo getclr.prg


https://imgur.com/rD0MTA1

Image

Tks,

Regards, saludos.

Re: Multiget con color cuando esta deshabilitado

PostPosted: Mon Apr 22, 2024 2:02 pm
by karinha
Mi querido Maestro Antônio, help-me, please!

Code: Select all  Expand view

// C:\MULTIGET\GETCLR2.PRG

#Include "FiveWin.ch" // Aparentemente TGET.PRG es mucho mejor.

FUNCTION Main()

   LOCAL oDlg, oGet1, oGet2, oGet3, oGet4, Test1, cTest2, cTest3, cTest4, ;
         oFont, oBtn, oSay, cSay, oSay2, cSay2, oSay3, cSay3, cTitle

   cTest1 := SPACE(  50 )
   cTest2 := SPACE(  50 )
   cTest3 := SPACE( 100 )
   cTest4 := SPACE( 100 )

   cTest1 := "Test de MULTIGET cTest1"
   cTest2 := "Test de MULTIGET cTest2"

   cTest3 := "Test de MULTIGET en cTest3 MGET.PRG        " + CRLF + ;
             "Otro Texto con MULTILINE en cTest3 MGET.PRG" + CRLF + ;
             "Otro Texto con MULTILINE en cTest3 MGET.PRG"

   cTest4 := "Test de MULTIGET cTest4 MGET.PRG           " + CRLF + ;
             "Otro Texto CON MULTILINE MGET.PRG"

   SkinButtons()

   cTitle := "FWH: TESTANDO MGET.PRG -> TGET.PRG ES MUCHO MEJOR(MAS COMPLETA)"

   // No me gusta esto, porque no es igual a la TGET.PRG - complicado usar esto.
   TGet():bColorBlock := {| oGet | IF( oGet:lFocused, { CLR_WHITE, CLR_GREEN }, ;
      IF( .NOT. oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }

   TMultiGet():bColorBlock := {| oGet | IF( oGet:lFocused, { CLR_WHITE, CLR_GREEN }, ;
      IF( .NOT. oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }

   DEFINE FONT oFont NAME "Verdana" SIZE 0,-14 BOLD

   DEFINE DIALOG oDlg SIZE 520, 354 TITLE cTitle COLOR CLR_BLACK, CLR_WHITE  ;
      TRANSPARENT

   oDlg:lHelpIcon := .F.

   @ 1, 1 GET oGet1 VAR cTest1 SIZE 130, 16 PICTURE "@!" OF oDlg FONT oFont  ;
      UPDATE // NOBORDER -> FUNCIONA SI. -> COLORS NO FUNCIONA. BAD.

   @ 2.3, 1 GET oGet2 VAR cTest2 SIZE 130, 16 PICTURE "@!" OF oDlg FONT oFont

   // PICTURE NO FUNCIONA CON MULTILINE.

   // Maestro Antonio:

   // ¿CÓMO SALTO DE UNA MULTILÍNEA PARA LLEGAR A LA OTRA?

   @ 3.5, 1 GET oGet3 VAR cTest3 MULTILINE SIZE 200, 30 OF oDlg FONT oFont

   // PICTURE NO FUNCIONA CON MULTILINE.
   @ 6.5, 1 GET oGet4 VAR cTest4 MULTILINE SIZE 200, 30  OF oDlg FONT oFont

   cSay := "¿CÓMO SALTO DE UNA MULTILÍNEA PARA LLEGAR A LA OTRA?"

   @ 8.0, 01 SAY oSay VAR cSay PICTURE "@!" OF oDlg FONT oFont UPDATE        ;
      COLORS METRO_ORANGE, CLR_WHITE TRANSPARENT

   cSay2 := "COMO HAGO EN WORKSHOP.exe?"

   @ 11.0, 20 SAY oSay2 VAR cSay2 PICTURE "@!" OF oDlg FONT oFont UPDATE     ;
      COLORS METRO_ORANGE, CLR_WHITE TRANSPARENT

   cSay3 := "FIVEWIN The Best"

   @ 11.0, 00 SAY oSay3 VAR cSay3 PICTURE "@" OF oDlg FONT oFont UPDATE      ;
      COLORS METRO_PINK, CLR_WHITE TRANSPARENT

   @ 133.5, 100 BTNBMP oBtn PROMPT "&EXIT" FILENAME ".\Exit.bmp"             ;
      SIZE 35, 35 OF oDlg PIXEL NOBORDER TOP 2007 FLAT FONT oFont            ;
      COLOR CLR_HRED, CLR_WHITE ACTION( oDlg:End() )
     
   oBtn:lCancel  := .T.
   oBtn:nRound   := 60
   oBtn:bClrGrad := { |lInvert| If( lInvert, 0x80FFA54A, nARGB( 54, 0, 192, 0 ) ) }

   ACTIVATE DIALOG oDlg CENTERED /* ;
      ON INIT ( oGet1:Disable(), oGet3:Disable(), .T. ) */

   oFont:End()

RETURN NIL

// FIN / END - kapiabafwh@gmail.com
 


Regards, saludos.

Re: Multiget con color cuando esta deshabilitado

PostPosted: Mon Apr 22, 2024 8:03 pm
by Antonio Linares
Estimado Joao,

Para saltar de un control a otro usa la tecla Tab

Re: Multiget con color cuando esta deshabilitado

PostPosted: Tue Apr 23, 2024 1:19 pm
by karinha
Antonio Linares wrote:Estimado Joao,

Para saltar de un control a otro usa la tecla Tab


https://imgur.com/WjPtoyk

Image

Regards, saludos.

Re: Multiget con color cuando esta deshabilitado

PostPosted: Tue Apr 23, 2024 1:23 pm
by karinha
Mi querido Maestro Liñares, me conteste por favor! Puede mejorar?

Code: Select all  Expand view

// C:\MULTIGET\GETCLR2.PRG - Version: 3.1 - by kapiabafwh@gmail.com

#Include "FiveWin.ch" // Aparentemente TGET.PRG es mucho mejor.

FUNCTION Main()

   LOCAL oDlg, oGet1, oGet2, oGet3, oGet4, Test1, cTest2, cTest3, cTest4, ;
         oFont, oBtn, oSay, cSay, oSay2, cSay2, oSay3, cSay3, cTitle

   cTest1 := SPACE(  50 )
   cTest2 := SPACE(  50 )
   cTest3 := SPACE( 100 )
   cTest4 := SPACE( 100 )

   cTest1 := "Test de MULTIGET cTest1"
   cTest2 := "Test de MULTIGET cTest2"

   cTest3 := "Test de MULTIGET en cTest3 MGET.PRG "         + ;
             "Otro Texto con MULTILINE en cTest3 MGET.PRG " + ;
             "Otro Texto con MULTILINE en cTest3 MGET.PRG."

   cTest4 := "Test de MULTIGET cTest4 MGET.PRG "            + ;
             "Otro Texto CON MULTILINE MGET.PRG."

   SkinButtons()

   cTitle := "FWH: TESTANDO MGET.PRG -> TGET.PRG ES MUCHO MEJOR(MAS COMPLETA)"

   // No me gusta esto, porque no es igual a la TGET.PRG - complicado usar esto.
   TGet():bColorBlock := {| oGet | IF( oGet:lFocused, { CLR_WHITE, CLR_GREEN }, ;
      IF( .NOT. oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }

   TMultiGet():bColorBlock := {| oGet | IF( oGet:lFocused, { CLR_WHITE, CLR_GREEN }, ;
      IF( .NOT. oGet:lActive, { CLR_RED, CLR_YELLOW }, { CLR_BLACK, CLR_WHITE } ) ) }

   DEFINE FONT oFont NAME "Verdana" SIZE 0,-14 BOLD

   DEFINE DIALOG oDlg SIZE 520, 354 TITLE cTitle COLOR CLR_BLACK, CLR_WHITE  ;
      TRANSPARENT

   oDlg:lHelpIcon := .F.

   IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
      Set( _SET_INSERT, ! Set( _SET_INSERT ) )
   ENDIF

   @ 1, 1 GET oGet1 VAR cTest1 SIZE 130, 16 PICTURE "@!" OF oDlg FONT oFont  ;
      UPDATE ; // NOBORDER -> FUNCIONA SI. -> COLORS NO FUNCIONA. BAD.
      VALID( BLOCK_GET1() )

   oGet1:bLostFocus := { || oGet1:SetColor( CLR_BLACK, CLR_WHITE) }
   oGet1:bGotFocus  := { || oGet1:SetColor( CLR_BLACK, nRGB( 255,255,45 )),  ;
                            oGet1:SetSel(0,0) }

   @ 2.3, 1 GET oGet2 VAR cTest2 SIZE 130, 16 PICTURE "@!" OF oDlg FONT oFont

   oGet2:bLostFocus := { || oGet2:SetColor( CLR_BLACK, CLR_WHITE) }
   oGet2:bGotFocus  := { || oGet2:SetColor( CLR_BLACK, nRGB( 255,255,45 )),  ;
                            oGet2:SetSel(0,0) }

   @ 3.5, 1 GET oGet3 VAR cTest3 MULTILINE SIZE 245, 30 OF oDlg FONT oFont

   oGet3:bLostFocus := { || oGet3:SetColor( CLR_BLACK, CLR_WHITE) }
   oGet3:bGotFocus  := { || oGet3:SetColor( CLR_BLACK, nRGB( 255,255,45 )),  ;
                            oGet3:SetSel(0,0) }

   // <Enter> y Flecha Arriba
   oGet3:bKeyDown:={|nKey|IF(nKey==VK_RETURN, VER_FOCO_GET3( oGet4 ),        ;
                          IF(nKey==VK_UP, oGet2:SetFocus(), ) ) }

   @ 6.5, 1 GET oGet4 VAR cTest4 MULTILINE SIZE 245, 30  OF oDlg FONT oFont

   oGet4:bLostFocus := { || oGet4:SetColor( CLR_BLACK, CLR_WHITE) }
   oGet4:bGotFocus  := { || oGet4:SetColor( CLR_BLACK, nRGB( 2455,255,45 )), ;
                            oGet4:SetSel(0,0) }

   // SALTO DE UNA MULTILÍNEA PARA LLEGAR A LA OTRA
   oGet4:bKeyDown:={|nKey|IF(nKey==VK_UP, VER_FOCO_GET4( oGet3 ),)}

   cSay := "<ENTER> PARA SALTAR Y LA FLECHA ARRIBA PARA VOLVER."

   @ 8.0, 01 SAY oSay VAR cSay PICTURE "@!" OF oDlg FONT oFont UPDATE        ;
      COLORS METRO_ORANGE, CLR_WHITE TRANSPARENT

   cSay2 := "Antônio Liñares"

   @ 10.5, 17.5 SAY oSay2 VAR cSay2 PICTURE "@" OF oDlg FONT oFont UPDATE    ;
      RIGHT COLORS METRO_VIOLET, CLR_WHITE TRANSPARENT

   cSay3 := "FIVEWIN The Best"

   @ 10.5, 01 SAY oSay3 VAR cSay3 PICTURE "@" OF oDlg FONT oFont UPDATE      ;
      COLORS METRO_PINK, CLR_WHITE TRANSPARENT

   @ 133.5, 105 BTNBMP oBtn PROMPT "&EXIT" FILENAME ".\Exit.bmp"             ;
      SIZE 35, 35 OF oDlg PIXEL NOBORDER TOP 2007 FLAT FONT oFont            ;
      COLOR CLR_HRED, CLR_WHITE ACTION( oDlg:End() )
     
   oBtn:lCancel  := .T.
   oBtn:nRound   := 30
   oBtn:bClrGrad := { |lInvert| If( lInvert, 0x80FFA54A, nARGB( 54, 0, 192, 0 ) ) }

   ACTIVATE DIALOG oDlg CENTERED /* ;
      ON INIT ( oGet1:Disable(), oGet3:Disable(), .T. ) */

   IF Set( _SET_INSERT, ! Set( _SET_INSERT ) )
      Set( _SET_INSERT, ! Set( _SET_INSERT ) )
   ENDIF

   oFont:End()

RETURN NIL

FUNCTION BLOCK_GET1()

   IF GETASYNCKEY( VK_UP )
      RETURN( .F. )        
   ENDIF

RETURN( .T. )

FUNCTION VER_FOCO_GET3( oGet4 ) // GET 3

   oGet4:SetFocus()
   oGet4:bGotFocus := { || oGet4:SetPos(0), Nil }

RETURN( .T. )

FUNCTION VER_FOCO_GET4( oGet3 ) // GET 3

   oGet3:SetFocus()
   oGet3:bGotFocus := { || oGet3:SetPos(0), Nil }

   XFOCUS( oGet3 )

RETURN( .T. )

FUNCTION xFocus( oObj )

   xSetFocus( oObj )
   xSetFocus( oObj )

RETURN( .T. )

FUNCTION xSetFocus( oObj )    

   LOCAL _oWnd := oObj:oWnd, _oTempo := ""

   DEFINE TIMER _oTempo INTERVAL 10 OF _oWnd ;
      ACTION ( oObj:SetFocus(), _oTempo:End() )

   ACTIVATE TIMER _oTempo

RETURN( .T. )

// FIN / END - kapiabafwh@gmail.com
 


Gracias.

Regards, saludos.

Re: Multiget con color cuando esta deshabilitado

PostPosted: Tue Apr 23, 2024 1:32 pm
by Antonio Linares
Joao,

Aqui funciona bien usando Tab y Shift-Tab

cual es el problema ? :-)

Re: Multiget con color cuando esta deshabilitado

PostPosted: Tue Apr 23, 2024 1:45 pm
by karinha
Antonio Linares wrote:Joao,

Aqui funciona bien usando Tab y Shift-Tab

cual es el problema ? :-)


Maestro: usuarios exigentes. Intenta retroceder con la flecha hacia arriba.

Prueba el ejemplo y lo entenderás.

Gracias.

Regards, saludos.

Re: Multiget con color cuando esta deshabilitado

PostPosted: Tue Apr 23, 2024 1:56 pm
by Antonio Linares
> Intenta retroceder con la flecha hacia arriba

Aqui retrocede bien con la flecha hacia arriba :-)
All times are UTC
Page 1 of 2
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/