Newsgroup: it.comp.lang.visual-basic
Titolo: Foto desktop casuali

Si potrebbe fare in modo che ogni volta che si risetti il PC
sul desktop compaia una foto diversa "tirata a caso" da un
certo numero di foto date?
Grazie a chi mi risponderà
Saluti
-- 
Posted from 
smtp1.libero.it
 [193.70.192.51] 
via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 Saluti
si', abbastanza tranquillamente. prova il codice che segue, poi metti un
collegamento all'exe in esecuzione automatica. molto pron mi sto scordando
qualche dichiarazione o costante. nel caso, su 
www.allapi.net
 trovi una
bella guida free all'api di windows.
ciao, a.
'sub (tilevalue e' il valore per metterla affiancata o centrata):
        Dim rtn As Long, KeyName As String
        Dim hKey As Long, KeyValueLength As Long
        KeyName = "desktop\TileWallpaper"
        KeyValueLength = Len(TileValue) + 1
        rtn = RegOpenKey(HKEY_CURRENT_USER, "Control Panel\desktop", hKey)
        rtn = RegSetValueEx(hKey, "TileWallpaper", 0, REG_SZ, TileValue,
KeyValueLength)
        rtn = RegCloseKey(hKey)
        Dim TmpName As String
        TmpName = GetWinDir & [latuaimmagine.bmp]
        rtn = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, TmpName, _
            SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
'dichiarazioni:
Public Const SPI_GETWORKAREA& = 48
Public Const SPI_SETDESKWALLPAPER = 20
Public Const SPIF_UPDATEINIFILE = &H1
Public Const SPIF_SENDWININICHANGE = &H2
Declare Function SystemParametersInfo& Lib "user32" Alias
"SystemParametersInfoA" _
     (ByVal uAction&, ByVal uParam&, ByVal lpvParam As Any, ByVal fuWinIni&)
Declare Function GetWindowsDirectory Lib "kernel32" Alias
"GetWindowsDirectoryA" _
    (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function RegCloseKey Lib "advapi32" _
    (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32" Alias "RegCreateKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As
Long
Declare Function RegEnumValue& Lib "advapi32" Alias "RegEnumValueA" _
    (ByVal hKey&, ByVal dwIndex&, ByVal lpName$, lpcbName&, ByVal
lpReserved&, lpdwType&, lpValue As Any, lpcbValue&)
Declare Function RegOpenKey Lib "advapi32" Alias "RegOpenKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As
Long
Public Function GetWinDir() As String
    On Error GoTo errman
    Dim Temp As String * 256
    Dim x As Integer
    x = GetWindowsDirectory(Temp, Len(Temp))
    GetWinDir = Left$(Temp, x)
    GetWinDir = IIf(Right(GetWinDir, 1) = "\", GetWinDir, GetWinDir & "\")
    Exit Function
errman: MsgBox Error
End Function

 certo numero di foto date?
  Const SPI_SETDESKWALLPAPER = 20
  Const SPIF_UPDATEINIFILE = &H1
  Const SPIF_SENDWININICHANGE = &H2
  Declare Function SystemParametersInfo Lib "user32" Alias
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal
lpvParam As String, ByVal fuWinIni As Long) As Long
  Public Sub SetWindowsWallPaper(sFile As String)
  Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, sFile,
SPIF_UPDATEINIFILE
  Or SPIF_SENDWININICHANGE)
  End Sub
Public Sub ImpostaSfondo()
Dim sDir() As String
Dim sPath  As String
Dim sFile  As String
Dim iInd   As Integer
Dim iNum   As Integer
sPath = GetSetting(App.EXEName, "Sfondo", "Path", App.Path & "\Sfondi")
If Right(" " & sPath, 1) <> "\" Then sPath = sPath & "\"
Erase sDir
iNum = 0
sFile = Dir(sPath & "*.bmp")
While sFile <> ""
    iNum = iNum + 1
    ReDim Preserve sDir(iNum)
    sDir(iNum) = sFile
    sFile = Dir
  Wend
Randomize
If iNum <> 0 Then 'la dir non e' vuota
   iInd = Int(iNum * Rnd + 1)
   sFile = sPath & sDir(iInd)
   SetWindowsWallPaper sFile
  End If
End Sub


Provare a scaricare la versione free di WebShots (
www.webshots.com
)?
Bye by Massimo 8-]

Saluti
->
DoS :: dENIAL OF sTABILITY
dos...@hotmail.com