VFP - MessageBox Transparente

Instrucciones, copiar el código en un archivo prg y ejecutarlo; espero les sea de utilidad.

Saludos

Denny Infante

#DEFINE GWL_EXSTYLE -20

#DEFINE WS_EX_LAYERED 0x00080000

DECLARE INTEGER FindWindow IN WIN32API STRING cClassName, STRING cWindName

DECLARE INTEGER SetLayeredWindowAttributes IN user32 INTEGER hwnd, INTEGER crKey, SHORT bAlpha, INTEGER dwFlags

DECLARE INTEGER SetWindowLong IN user32 INTEGER hWnd, INTEGER nIndex, INTEGER dwNewLong

DECLARE INTEGER GetWindowLong IN user32 INTEGER hWnd, INTEGER nIndex

DECLARE INTEGER MessageBox IN user32 As MessageBoxA INTEGER hwnd, STRING lpText, STRING lpCaption, INTEGER wType

LOCAL oMsg, lRet

oMsg = CREATEOBJECT('MsgBoxTransparent')

lRet = oMsg.Show('Denny Infante')

?'Resultado = ' + ALLTRIM(STR(lRet))

oMsg = null

DEFINE CLASS MsgBoxTransparent as Container

    ADD OBJECT tmrTimer AS Timer

    BoxTitle = "MDI Ingeniería"

    PROCEDURE Init

        LPARAMETERS lcTitulo

        IF TYPE('lcTitulo') = "C" THEN

            This.FBoxTitle = ALLTRIM(lcTitulo)

        ENDIF

        This.tmrTimer.Interval = 1

    ENDPROC

        PARAMETERS cMensaje, iPorcentajeOpacidad

        This.PorcentajeOpacidad = 65

        IF TYPE("iPorcentajeOpacidad") = "N"

            IF BETWEEN(iPorcentajeOpacidad, 0, 100)

                This.PorcentajeOpacidad = iPorcentajeOpacidad

            ENDIF

        ENDIF

        This.tmrTimer.Enabled = .T.

        RETURN MESSAGEBOX(cMensaje,3 + 32, This.BoxTitle) &&"MDI Msg")

    ENDPROC  

    PROCEDURE tmrTimer.Timer

        LOCAL lcHandle

        lcHandle = FindWindow(null, This.parent.BoxTitle) &&"MDI Msg")

        IF (lcHandle > 0)

            This.Enabled = .F.

            LOCAL lcWndStyle

            *!* GetWindowLong

            lcWndStyle = GetWindowLong(lcHandle, GWL_EXSTYLE)

            IF NOT (BITAND(lcWndStyle, WS_EX_LAYERED ) = WS_EX_LAYERED)

            ENDIF

            LOCAL lcByte

            lcByte = INT(This.Parent.PorcentajeOpacidad * 255 / 100)

        ELSE

            WAIT WINDOW 'No encontrada...' nowait