Luz en la caja del get

[Antonio Linares]

Manuel,

Puedes publicar el ejemplo completo ya modificado por ti ? gracias

[mastintin]

Antonio , no funciona adecuadamente desde recursos . Al dibujar los marcos se tapa el Get ( desde recursos) y si ademas el fondo del dialogo no es blanco hace un efecto un poco extraño , se tendría que variar para que el degradado sea en función del color de fondo del dialogo .
Como ejmplo en que propone karinha es perfecto .

Code: Select all  Expand view

#Include "FiveWin.ch"

function Main()

   local oDlg, cTest := Space( 20 ), oGet

   DEFINE DIALOG oDlg

   @ 2, 3 GET oGet VAR cTest OF oDlg SIZE 100, 13

   oGet:bPainted = { || LightBorder( oGet ) }

   ACTIVATE DIALOG oDlg CENTERED

return nil

//Function pintaselect( oItem )
function LightBorder( oGet )

   local hDC := oGet:oWnd:GetDC()
   local hBrush, hOldBrush, n
   local aTopLeft, aBottomRight
   local oPen,hPen1
   local aRect := GetClientRect( oGet:hWnd )

   for n = 1 to 6  // 10 es mejor

      IF n > 5
         hPen1 = CreatePen( PS_SOLID, 1,  nRGB( 102 , 175, 233 ) )
      ELSE
         hPen1 = CreatePen( PS_SOLID, 1,  nRGB( Int(254 - n*3-n ), Int(254- n*2 ) , 255 ) )
      endif

      // hPen1 = CreatePen( PS_SOLID, 1,  nRGB( Int(244 - n ), Int(254- n ) , 255 ) )
      // SelectObject( hDC, oPen := TPen():New( ,, nRGB( n ^ 2, n ^ 2, 200 ) ):hPen )

      SelectObject( hDC,hPen1)
      aTopLeft = ClientToScreen( oGet:hWnd, { aRect[1], aRect[2] } )
      aTopLeft = ScreenToClient( oGet:oWnd:hWnd, aTopLeft )

      aBottomRight = ClientToScreen( oGet:hWnd, {aRect[3], aRect[4] } )
      aBottomRight = ScreenToClient( oGet:oWnd:hWnd, aBottomRight )

      SetBkMode( hDC , 1 )

      Rectangle( hDC, aTopLeft[1]-8 + n, aTopLeft[2]-8+ n, aBottomRight[ 1 ]+8 -n,  aBottomRight[ 2 ]+8-n )

      DeleteObject( hPen1 )

   next

   oGet:oWnd:ReleaseDC()

Return nil
 

 

[mastintin]

Y aun mejor otra manera de afrontarlo...
Con gradientes

Code: Select all  Expand view

function LightBorder( oGet )

   local hDC := oGet:oWnd:GetDC()
   local hBrush, hOldBrush, n
   local aTopLeft, aBottomRight
   local oPen,hPen1
   local aRect := GetClientRect( oGet:hWnd )
   LOCAL aGrdBack1  := { { 0.5, oget:ownd:nClrPane, nRGB(234 ,244, 252 ) },{ 0.5, nRGB(234 ,244, 252 ), nRGB(214 ,234,249 ) } }
   LOCAL aGrdBack2  := { { 0.5, nRGB(214 ,234, 249 ), nRGB(234 ,244,252 ) }, { 0.5, nRGB(234 ,244, 252 ), oget:ownd:nClrPane} }
 
    n:= 1  
 
      hPen1 = CreatePen( PS_SOLID, 1,  nRGB( 102 , 175, 233 ) )
     
       
      SelectObject( hDC,hPen1)
     
      aTopLeft = ClientToScreen( oGet:hWnd, { aRect[1], aRect[2] } )
      aTopLeft = ScreenToClient( oGet:oWnd:hWnd, aTopLeft )

      aBottomRight = ClientToScreen( oGet:hWnd, {aRect[3], aRect[4] } )
      aBottomRight = ScreenToClient( oGet:oWnd:hWnd, aBottomRight )

      SetBkMode( hDC , 1 )
     
      Rectangle( hDC, aTopLeft[1]-2, aTopLeft[2]-2, aBottomRight[ 1 ]+2,  aBottomRight[ 2 ]+2 )
     
      DeleteObject( hpen1 )
     
       GRADIENTFILL( hDC, aTopLeft[1]-12, aTopLeft[2]-12, aTopLeft[1]-3, aBottomRight[ 2 ]+12 , aGrdBack1 )
       GRADIENTFILL( hDC, aBottomRight[1]+2, aTopLeft[2]-10, aBottomRight[1]+10, aBottomRight[ 2 ]+10 , aGrdBack2 )
       
       GRADIENTFILL( hDC, aTopLeft[1]-5, aTopLeft[2]-14, aBottomRight[1]+5, aTopLeft[ 2 ]-3 , aGrdBack1, .f. )
       GRADIENTFILL( hDC, aTopLeft[1]-5, aBottomRight[2]+2, aBottomRight[1]+5, aBottomRight[ 2 ]+14 , aGrdBack2, .f. )
   
     

 

   oGet:oWnd:ReleaseDC()

