Hola, este es un codigo con la api BitBlt que al ejecutarlo hace un efecto en la pantalla como si se estuviera derritiendo.se sale con cualquier tecla, es mejor sacarle el borde primero al formulario antes de ejecutarlo asi ocupa toda la pantalla.
Código:
Option Explicit Private Declare Function GetDC Lib "USER32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "USER32" (ByVal hwnd As Long, ByVal hDC As Long) As Long Private Declare Function BitBlt Lib "gdi32" (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 lngDC As Long Private blnLoop As Boolean Dim m1 As Integer, m2 As Integer Private Sub Form_Click() blnLoop = vbFalse Unload Me End Sub Private Sub Form_KeyPress(KeyAscii As Integer) blnLoop = vbFalse End Sub Sub ElEfecto() Dim intX As Integer, intY As Integer Dim intI As Integer, intJ As Integer Dim intWidth As Integer, intHeight As Integer intWidth = Screen.Width / Screen.TwipsPerPixelX intHeight = Screen.Height / Screen.TwipsPerPixelY Form1.Width = Screen.Width Form1.Height = Screen.Height lngDC = GetDC(0) Call BitBlt(hDC, 0, 0, intWidth, intHeight, lngDC, 0, 0, vbSrcCopy) Form1.Visible = vbTrue Form1.AutoRedraw = vbFalse Randomize blnLoop = vbTrue Do While blnLoop = vbTrue intX = (intWidth - 128) * Rnd intY = (intHeight - 128) * Rnd intI = m1 * Rnd - 1 intJ = m2 * Rnd - 1 Call BitBlt(Form1.hDC, intX + intI, intY + intJ, 128, 128, Form1.hDC, intX, intY, vbSrcCopy) DoEvents Loop Set Form1 = Nothing Call ReleaseDC(0, lngDC) End End Sub Private Sub Form_Load() Me.WindowState = 2 Me.AutoRedraw = True On Error GoTo er1 Dim ef As Integer ef = GetSetting("MeltSCR", "Effect", "Effect") Select Case ef Case 0 m1 = 2: m2 = 2 Case 1 m1 = 20: m2 = 20 Case 2 m1 = 9: m2 = 9 Case 3 m1 = 0: m2 = 0 Case 4 m1 = 3: m2 = 3 Case 5 m1 = 5: m2 = 5 Case 6 m1 = 10000: m2 = 10000 Case 7 m1 = 1000: m2 = 1000 Case 8 m1 = 10: m2 = 2 Case 9 m1 = 2: m2 = 10 End Select Call ElEfecto Exit Sub er1: m1 = 2: m2 = 2 Call ElEfecto End Sub
saludos.