Hola,este codigo muy bueno permite hacer un efecto como de espejo del formulario,se necesita un timer y agregar un modulo.

En el Modulo:

Código:
Option Explicit

Private Type SAFEARRAYBOUND
 cElements As Long
 lLbound As Long
End Type

Private Type SAFEARRAY2D
 cDims As Integer
 fFeatures As Integer
 cbElements As Long
 cLocks As Long
 pvData As Long
 Bounds(0 To 1) As SAFEARRAYBOUND
End Type
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long

Private Type RGBQUAD
 rgbBlue As Byte
 rgbGreen As Byte
 rgbRed As Byte
 rgbReserved As Byte
End Type
Private Type BITMAPINFOHEADER
 biSize As Long
 biWidth As Long
 biHeight As Long
 biPlanes As Integer
 biBitCount As Integer
 biCompression As Long
 biSizeImage As Long
 biXPelsPerMeter As Long
 biYPelsPerMeter As Long
 biClrUsed As Long
 biClrImportant As Long
End Type

Private Type BITMAPINFO
 bmiHeader As BITMAPINFOHEADER
End Type

Private Const BI_RGB = 0&
Private Const BI_RLE4 = 2&
Private Const BI_RLE8 = 1&
Private Const DIB_RGB_COLORS = 0

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetCurrentObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal uObjectType As Long) As Long
Private Const OBJ_BITMAP As Long = 7

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Declare Function UpdateLayeredWindow Lib "user32" ( _
 ByVal hwnd As Long, _
 ByVal hdcDst As Long, _
 pptDst As Any, _
 psize As Any, _
 ByVal hdcSrc As Long, _
 pptSrc As Any, _
 ByVal crKey As Long, _
 pblend As BLENDFUNCTION, _
 ByVal dwFlags As Long) As Long

Private Declare Function CreateDIBSection Lib "gdi32" _
 (ByVal hdc As Long, _
 pBitmapInfo As BITMAPINFO, _
 ByVal un As Long, _
 lplpVoid As Long, _
 ByVal handle As Long, _
 ByVal dw As Long) As Long
 
Private Type SIZEAPI
 cx As Long
 cy As Long
End Type

Private Type POINTAPI
 x As Long
 y As Long
End Type

Private Type RECT
 Left As Long
 Top As Long
 Right As Long
 Bottom As Long
End Type

Private Type BLENDFUNCTION
 BlendOp As Byte
 BlendFlags As Byte
 SourceConstantAlpha As Byte
 AlphaFormat As Byte
End Type

Private Const AC_SRC_OVER As Long = &H0&
Private Const ULW_COLORKEY As Long = &H1&
Private Const ULW_ALPHA As Long = &H2&
Private Const ULW_OPAQUE As Long = &H4&
Private Const AC_SRC_ALPHA = &H1


Private Const WS_EX_TOPMOST As Long = &H8&
Private Const WS_EX_TRANSPARENT As Long = &H20&
Private Const WS_EX_TOOLWINDOW As Long = &H80&
Private Const WS_EX_LAYERED As Long = &H80000
Private Const WS_POPUP = &H80000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_DISABLED As Long = &H8000000

Private Const WM_DESTROY = &H2
Private Const WM_SIZE = &H5
Private Const WM_SIZING = &H214
Private Const WM_MOVING = &H216&
Private Const WM_ENTERSIZEMOVE = &H231&
Private Const WM_EXITSIZEMOVE = &H232&
Private Const WM_MOVE As Long = &H3

Private Declare Function SetWindowPos Lib "user32.dll" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SWP_ASYNCWINDOWPOS As Long = &H4000
Private Const SWP_DEFERERASE As Long = &H2000
Private Const SWP_FRAMECHANGED As Long = &H20
Private Const SWP_DRAWFRAME As Long = SWP_FRAMECHANGED
Private Const SWP_HIDEWINDOW As Long = &H80
Private Const SWP_NOACTIVATE As Long = &H10
Private Const SWP_NOCOPYBITS As Long = &H100
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOOWNERZORDER As Long = &H200
Private Const SWP_NOREDRAW As Long = &H8
Private Const SWP_NOREPOSITION As Long = SWP_NOOWNERZORDER
Private Const SWP_NOSENDCHANGING As Long = &H400
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOZORDER As Long = &H4
Private Const SWP_SHOWWINDOW As Long = &H40

Private Declare Function GetDIBits Lib "gdi32.dll" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, ByRef lpBits As Any, ByRef lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function GetWindowDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long


Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
 lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const GWL_EXSTYLE As Long = -20