Return nil

 

[Antonio Linares]

Manuel,

Eres un fiera

Puedes poner una captura de pantalla ? gracias!

[hmpaquito]

Quizá sea mejor la forma "clasica". Con gradientes no se podrá usar RoundRect()

[mastintin]

captura con redondeado ...

[jmartial]

Manuel,

Está muy bonito.

Ahora quedan un par de cosas que solucionar. He hecho una prueba en la clase TGet en el PAINT después de evaluar el bPainted, he puesto
if(::lFocused, LightBorder( Qself() ), )

Para que no ponga el borde en todos los gets de la pantalla, sólo cuando coja el foco.
Y el 2º problema que habría que solucionar es borrar el borde cuando pierda el foco.

[mastintin]

Manuel,

Está muy bonito.

Ahora quedan un par de cosas que solucionar. He hecho una prueba en la clase TGet en el PAINT después de evaluar el bPainted, he puesto
if(::lFocused, LightBorder( Qself() ), )

Para que no ponga el borde en todos los gets de la pantalla, sólo cuando coja el foco.
Y el 2º problema que habría que solucionar es borrar el borde cuando pierda el foco.

Ya lo tengo ... , faltaria poner los colores como variables para poder usar el juego de colores que queramos

Code: Select all  Expand view

#Include "FiveWin.ch"

function Main()

   local oDlg, cTest := "hola"+Space( 20 ), oGet, oGet2
   local obtn

   DEFINE DIALOG oDlg

   @ 1, 3 GET oGet VAR cTest OF oDlg SIZE 100, 13
   
   oget:bPainted = { ||  LightBorder( oGet, oGet:lFocused , .f. ) }
         
   @ 3, 3 GET oGet2 VAR cTest OF oDlg SIZE 100, 13
     
   oget2:bPainted = { ||  LightBorder( oGet2, oGet2:lFocused , .T. ) }

   ACTIVATE DIALOG oDlg CENTERED
   

return nil


