como crear un salvapantallas

[soru13]

hola, aver si alguien me puede decir como puedo hacer un salvapantallas

gracias

[Cicklow]

http://www.planet-source-code.com/vb/scripts/ShowZip.asp?lngWId=1&lngCodeId=40529&strZipAccessCode=tp%2FA405297111

+info:
http://www.planet-source-code.com/vb/scripts/BrowseCategoryOrSearchResults.asp?optSort=Alphabetical&txtCriteria=screensave&blnWorldDropDownUsed=TRUE&txtMaxNumberOfEntriesPerPage=10&blnResetAllVariables=TRUE&lngWId=1&B1=Quick+Search

[soru13]

ok, gracias, pero como podria hacer, que rotaran imagenes???

y un sonido de fondo???

[Cicklow]

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:

Código [Seleccionar] Expandir


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:

Código [Seleccionar] Expandir


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:

Código [Seleccionar] Expandir


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:

Código [Seleccionar] Expandir

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