Burbujas Flotantes

[TOTOVIOTTI]

Karinha... cólocale el código a Claude IA y pídele que te lo haga para Dialog MDI

y lo hace.... es muy obediente... jajaja

[Antonio Linares]

Aún falla el pintado de la sombra, solo lo hace bien al redimensionar la ventana principal. Seguimos...

Code: Select all  Expand view

#include "FiveWin.ch"

function Main()

    local oWnd, oCircle

    DEFINE WINDOW oWnd TITLE "Testing Class TCircle" COLOR "W/BG" SIZE 1200, 800

    @ 5, 5 BUTTON "Test" SIZE 80, 20

    oCircle = TCircle():New( 50, 80, 120, CLR_BLUE, oWnd )

    ACTIVATE WINDOW oWnd CENTER

return nil    

#define WHITE_BRUSH          0
#define DKGRAY_BRUSH         3
#define SRCCOPY       13369376
#define WS_EX_LAYERED   0x00080000

CLASS TCircle FROM TControl

   CLASSDATA lRegistered AS LOGICAL

   DATA   nRadius, hRgn
   DATA   lDragging INIT .F.
   DATA   nDragOffsetX INIT 0
   DATA   nDragOffsetY INIT 0

   METHOD New( nTop, nLeft, nRadius, nRGBColor, oWnd ) CONSTRUCTOR

   METHOD EraseBkGnd() INLINE 1

   METHOD Paint()

   METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0

   METHOD LButtonDown( nX, nY, nFlags )  

   METHOD LButtonUp( nX, nY, nFlags ) INLINE ::lDragging := .F., nil

   METHOD MouseMove( nX, nY, nFlags )

   METHOD Destroy()

ENDCLASS    

METHOD New( nTop, nLeft, nRadius, nRGBColor, oWnd ) CLASS TCircle

   DEFAULT nTop := 0, nLeft := 0, nRadius := 100,;
           oWnd := GetWndDefault()

   ::nTop    = nTop
   ::nLeft   = nLeft
   ::nBottom = nTop + nRadius
   ::nRight  = nLeft + nRadius
   ::nRadius = nRadius
   ::oWnd    = oWnd  
   ::nStyle  = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP )

   ::Register()

   if ! Empty( ::oWnd:hWnd )
      ::Create()
      ::SetBrush( TBrush():New( , nRGBColor ) )
      ::hRgn = CreateEllipticRgn( 0, 0, ::nRadius, ::nRadius )
      SetWindowRgn( ::hWnd, ::hRgn, .T. )
      ::oWnd:AddControl( Self )
   else
      ::oWnd:DefControl( Self )
   endif
 
return Self  

METHOD Paint() CLASS TCircle

   local hdcMem, hdcDest, hBmp, hOldBmp, hdcScreen, hBmpScreen, hOldBmpScreen, i, nStep, nAlpha := 100
   local hBrush := GetStockObject( DKGRAY_BRUSH )

   hdcDest := ::hDC  // HDC del destino (control)
   hdcScreen := ::oWnd:GetDC()

   // Crear un contexto de memoria compatible con la ventana
   hdcMem := CreateCompatibleDC( hdcScreen )
   hBmp := CreateCompatibleBitmap( hdcScreen, ::nRadius * 2 + 30, ::nRadius * 2 + 30 )  // Incluir el área de la sombra
   hOldBmp := SelectObject( hdcMem, hBmp )

   // Copiar la parte de la ventana contenedora donde se va a dibujar la sombra y el círculo
   BitBlt( hdcMem, 0, 0, ::nRadius, ::nRadius, hdcScreen, ::nLeft, ::nTop, SRCCOPY )

   SelectObject( hdcMem, hBrush )
   Ellipse( hdcMem, -1, -1, ::nRadius, ::nRadius )
   AlphaBlend( hdcDest, 0, 0, ::nRadius, ::nRadius, hdcMem, 0, 0, ::nRadius, ::nRadius, nAlpha, 0 )

   // Dibujar sombras concéntricas degradadas
   // nStep := 5  // Tamaño de cada paso en el degradado
   // for i := 30 to 1 step -1
   //    nAlpha := i * 8  // Nivel de transparencia de la sombra (ajustable entre 0 y 255)
   //    AlphaBlend( hdcDest, 15 - i, 15 - i, ::nRadius * 2 + i * 2 - 30, ::nRadius * 2 + i * 2 - 30, hdcMem, 0, 0, ::nRadius * 2, ::nRadius * 2, nAlpha, 0 )
   // next

   SelectObject( ::hDC, ::oBrush:hBrush )
   Ellipse( ::hDC, 15, 15, ::nRadius - 15, ::nRadius - 15 )

   SelectObject( hdcMem, hOldBmp )
   DeleteObject( hBmp )
   DeleteDC( hdcMem )
   ::oWnd:ReleaseDC()

