Foro de elhacker.net

hola nuevamente amigos.
veran hace pocas horas puse un post donde consegui solucionar una duda con la ruta de acseso, pues bien:
ahora resulta que la aplicacion que ando creando (la cual solo cambia el fondo del escritorio por la de una imagen que tenga en el cd ) me cambia solo 2 de las 4 imagenes que le tengo puestas y resulta que las 4 tienen las mismas medidas y son .bmp
el codigo que uso es el siguiente:

Private 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
Const SPIF_UPDATEINIFILE = &H1
Const SPI_SETDESKWALLPAPER = 20
Const SPIF_SENDWININICHANGE = &H2
Private Sub Picture1_Click()
Dim FileName As String
    Dim X As Long
 
    'Usa aquí el bitmap que quieres usar
    FileName = App.Path & "\fondo(1).bmp"
 
    X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, FileName, _
       SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
 
End Sub
Private Sub Picture2_Click()
Dim FileName As String
    Dim X As Long
 
    'Usa aquí el bitmap que quieres usar
    FileName = App.Path + "\fondo(2).bmp"
 
    X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, FileName, _
       SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
 
End Sub
Private Sub Picture3_Click()
Dim FileName As String
    Dim X As Long
 
    'Usa aquí el bitmap que quieres usar
    FileName = App.Path + "\fondo(3).bmp"
 
    X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, FileName, _
       SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
 
End Sub
Private Sub Picture4_Click()
Dim FileName As String
    Dim X As Long
 
    'Usa aquí el bitmap que quieres usar
    FileName = App.Path + "\fondo(4).bmp"
 
    X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, FileName, _
       SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
 
End Sub
 
son 4 picture box y en cada uno tengo una imagen diferente para cuando quiero cambiar una por otra solo bastaria con hacer click en uno de los picture box y se cambia automaticamente pero solo me funciona con dos de esos picture box
espero haberme explicado con claridad amigos
espero sus consejos.

Finalmente lo he solucionado

Encontre buscando en la web un codigo que modificando un poco la interface de mi  software me ha funcionado perfectamente amigos.

solo elimine los picture box y añadi al proyecto un filelistbox, dos checkbox y algun que otro componente, finalmente modifique un poco mi codigo y voila, el programa me funciona a la perfeccion.

Aqui os pongo el codigo por si alguien mas quiere aprovecharlo, y si quieren el programa para testearlo solo envienme un email a:
pedraosone@yahoo.es y se lo remito encantado.

 
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
Dim ruta As String
Const SPIF_UPDATEINIFILE = 1
Const SPI_SETDESKWALLPAPER = 20
Const SPI_SETDESKPATTERN = 21
Const SPIF_SENDWININICHANGE = &H2
 
Private Sub Check1_Click()
If Check1.Value = Checked Then
    Image1.Stretch = True
Else
    Image1.Stretch = False
End If
End Sub
 
Private Sub Check2_Click()
Image1.Visible = Check2.Value
End Sub
 
Private Sub Command1_Click()
Dim ruta As String
If Right(File1.Path, 1) <> "" Then
  ruta = File1.Path & "\" & File1.FileName
 Else
  ruta = File1.Path & "\" & File1.FileName
End If
x = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, _
    ruta, SPIF_UPDATEINIFILE Or _
    SPIF_SENDWININICHANGE)
End Sub
 
Private Sub Command2_Click()
Dim x As Long
    'Para sacar el papel Tapiz se le envía una cadena vacía en lpvParam
    x = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "", SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
    'MsgBox "El fondo de pantalla ha sido quitado", 64
 
End Sub
 
Private Sub File1_Click()
On Error Resume Next
Dim ruta As String
If Right(File1.Path, 1) <> "" Then
  ruta = File1.Path &  File1.FileName
 Else
  ruta = File1.Path & "\" & File1.FileName
End If
Image1.Picture = LoadPicture(ruta)
Label1.Visible = True
Label1.Caption = "Imagen: " + ruta
End Sub
 
Private Sub File1_DBLCLICK()
On Error Resume Next
Dim ruta As String
If Right(File1.Path, 1) <> "" Then
  ruta = File1.Path & File1.FileName
 Else
  ruta = File1.Path & "\" & File1.FileName
End If
x = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, _
    ruta, SPIF_UPDATEINIFILE Or _
    SPIF_SENDWININICHANGE)
Image1.Picture = LoadPicture(ruta)
Label1.Visible = True
Label1.Caption = "Imagen: " + ruta
End Sub
 
Private Sub File1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
On Error Resume Next
Dim ruta As String
If Right(File1.Path, 1) = "\" Then
  ruta = File1.Path & File1.FileName
 Else
  ruta = File1.Path & "\" & File1.FileName
End If
x = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, _
    ruta, SPIF_UPDATEINIFILE Or _
    SPIF_SENDWININICHANGE)
Image1.Picture = LoadPicture(ruta)
Label1.Visible = True
Label1.Caption = "Imagen: " + ruta
End If
End Sub
 
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then
End
End If
End Sub
 
Private Sub Form_Resize()
On Error Resume Next
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2 'Centra el formulario completamente
End Sub
 
 

Espero que os sea tan util como me lo ha sido a mi, gracias.