Private Const GWL_WNDPROC As Long = -4

Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function IsWindow Lib "user32.dll" (ByVal hwnd As Long) As Long

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Sub OutputDebugString Lib "kernel32.dll" Alias "OutputDebugStringA" (ByVal lpOutputString As String)
Private Declare Function Ellipse Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private hWndAttach As Long
Private hWndReflection As Long
Private pFnOldWindowProc As Long
Private iTimerID As Long
Private bDying As Boolean

Const WAVE_SIZE As Long = 20
Const WAVE_GAP As Long = 5
Const WAVE_FREQ As Long = 4
Private OffsetLookup(0 To 256) As Long

Private hDib As Long
Private hBmpOld As Long
Private hdc As Long
Private hDD As Long
Private lPtr As Long
Private bi As BITMAPINFO

Public Sub Attach(ByVal hwnd As Long)
 If hWndAttach <> 0 Then
 Err.Raise vbObjectError, "Reflection::Attach()", "Only one window supported in this version"
 Exit Sub
 End If
 If IsWindow(hwnd) = 0 Then
 Err.Raise vbObjectError, "Reflection::Attach()", "Not a valid window"
 Exit Sub
 End If
 hWndAttach = hwnd

 Dim i As Long
 Dim two_pi As Double
 two_pi = Atn(1) * 8#
 For i = 0 To 256
 OffsetLookup(i) = Round((2 * WAVE_SIZE - WAVE_GAP) * Sin(CDbl(WAVE_FREQ) * two_pi * CDbl(i) / 256#))
 Next

 Dim rc As RECT, cy As Long
 GetWindowRect hWndAttach, rc
 cy = rc.Bottom - rc.Top
 rc.Top = rc.Top + cy
 rc.Bottom = rc.Top + cy
 

 
 hWndReflection = CreateWindowEx(WS_EX_LAYERED Or WS_EX_TRANSPARENT Or WS_EX_TOOLWINDOW, _
 "STATIC", "Reflection", WS_POPUP Or WS_VISIBLE Or WS_DISABLED, _
 rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, _
 0, 0, App.hInstance, ByVal 0&)
 
 If hWndReflection = 0 Then
 hWndAttach = 0
 Err.Raise vbObjectError, "Reflection::Create()", "Could not create window"
 Exit Sub
 End If
 

 pFnOldWindowProc = SetWindowLong(hWndAttach, GWL_WNDPROC, AddressOf AttachedWindow_WindowProc)

 iTimerID = SetTimer(0, 0, 50, AddressOf TimerProc)
 
 bDying = False
 
End Sub

Public Sub Detach()
 bDying = True
 
 ODS "Detach()..."
 If hWndAttach = 0 Then Exit Sub
 

 KillTimer 0, iTimerID
 

 ODS "Unsubclassing..."
 SetWindowLong hWndAttach, GWL_WNDPROC, pFnOldWindowProc
 

 ODS "Destroying our window..."
 If hWndReflection <> 0 Then
 If IsWindow(hWndReflection) Then
 SetWindowLong hWndReflection, GWL_EXSTYLE, GetWindowLong(hWndReflection, GWL_EXSTYLE) And Not (WS_EX_LAYERED)
 DestroyWindow hWndReflection
 End If
 hWndReflection = 0
 End If
 

 ODS "Deleting graphics..."
 ClearUp
 
 hWndAttach = 0
 ODS "Done"
End Sub

Private Function CreateDIB( _
 ByVal hDCRef As Long, _
 ByVal w As Long, _
 ByVal h As Long, _
 ByRef hDib As Long _
 ) As Boolean
 With bi.bmiHeader
 .biSize = Len(bi.bmiHeader)
 .biWidth = w
 .biHeight = h
 .biPlanes = 1
 .biBitCount = 32
 .biCompression = BI_RGB

 .biSizeImage = 4& * .biHeight * .biHeight
 End With
 hDib = CreateDIBSection( _
 hDCRef, _
 bi, _
 DIB_RGB_COLORS, _
 lPtr, _
 0, 0)
 CreateDIB = (hDib <> 0)
End Function

Private Function Create( _
 ByVal w As Long, _
 ByVal h As Long _
 ) As Boolean

 If w = bi.bmiHeader.biWidth And h = bi.bmiHeader.biHeight Then
 Create = True
 Exit Function
 End If
 
 ClearUp
 hdc = CreateCompatibleDC(0)
 If (hdc <> 0) Then
 If (CreateDIB(hdc, w, h, hDib)) Then
 hBmpOld = SelectObject(hdc, hDib)
 Create = True
 Else
 DeleteObject hdc
 hdc = 0
 End If
 End If
End Function

Private Sub ClearUp()
 If (hdc <> 0) Then
 If (hDib <> 0) Then
 SelectObject hdc, hBmpOld
 DeleteObject hDib
 End If
 DeleteObject hdc
 End If
 hdc = 0: hDib = 0: hBmpOld = 0: lPtr = 0
End Sub

Private Function AttachedWindow_WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 If bDying = False Then
 Static bInSizeMove As Boolean
 Dim rc As RECT
 Select Case uMsg
 Case WM_MOVING

 GetWindowRect hwnd, rc
 Reposition rc
 Case WM_SIZING

 GetWindowRect hwnd, rc
 Reposition rc
 Case WM_SIZE, WM_MOVE
 If Not bInSizeMove Then
 GetWindowRect hwnd, rc
 Reposition rc
 End If
 Case WM_ENTERSIZEMOVE
 bInSizeMove = True
 Case WM_EXITSIZEMOVE
 bInSizeMove = False
 Case WM_DESTROY
 rc.Left = pFnOldWindowProc
 Detach
 AttachedWindow_WindowProc = CallWindowProc(rc.Left, hwnd, uMsg, wParam, lParam)
 Exit Function
 End Select
 End If
 AttachedWindow_WindowProc = CallWindowProc(pFnOldWindowProc, hwnd, uMsg, wParam, lParam)
 
End Function

Private Function Reposition(rc As RECT)
 If bDying Then Exit Function
 
 Dim cy As Long
 cy = rc.Bottom - rc.Top
 rc.Top = rc.Top + cy
 
 If cy > 128 * 2 Then
 rc.Bottom = rc.Top + 128
 Else
 rc.Bottom = rc.Top + cy \ 2
 End If
 
 rc.Left = rc.Left - WAVE_SIZE
 rc.Right = rc.Right + WAVE_SIZE
 
 SetWindowPos hWndReflection, 0, rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, SWP_NOOWNERZORDER Or SWP_NOACTIVATE
 
 Create rc.Right - rc.Left, rc.Bottom - rc.Top
 Redraw
End Function

Public Function Redraw()
 If bDying Then Exit Function
 
 Dim rc As RECT
 Dim si As SIZEAPI
 GetWindowRect hWndReflection, rc
 si.cx = rc.Right - rc.Left
 si.cy = rc.Bottom - rc.Top
 Dim bf As BLENDFUNCTION
 bf.BlendOp = AC_SRC_OVER
 bf.BlendFlags = 0
 bf.AlphaFormat = AC_SRC_ALPHA
 bf.SourceConstantAlpha = 192
 Dim pt As POINTAPI
 pt.x = 0
 pt.y = 0
 
 Create rc.Right - rc.Left, rc.Bottom - rc.Top
 Render
 
 UpdateLayeredWindow hWndReflection, ByVal 0&, ByVal 0&, si, hdc, pt, 0, bf, ULW_ALPHA
End Function

Private Function Render()
 Static LastRenderTime As Long
 Dim ThisRenderTime As Long
 
 ThisRenderTime = timeGetTime
 
 If bDying Then Exit Function
 
 Dim SrcBits() As Byte
 Dim DstBits() As Byte
 Dim x As Long, y As Long
 Dim tSA As SAFEARRAY2D

 With tSA
 .cbElements = 1
 .cDims = 2
 .Bounds(0).lLbound = 0
 .Bounds(0).cElements = bi.bmiHeader.biHeight
 .Bounds(1).lLbound = 0
 .Bounds(1).cElements = bi.bmiHeader.biWidth * 4
 .pvData = lPtr
 End With
 CopyMemory ByVal VarPtrArray(DstBits()), VarPtr(tSA), 4
 
 
 GetWindowBits hWndAttach, SrcBits()
 Dim SrcX As Long, SrcY As Long

 SrcY = 2
 
 Dim alpha As Long, alpha_delta As Long
 alpha_delta = Int(255# / CDbl(bi.bmiHeader.biHeight) + 0.5)
 alpha = 0
 
 Dim phase As Double
 phase = CDbl(ThisRenderTime Mod 1000) * 0.001
 phase = phase * 3.1415927 * 2#
 
 Dim phase2 As Long
 phase2 = (ThisRenderTime Mod 1000)
 phase2 = phase2 \ 16
 
 Dim pos As Double
 Dim pos2 As Long

 For y = bi.bmiHeader.biHeight - 1 To 0 Step -1
 pos2 = y * 255 \ bi.bmiHeader.biHeight
 alpha = pos2
 For x = 0 To bi.bmiHeader.biWidth * 4 - 1 Step 4
 
 
 SrcX = x \ 4
 SrcX = SrcX - WAVE_SIZE + ((255 - pos2) * OffsetLookup(((y + phase2)) Mod 256)) \ 255
 SrcX = SrcX * 4
 
 If SrcX < 0 Or SrcX > UBound(SrcBits, 1) Then
 DstBits(x + 3, y) = 0
 DstBits(x + 2, y) = 0
 DstBits(x + 1, y) = 0
 DstBits(x + 0, y) = 0
 Else
 DstBits(x + 3, y) = alpha
 DstBits(x + 2, y) = (SrcBits(SrcX + 2, SrcY) * alpha) \ 255
 DstBits(x + 1, y) = (SrcBits(SrcX + 1, SrcY) * alpha) \ 255
 DstBits(x + 0, y) = (SrcBits(SrcX + 0, SrcY) * alpha) \ 255
 End If
 Next
 SrcY = SrcY + 1
 alpha = alpha + alpha_delta
 Next

 CopyMemory ByVal VarPtrArray(DstBits()), 0&, 4
 
 LastRenderTime = ThisRenderTime
End Function

Private Function GetWindowBits(ByVal hwnd As Long, ByRef WinBits() As Byte)
 Dim rc As RECT
 Dim hWinDC As Long
 Dim hWinBmp As Long
 Dim hWinOldBmp As Long
 Dim tSA As SAFEARRAY2D
 Dim biWin As BITMAPINFO
 

 GetWindowRect hwnd, rc
 

 With biWin.bmiHeader
 .biSize = Len(bi.bmiHeader)
 .biWidth = rc.Right - rc.Left
 .biHeight = rc.Bottom - rc.Top
 .biPlanes = 1
 .biBitCount = 32
 .biCompression = BI_RGB
 .biSizeImage = 4& * .biHeight * .biHeight
 End With
 
 ReDim WinBits(0 To ((rc.Right - rc.Left) * 4) - 1, 0 To (rc.Bottom - rc.Top) - 1)

Dim ret As Long
Dim hTempDC As Long
 
 hWinDC = GetWindowDC(hwnd)
 hTempDC = CreateCompatibleDC(0)
 hWinBmp = CreateCompatibleBitmap(hWinDC, biWin.bmiHeader.biWidth, biWin.bmiHeader.biHeight)
 hWinOldBmp = SelectObject(hTempDC, hWinBmp)
 BitBlt hTempDC, 0, 0, biWin.bmiHeader.biWidth, biWin.bmiHeader.biHeight, hWinDC, 0, 0, vbSrcCopy
 SelectObject hTempDC, hWinOldBmp

 ret = GetDIBits(hWinDC, hWinBmp, 0, rc.Bottom - rc.Top, WinBits(0, 0), biWin, DIB_RGB_COLORS)

 ReleaseDC hwnd, hWinDC
 DeleteDC hTempDC
 DeleteObject hWinBmp
 
End Function

Public Function ODS(ParamArray s())
 OutputDebugString Join(s, ", ") & vbCrLf
End Function

Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
 If bDying Then Exit Sub
 Dim rc As RECT
 GetWindowRect hWndAttach, rc
 Reposition rc
End Sub
En el Formulario:


Código:
Option Explicit

Private Declare Function Polygon Lib "gdi32.dll" (ByVal hdc As Long, ByRef lpPoint As POINTAPI, ByVal nCount As Long) As Long
Private Declare Function PolyBezier Lib "gdi32.dll" (ByVal hdc As Long, ByRef lppt As POINTAPI, ByVal cPoints As Long) As Long
Private Declare Function BeginPath Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function EndPath Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function FillPath Lib "gdi32.dll" (ByVal hdc As Long) As Long

Private Type POINTAPI
 x As Long
 y As Long
End Type

Dim pts(0 To 9) As POINTAPI

Private Sub Form_Load()
Me.Caption = "Reflejo Formulario"
Timer1.Enabled = True
Timer1.Interval = 25
On Error GoTo NO_REFLECTION
Module1.Attach Me.hwnd
Exit Sub
NO_REFLECTION:
MsgBox "No se pudo Iniciar el Proceso" & vbCrLf & Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
Module1.Detach
End Sub

Private Sub Form_Initialize()
Timer1_Timer
End Sub

Private Sub Timer1_Timer()
Static phase As Double
Dim i As Long
Dim a As Double, r As Double, da As Double
a = phase
da = (2 * Atn(1) * 4) / 10#
For i = 0 To 9
If i Mod 2 = 0 Then
r = 40# + Sin(phase) * 10
Else
r = 20# + Sin(phase * 2) * 10
End If
pts(i).x = 47 + Int(Cos(a) * r + 0.5)
pts(i).y = 47 - Int(Sin(a) * r + 0.5)
a = a + da
Next
End Sub
saludos.