return 0

METHOD LButtonDown( nX, nY, nFlags ) CLASS TCircle

   if ! ::lDragging
      SetFocus( ::hWnd )
      ::lDragging = .T.
      ::nDragOffsetX = nX
      ::nDragOffsetY = nY
   endif
   
return nil  

METHOD MouseMove( nX, nY, nFlags ) CLASS TCircle

   if ::lDragging
      ::Move( ::nTop + nX - ::nDragOffsetX, ::nLeft + nY - ::nDragOffsetY,,, .T. )
   endif
   
return nil  

METHOD Destroy() CLASS TCircle

   if ! Empty( ::hRgn )
      DeleteObject( ::hRgn )
   endif
 
 return ::Super:Destroy()

#pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>

HB_FUNC( ALPHABLEND )
{
    HDC hdcDest      = (HDC) hb_parnl( 1 );  // Primer parámetro: HDC destino
    int xDest        = hb_parni( 2 );        // Segundo parámetro: posición x de destino
    int yDest        = hb_parni( 3 );        // Tercer parámetro: posición y de destino
    int wDest        = hb_parni( 4 );        // Cuarto parámetro: ancho del área de destino
    int hDest        = hb_parni( 5 );        // Quinto parámetro: alto del área de destino
    HDC hdcSrc       = (HDC) hb_parnl( 6 );  // _ parámetro: HDC fuente
    int xSrc         = hb_parni( 7 );        // Séptimo parámetro: posición x en la fuente
    int ySrc         = hb_parni( 8 );        // Octavo parámetro: posición y en la fuente
    int wSrc         = hb_parni( 9 );        // Noveno parámetro: ancho del área en la fuente
    int hSrc         = hb_parni( 10 );       // Décimo parámetro: alto del área en la fuente
    BLENDFUNCTION bf;

    bf.BlendOp             = AC_SRC_OVER;    // La operación de mezcla estándar
    bf.BlendFlags          = 0;              // No usar banderas adicionales
    bf.SourceConstantAlpha = (BYTE) hb_parni( 11 ); // El nivel de transparencia (0-255)
    bf.AlphaFormat         = (BYTE) hb_parni( 12 ); // El formato del alfa (0 o AC_SRC_ALPHA)

    // Llamar a la función AlphaBlend de la GDI32
    hb_retl( AlphaBlend(
        hdcDest, xDest, yDest, wDest, hDest,
        hdcSrc, xSrc, ySrc, wSrc, hSrc,
        bf ) );  // Retornar el resultado de la operación (TRUE o FALSE)
}

#pragma ENDDUMP
 

[Antonio Linares]

Para MDI sólo hay que cambiar estas dos líneas:

DEFINE WINDOW oWnd TITLE "Testing Class TCircle" COLOR "W/BG" SIZE 1200, 800 MDI

oCircle = TCircle():New( 50, 80, 120, CLR_BLUE, oWnd:oWndClient )

[TOTOVIOTTI]

Buenísimo Antonio!!

No pude insertarle una imagen, pero seguiremos probando!

Muchas gracias!

[Antonio Linares]

Estamos intentando arreglar la sombra

[karinha]

Gracias Maestro. Es posible poner un TEXTO y IMAGEN en el CIRCLE?

Code: Select all  Expand view

// CIRCLE.PRG

#Include "FiveWin.ch"

FUNCTION Main()

   LOCAL oWnd, oCircle, cTitle := "Testing Class TCircle"

   // Window normal
   // DEFINE WINDOW oWnd TITLE "Testing Class TCircle" COLOR "W/BG" SIZE 1200, 800

   // MDI
   DEFINE WINDOW oWnd TITLE "Testing Class TCircle" COLOR "W/BG" SIZE 1200, 800 MDI

   // MDI
   oCircle = TCircle():New( 50, 80, 120, CLR_BLUE, oWnd:oWndClient, {|| MsgInfo( "¡Círculo presionado!", "Acción" ) } )

   // Window Normal
   // oCircle = TCircle():New( 50, 80, 120, CLR_BLUE, oWnd, {|| MsgInfo( "¡Círculo presionado!", "Acción" ) } )

   // MDI
   ACTIVATE WINDOW oWnd CENTERED ON INIT( oWnd:oMenu:End() )