function LightBorder( oGet, lFocus, lRounded  )

   local hDC := oGet:oWnd:GetDC()
   local hBrush, hOldBrush, n
   local aTopLeft, aBottomRight
   local oPen,hPen1
   local aRect := GetClientRect( oGet:hWnd )
   
   LOCAL aGrdBack1  := { { 0.5, oget:ownd:nClrPane, nRGB(234 ,244, 252 ) },{ 0.5, nRGB(234 ,244, 252 ), nRGB(214 ,234,249 ) } }
   LOCAL aGrdBack2  := { { 0.5, nRGB(214 ,234, 249 ), nRGB(234 ,244,252 ) }, { 0.5, nRGB(234 ,244, 252 ), oget:ownd:nClrPane} }
   local aGrdBack3  := { { 1,  oget:ownd:nClrPane,  oget:ownd:nClrPane } }
   
    DEFAULT lRounded := .f.
    DEFAULT lfocus  := .t.
   
       if lFocus
           hPen1 = CreatePen( PS_SOLID, 1,  nRGB( 102 , 175, 233 ) )
     else
           hPen1 = CreatePen( PS_SOLID, 1,  nRGB( 180 , 180, 180 ) )
     endif
     
       
      SelectObject( hDC,hPen1)
     
      aTopLeft = ClientToScreen( oGet:hWnd, { aRect[1], aRect[2] } )
      aTopLeft = ScreenToClient( oGet:oWnd:hWnd, aTopLeft )

      aBottomRight = ClientToScreen( oGet:hWnd, {aRect[3], aRect[4] } )
      aBottomRight = ScreenToClient( oGet:oWnd:hWnd, aBottomRight )
     
     SetBkMode( hDC , 1 )
           
       GRADIENTFILL( hDC, aTopLeft[1]-12, aTopLeft[2]-12, aTopLeft[1]-3, aBottomRight[ 2 ]+12 , if( lFocus, aGrdBack1, aGrdBack3 ) )
       GRADIENTFILL( hDC, aBottomRight[1]+2, aTopLeft[2]-10, aBottomRight[1]+10, aBottomRight[ 2 ]+10 , if( lFocus, aGrdBack2, aGrdBack3 ) )
       
       GRADIENTFILL( hDC, aTopLeft[1]-5, aTopLeft[2]-14, aBottomRight[1]+5, aTopLeft[ 2 ]-3 ,if( lFocus, aGrdBack1, aGrdBack3 ), .F. )
       GRADIENTFILL( hDC, aTopLeft[1]-5, aBottomRight[2]+2, aBottomRight[1]+5, aBottomRight[ 2 ]+14 , if( lFocus, aGrdBack2, aGrdBack3 ), .F. )
       
    if lRounded
            RoundRect( hDC, aTopLeft[2]-4, aTopLeft[1]-2, aBottomRight[ 2 ]+3,  aBottomRight[ 1 ]+2 , 7, 7 )
    else
            Rectangle( hDC, aTopLeft[1]-2, aTopLeft[2]-2, aBottomRight[ 1 ]+2,  aBottomRight[ 2 ]+2 )
    endif
       
   
    DeleteObject( hpen1 )

    oGet:oWnd:ReleaseDC()
   
Return nil
 

 

[AngelSalom]

Buen trabajo amigos, queda muy bonito. Estoy pensando en aplicarlo en mi software.
Saludos,

[MOISES]

Hola Manuel,

Simplemente es espectacular. Muchas gracias por tu aporte.

Yo creo que lo suyo sería a nivel global de main() poder especificar este comportamiento para todos los gets de la aplicación.

¿Qué os parece?.

[fgondi]

Muy buen trabajo. Queda elegante y profesional.

[D.Fernandez]

EXCELENTE.

Funciona desde recursos?

Muchas gracias, saludos.

[mastintin]

EXCELENTE.

Funciona desde recursos?

Muchas gracias, saludos.

Desde recursos tendríamos que cambiar la táctica ... dos cosas :
1.- el marco en redondo produce un efecto raro ( no se si se puede hacer redondo el original )
2.- en vez usar el bpaint tendriamos que usar ...

Code: Select all  Expand view

    //oget:bPainted = { ||  LightBorder2( oGet2, oGet2:lFocused , .T. ) }

    oget:bgotfocus = { ||  LightBorder( oGet,.t., .f. )  }
     oget:bLostFocus = { ||  LightBorder( oGet,.f., .f. ) }

   ACTIVATE DIALOG oDlg CENTERED ON Paint LightBorder ( oGet,.t., .f. )  // aqui ponemos esto si es el get el primer control que toma el foco cunado se lanza el dialogo

 

[Antonio Linares]

Manuel,

Muchas gracias!

[hmpaquito]

Dos cosas.

Pri: al menos en mis pruebas el gradiente borra cualquier imagen que haya junto al get y que caiga dentro de sus limites. En mi caso lo hace inaplicable.
Seg: imho este tema bien merece asignar una nueva data a la clase get bpaintborder que tendra un parametro .t. cuando gotfocus y .f. cuando lostfocus {|lGotFocus| lightborder (lgotfocus) }