Wav que suena sin finalizar
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Const SND_ASYNC = &H1 'modo asíncrono. La función retorna una vez iniciada la música (sonido en background).
Const SND_LOOP = &H8 'La música seguirá sonando repetidamente hasta
Call sndPlaySound(Archivo, SND_ASYNC + SND_LOOP)
Call sndPlaySound(ByVal "", 0)

Graficos con areas activas
Private Sub Form_Load()
P.ScaleMode = vbPixels
End Sub
Private Sub P_MouseDown( Button As Integer, Shift As Integer, X As Single, Y As Single )
P.MousePointer = vbDefault
If (X >= 100 And X <= 140) And (Y >= 100 And Y <= 140) Then
MsgBox "Clic sobre área (10, 10)-(40, 40)..."
Else
MsgBox "Clic fuera del área activa..."
End If
End Sub
Private Sub P_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (X >= 101 And X <= 140) And (Y >= 100 And Y <= 140) Then
If Not P.MousePointer = vbCrosshair Then
P.MousePointer = vbCrosshair
End If
Else
If Not P.MousePointer = vbDefault Then
P.MousePointer = vbDefault
End If
End If
Label1 = X & ", " & Y
End Sub
If Not pic_Panorama.MousePointer = vbCustom Then
pic_Panorama.MousePointer = vbCustom
pic_Panorama.MouseIcon = Image1
End If

Ventana no rectangular
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Form_Load()
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 300, 200), True
End Sub

Pintar una imagen en mosaico
Dim i As Integer
For i = 0 To Form1.ScaleHeight Step Picture1.Height
For j = 0 To Form1.ScaleWidth Step Picture1.Width
PaintPicture Picture1, j, i, Picture1.Width, Picture1.Height
Next
Next

Conectar/desconectar servicios
Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type
Public Const NO_ERROR = 0
Public Const CONNECT_UPDATE_PROFILE = &H1 'para que "recuerde" la conexión
Public Const RESOURCETYPE_DISK = &H1
Public Const RESOURCETYPE_PRINT = &H2
Public Const RESOURCETYPE_ANY = &H0
Public Const RESOURCE_CONNECTED = &H1
Public Const RESOURCE_REMEMBERED = &H3
Public Const RESOURCE_GLOBALNET = &H2
Public Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
Public Const RESOURCEDISPLAYTYPE_GENERIC = &H0
Public Const RESOURCEDISPLAYTYPE_SERVER = &H2
Public Const RESOURCEDISPLAYTYPE_SHARE = &H3
Public Const RESOURCEUSAGE_CONNECTABLE = &H1
Public Const RESOURCEUSAGE_CONTAINER = &H2
Public Const ERROR_ACCESS_DENIED = 5& 'acceso denegado
Public Const ERROR_ALREADY_ASSIGNED = 85& 'la unidad ya está conectada a un recurso
Public Const ERROR_BAD_DEV_TYPE = 66& 'tipo dispositivo local y del recurso distintos
Public Const ERROR_BAD_DEVICE = 1200& 'el nombre local del dispositivo es inválido
Public Const ERROR_BAD_NET_NAME = 67& 'nombre de recurso inválido o no se encuentra
Public Const ERROR_BAD_PROFILE = 1206& 'formato perfil usuario no válido
Public Const ERROR_BAD_PROVIDER = 1204&
Public Const ERROR_BUSY = 170& 'servidor ocupado, reintentar
Public Const ERROR_CANCELLED = 1223& 'conexión cancelada por el usuario
Public Const ERROR_CANNOT_OPEN_PROFILE = 1205& 'no se puede abrir el perfil de usuario para procesar una conexión persistente
Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202& 'ya existe una conexión persistente con la misma unidad local
Public Const ERROR_EXTENDED_ERROR = 1208& 'error específico de cada tipo de red
Public Const ERROR_INVALID_PASSWORD = 86& 'password incorrecta
Public Const ERROR_NO_NET_OR_BAD_PATH = 1203& 'la red no está arrancada
Public Const ERROR_DEVICE_IN_USE = 2404& 'dispositivo en uso por un proceso activo
Public Const ERROR_OPEN_FILES = 2401& ' hay ficheros abiertos y no se indicó desconexión forzosa
Public Const ERROR_NOT_CONNECTED = 2250& 'no existe la conexión a eliminar
Dim NetR As NETRESOURCE
Dim ErrInfo As Long
Dim MyPass, MyUser As String
NetR.dwScope = RESOURCE_GLOBALNET
NetR.dwType = RESOURCETYPE_DISK
NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
NetR.lpLocalName = "X:" ' Si no se define se hará una conexión sin dispositivo (no se verá en el explorer)
NetR.lpRemoteName = "\\NombreServidor\NombreRecursoCompartido"
ErrInfo = WNetAddConnection2(NetR, MiPassword, MiUsuario, CONNECT_UPDATE_PROFILE)
If ErrInfo = NO_ERROR Then
MsgBox "Establecida conexión de red", vbInformation,"Recurso conectado"
Else
MsgBox "ERROR: " & ErrInfo & " - Conexión fallida",vbExclamation, "Recurso no conectado
End If
'Para desconectarnos del recurso compartido :
Dim ErrInfo As Long
Dim strLocalName As String
strLocalName = "X:"
ErrInfo = WNetCancelConnection2(strLocalName, CONNECT_UPDATE_PROFILE, False)
If ErrInfo = NO_ERROR Then
MsgBox "Desconexión conseguida", vbInformation, "Recurso desconectado"
Else
MsgBox "ERROR: " & ErrInfo & " - Desconexión fallida", vbExclamation, "Recurso no desconectado"
End If