RETURN NIL

CLASS TCircle FROM TControl

   CLASSDATA lRegistered AS LOGICAL

   DATA   nRadius, hRgn
   DATA   lDragging INIT .F.
   DATA   nDragOffsetX INIT 0
   DATA   nDragOffsetY INIT 0
   DATA   bAction

   METHOD New( nTop, nLeft, nRadius, nRGBColor, oWnd, bAction ) CONSTRUCTOR
   METHOD Paint()
   METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD LButtonDown( nX, nY, nFlags )
   METHOD LButtonUp( nX, nY, nFlags )
   METHOD MouseMove( nX, nY, nFlags )
   METHOD Destroy()
   METHOD PerformAction()

ENDCLASS

METHOD New( nTop, nLeft, nRadius, nRGBColor, oWnd, bAction ) CLASS TCircle

   DEFAULT nTop := 0, nLeft := 0, nRadius := 100, ;
      oWnd := GetWndDefault(), bAction := {|| NIL }

   ::nTop    = nTop
   ::nLeft   = nLeft
   ::nBottom = nTop + ( nRadius * 2 )
   ::nRight  = nLeft + ( nRadius * 2 )
   ::nRadius = nRadius
   ::oWnd    = oWnd
   ::nStyle  = nOr( WS_CHILD, WS_VISIBLE, WS_CLIPCHILDREN )
   ::bAction = bAction

   ::Register()

   IF .NOT. Empty( ::oWnd:hWnd )

      ::Create()
      ::SetBrush( TBrush():New( , nRGBColor ) )
      ::hRgn = CreateEllipticRgn( 0, 0, ::nRadius, ::nRadius )

      SetWindowRgn( ::hWnd, ::hRgn, .T. )

      ::oWnd:AddControl( Self )

   ELSE

      ::oWnd:DefControl( Self )

   ENDIF

RETURN Self

METHOD Paint() CLASS TCircle

   SelectObject( ::hDC, ::oBrush:hBrush )

   Ellipse( ::hDC, 0, 0, ::nRadius, ::nRadius )

RETURN 0

METHOD LButtonDown( nX, nY, nFlags ) CLASS TCircle

   IF .NOT. ::lDragging

      ::lDragging = .T.
      ::nDragOffsetX = nX
      ::nDragOffsetY = nY
      ::PerformAction()

   ENDIF

RETURN NIL

METHOD LButtonUp( nX, nY, nFlags ) CLASS TCircle

   ::lDragging := .F.

RETURN NIL

METHOD MouseMove( nX, nY, nFlags ) CLASS TCircle

   IF ::lDragging
      ::Move( ::nTop + nX - ::nDragOffsetX, ::nLeft + nY - ::nDragOffsetY,,, .T. )
   ENDIF

RETURN NIL

METHOD Destroy() CLASS TCircle

   IF .NOT. Empty( ::hRgn )
      DeleteObject( ::hRgn )
   ENDIF

   RETURN ::Super:Destroy()

METHOD PerformAction() CLASS TCircle

   Eval( ::bAction )

RETURN NIL

// FIN / END
 

Regards, saludos.

[paquitohm]

Una pregunta de novato todo el tiempo.

¿ No sería mejor decirle a Claude que haga una clase en C++/ Python con todas las caracteristicas necesarias y luego wrapearla a fwh ?

¿ Qué es mejor, no tener una cosa nativamente o tenerla no nativa ?

[Antonio Linares]

Paco,

FWH tiene su propia arquitectura y la clase tiene que seguir las reglas de FWH

[paquitohm]

Gracias Antonio

[Antonio Linares]

Nuestro querido Maestro Rao lo ha bordado:

[paquitohm]

Nivelón !!
Impressive !!
Congrats !!

[leandro]

Excelente Antonio,

esto lo vas a incluir en el nuevo build de fw?

[Antonio Linares]

Si, vamos a incluirlo y publicarlo lo antes posible

[TOTOVIOTTI]

Genial Maestro Antonioooooooooooooo & Mr. Rao!!!!

MUCHAS MUCHAS GRACIAS POR HACER CASO A NUESTRAS LOCURAS!!
GRACIAS A TODO EL EQUIPO!!


Great, Maestro Antoniooooooooooooo and Mr. Rao!!!!

THANK YOU VERY MUCH FOR LISTENING TO OUR CRAZIES!!
THANKS TO THE ENTIRE TEAM!!