para que roten img, es facil pones a pantalla completa el form.
luego pones un timer que kada x tiempo cambie de img, en el componente image.
los nombres de las img las podes tener en un array o que vos le pases un directorio y escanee todas las img.
esta funcion te servira de mucho:
Function VerImg(D As String) As Variant
Dim X() As String
ReDim X(1500)
MiRuta = D ' Establece la ruta.
MiNombre = Dir(MiRuta, vbArchive) ' Recupera la primera entrada.
I = 0
Do While MiNombre <> "" ' Inicia el bucle.
' Ignora el directorio actual y el que lo abarca.
If MiNombre <> "." And MiNombre <> ".." Then
' Realiza una comparación a nivel de bit para asegurarse de que MiNombre es un directorio.
If (GetAttr(MiRuta & MiNombre) And vbArchive) = vbArchive Then
If InStr(1, MiNombre, ".gif") Or InStr(1, MiNombre, ".jpg") Then 'buscamos archivos
X(I) = MiRuta & MiNombre 'creamos el array
I = I + 1 'nos movemos un dir mas
End If
End If ' solamente si representa un directorio.
End If
MiNombre = Dir ' Obtiene siguiente entrada.
Loop
ReDim Preserve X(I) 'dejamos solo los ficheros imagenes
VerImg = X
End Function
la usas de esta manera:
A = VerImg("c:\german\fotos\")
luego creas una variable global de tipo entera (integer) llamada cant y otra llamada A (que kontendra las img), y en el timer vas moviendo el array de esta manera:
Private Sub Timer1_Timer()
If Cant = Ubound(A) Then
Cant = 0
Else
Cant = Cant +1
End If
Image1.Picture = LoadPicture(A(Cant))
End Sub
de esta manera tenes tu propio protector de pantalla.
CODIGO COMPLETO:
Dim A
Dim Cant As Integer
Private Sub Form_Load()
Cant = 0
A = VerImg("c:\german\fotos\")
End Sub
Function VerImg(D As String) As Variant
Dim X() As String
ReDim X(1500)
MiRuta = D ' Establece la ruta.
MiNombre = Dir(MiRuta, vbArchive) ' Recupera la primera entrada.
I = 0
Do While MiNombre <> "" ' Inicia el bucle.
' Ignora el directorio actual y el que lo abarca.
If MiNombre <> "." And MiNombre <> ".." Then
' Realiza una comparación a nivel de bit para asegurarse de que MiNombre es un directorio.
If (GetAttr(MiRuta & MiNombre) And vbArchive) = vbArchive Then
If InStr(1, MiNombre, ".gif") Or InStr(1, MiNombre, ".jpg") Then 'buscamos archivos
X(I) = MiRuta & MiNombre 'creamos el array
I = I + 1 'nos movemos un dir mas
End If
End If ' solamente si representa un directorio.
End If
MiNombre = Dir ' Obtiene siguiente entrada.
Loop
ReDim Preserve X(I) 'dejamos solo los ficheros imagenes
VerImg = X
End Function
Private Sub Timer1_Timer()
If Cant = UBound(A) Then
Cant = 0
Else
Cant = Cant + 1
End If
Image1.Picture = LoadPicture(A(Cant))
End Sub
Autor
En línea