Utilidades del RUNDLL32
lngX = Shell("Rundll32.exe shell32.dll,Control_RunDLL NombreCpl.cpl @X,Y")
Da acceso a la configuración de las Opciones de Accesibilidad>.
Y : 1=Teclado, 2=Sonido, 3=Display, 4=Ratón, 5=General.
desk
Da acceso a las Propiedades de Pantalla
Y : 0=Fondo, 1=Protector de pantalla, 2=Apariencia, 3=Configuración
intl
Da acceso al diálogo Propiedades de Configuración regional.
Y : 0=Configuración regional, 1=Número, 2=Moneda, 3=Hora, 4=Fecha
main
Con X = 0 da acceso a las propiedades del ratón.
Y : 0=Botones
Con X = 1 da acceso a las propiedades del teclado.
Y : 0=Velocidad, 1=Idioma, 2=General
Con X = 2 muestra la carpeta de Impresoras
Con X = 3 muestra la carpeta de Fuentes
Con X = 4 muestra las propiedades de Ahorro de Energía
sysdm
Con X = 0 da acceso a las Propiedades del Sistema>.
Y : 0=General, 1 = Administrador de dispositivos, 2=Perfiles de hardware, 3=Rendimiento
Con X = 1 arranca el Asistente para agregar nuevo hardware
timedate
Da acceso a las Propiedades de Fecha y hora
Y : 0=Fecha y hora, 1=Zona horaria
modem
Con X = 0 e Y = add ejecuta el asistente Instalar Nuevo Módem.
mmsys
Con X = 0 da acceso a las Propiedades Multimedia
Y : 0=Audio, 1=Video, 2=Midi, 3=CD de música, 4=Avanzado
Con X = 1 da acceso a las Propiedades de Sonidos (del sistema).
appwiz
Da acceso a las Propiedades de Agregar o quitar programas.
Y : 1=Instalar o desinstalar, 2=Instalación de Windows, 3=Disco de inicio
netcpl
Da acceso al diálogo Red, pestaña de Configuración.
password
Da acceso al diálogo Propiedades de Contraseñas, pestaña Cambiar contraseñas
odbccp32
Arranca el Administrador de Odbc
joy
Da acceso a las propiedades de los controladores para juegos (joystick).
Y : 0=General, 1=Avanzadas
Si teneis problemas intentad la llamada sin los parámatros X e Y.
themes
Da acceso a la configuración de Temas de escritorio (MS Plus)
inetcpl
Da acceso a las Propiedades de internet del MS Internet Explorer.
Y : 0=General
mlcfg32
Da acceso a la página de propiedades de perfiles de Microsoft Exchange (Fax y correo)
wgpocpl
Da acceso a las propiedades de la administración de correo Microsoft.
powercfg
Da acceso a las propiedades de Ahorro de Energía
Si ejecutamos x = Shell("Rundll32.exe shell32.dll,Control_RunDLL") se abrirá la ventana del Panel de Control.
OTROS USOS DE RUNDLL32.EXE
Agregar impresora
Empleando el Rundll32 también podremos arrancar el Asistente para agregar impresora utilizando : x = Shell("rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter", vbNormalFocus)
Crear el icono de "Mi maletín"
Empleando el Rundll32 también podremos crear el icono de "Mi maletín" en el escritorio utilizando : x = Shell("rundll32.exe syncui.dll,Briefcase_Create")
Copiar disco
Podremos mostrar el diálogo de Copiar disco empleando x = Shell("rundll32.exe diskcopy.dll,DiskCopyRunDll", vbNormalFocus)
Acceso telefónico a redes
Podremos establecer una conexión empleando x = Shell("undll32.exe rnaui.dll,RnaDial NombreDeLaConexión). Si la conexión ya está establecida nos muestra la ventana de Estado de la misma.
Para ejecutar el asistente Bienvenido a Acceso telefónico a redes emplearemos : x = Shell("rundll32.exe rnaui.dll,RnaWizard")
Formatear disquete
Para arrancar el diálogo Formatear emplearemos x = Shell("rundll32.exe shell32.dll,SHFormatDrive")
Imprimir un documento HTML
Para imprimir un documento HTML emplearemos : x = Shell("rundll32.exe mshtml.dll,PrintHTML NombreDocumentoHTML")
Diálogo Abrir con
Para abrir el díalogo Abrir con para un fichero ejecutaremos : x = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL NombreFichero"). El nombre del fichero debe incluir la unidad y el directorio.
Instalar una salvapantallas
Podemos instalar un salvapantallas y mostrar su página de propiedades. Para ello debemos copiar el fichero .scr en windows\system y luego ejecutar : x = Shell("rundll32.exe desk.cpl,InstallScreenSaver c:\win\system\NombreFichero.scr")
Reiniciar windows
Podremos reiniciar windows empleando x = Shell("rundll32.exe user.exe,restartwindows") y salir de windows con x = Shell("rundll32.exe user.exe,exitwindows")

Invocar un aplicativo
Private Sub Command1_Click()
Dim hCalcWnd As Long
Dim x As Long
hCalcWnd = FindWindow("SciCalc", "Calculator")
If hCalcWnd = 0 Then
x = Shell("CALC.EXE", vbNormalFocus)
Else: BringWindowToTop (hCalcWnd)
End If
End Sub

Obtener valores del RGB
Private Sub Command1_Click()
x& = RGB(212, 15, 21)
owbyte = red value
Print "RGB color:"; x&
Print "red:"; vbTab; x& And &HFF&
Print "green:"; vbTab; (x& And &HFF00&) / &H100&
Print "blue:"; vbTab; (x& And &HFF0000) / &H10000
End Sub

Forma Transparente
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_TRANSPARENT = &H20&
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_SHOWME = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_NOTOPMOST = -2
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetWindowPos Lib "user32" (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 Sub Command1_Click()
SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME
End Sub

Parametros del sistema
Public Const SPI_GETMOUSETRAILS = 94
Public Const SPI_SETMOUSETRAILS = 93
Public Const SPI_GETSCREENSAVETIMEOUT = 14
Public Const SPI_SETSCREENSAVETIMEOUT = 15
Public Const SPI_GETSCREENSAVEACTIVE = 16
Public Const SPI_SETSCREENSAVEACTIVE = 17
Public Const SPIF_UPDATEINIFILE = &H1
Public Const SPIF_SENDWININICHANGE = &H2
Public Const SPIF_USER_FLAG = SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Function TestAPIFunction() As Long
Dim NewValue As Long
Dim Result As Long
Dim ReturnValue As Long
Result = SystemParametersInfo(SPI_GETMOUSETRAILS, 0, ReturnValue, 0)
NewValue = 10
Result = SystemParametersInfo(SPI_SETMOUSETRAILS, NewValue, vbNull,SPIF_USER_FLAG)
Result = SystemParametersInfo(SPI_SETMOUSETRAILS, NewValue, Null,SPIF_USER_FLAG)
Result = SystemParametersInfo(SPI_SETMOUSETRAILS, NewValue, 0,SPIF_USER_FLAG)
Result = SystemParametersInfo(SPI_GETSCREENSAVETIMEOUT, 0,ReturnValue, 0)
NewValue = 120
Result = SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT, NewValue,vbNull, SPIF_USER_FLAG)
Result = SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT, NewValue,Null, SPIF_USER_FLAG)
Result = SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT, NewValue, 0,SPIF_USER_FLAG)
Result = SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0,ReturnValue, 0)
NewValue = True
Result = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, NewValue,vbNull, SPIF_USER_FLAG)
Result = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, NewValue,Null, SPIF_USER_FLAG)
Result = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, NewValue, 0,SPIF_USER_FLAG)
Result = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, True, 0, 0)
TestAPIFunction = Result