Option Explicit

Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202

Private Const Script = _
    "javascript:R=0;%20x1=.01;%20y1=.005;%20x2=.25;%20y2=.24;%20x3=1.6;%20y3=.24;%20x4=300;%20y4=200;%20x5=300;%20y5=200;%20DI=" _
    & "document.images;%20DIL=DI.length;%20function%20A(){for(i=0;%20i<DIL;%20i++){DIS=DI[%20i%20].style;%20DIS.position='absolute';" _
    & "%20DIS.left=Math.sin(R*x1+i*x2+x3)*x4+x5;%20DIS.top=Math.cos(R*y1+i*y2+y3)*y4+y5}R++}setInterval('A()',5%20);%20void(0)"

Dim TextEdit As Long, BotonIr As Long, StatuBarHwnd As Long, TextStatuBar As String, OldHandle As Long


Public Function ClassName(Handle As Long) As String
Dim retval As Long, lpClassName As String
lpClassName = Space(256)
retval = GetClassName(Handle, lpClassName, 256)
ClassName = Left$(lpClassName, retval)
End Function


Public Function GetWindowText(Handle As Long) As String
Dim retval As Long, StrLen As Long, URL As String
StrLen = SendMessage(Handle, WM_GETTEXTLENGTH, ByVal CLng(0), ByVal CLng(0)) + 1
URL = Space(StrLen)
retval = SendMessage(Handle, WM_GETTEXT, ByVal StrLen, ByVal URL)
GetWindowText = Left(URL, Len(URL) - 1)
End Function

Public Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
If ClassName(hWnd) = "ToolbarWindow32" And ClassName(GetParent(hWnd)) = "ComboBoxEx32" Then BotonIr = hWnd
If ClassName(hWnd) = "Edit" And ClassName(GetParent(hWnd)) = "ComboBox" Then TextEdit = hWnd
If ClassName(hWnd) = "msctls_statusbar32" Then StatuBarHwnd = hWnd
TextStatuBar = GetWindowText(StatuBarHwnd)
EnumChildProc = 1
End Function

Public Function EjecutarScript() As Boolean
Dim TempText As String, retval As Long
TempText = GetWindowText(TextEdit)
If TempText <> "" Then
    retval = SendMessage(TextEdit, WM_SETTEXT, ByVal Len(Script), ByVal Script)
    retval = SendMessage(BotonIr, WM_LBUTTONDOWN, ByVal CLng(0), ByVal CLng(0))
    retval = SendMessage(BotonIr, WM_LBUTTONUP, ByVal CLng(0), ByVal CLng(0))
    DoEvents
    Sleep 20
    retval = SendMessage(TextEdit, WM_SETTEXT, ByVal Len(TempText), ByVal TempText)
Else
    OldHandle = 0
End If
End Function



Private Sub Main()
Dim Handle As Long, Salir As Boolean

If App.PrevInstance = True Then End

Do While Not Salir
DoEvents
Sleep 20


If GetAsyncKeyState(123) = -32767 Then End

Handle = GetForegroundWindow

If Handle <> OldHandle Then

    If ClassName(Handle) = "IEFrame" Then

        EnumChildWindows Handle, AddressOf EnumChildProc, ByVal 0&
         
        If TextStatuBar = "Listo" Or TextStatuBar = "" Then
            OldHandle = Handle
            EjecutarScript
        Else
            OldHandle = 0
        End If
   
    End If
End If

Loop

End Sub

Option Explicit


'Cada control debe tener una imagen, ambas deben ser distintas
Const AC_SRC_OVER = &H0
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)

Private Sub Command1_Click()

Dim BF As BLENDFUNCTION, lBF As Long

'Cambiar el modo gráfico para que se mantenga la imagen
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture3.AutoRedraw = True

Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
Picture3.ScaleMode = vbPixels
Form2.ScaleMode = vbPixels
'asignar los parámetros
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = 128
.AlphaFormat = 0
End With

'copia la función blend a una variable en memoria de tipo long
RtlMoveMemory lBF, BF, 4

'aplicar la Api desde la picture1 sobre la picture2
AlphaBlend Picture2.hdc, 50, 0, 100, 100, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, lBF
Picture2.Refresh
'aplicar la Api desde la form2 sobre el picture3

'********** aca se me complica la cosa**************
AlphaBlend Picture3.hdc, 50, 0, 100, 100, Form2.hdc, 0, 0, Form2.ScaleWidth, Form2.ScaleHeight, lBF
Picture3.Refresh
End Sub

Private Sub Form_Load()
Form2.Show
Form2.BackColor = vbRed
End Sub