Visor de imagenes y cambiador de fondo (mi codigo)

Iniciado por pedraosone, 30 Julio 2009, 21:55 PM

0 Miembros y 1 Visitante están viendo este tema.

pedraosone

Hola a todos, una vez mas les escribo aunque en esta ocacion no es para pedirles su ayuda sino para mostrarles  mi ultimo proyecto ya terminado por si puedo contribuir a ayudar a alguien que al igual que yo este comenzando a programar.
Aquí les pongo una captura del resultado final de mi aplicación.



Este programa esta destinado a personas que apenas conocen de informatica para que les ayude a ver  las imágenes que tengan en su pc ademas de poder cambiarlas por el fondo del escritorio con un simple clic  o pulsando intro ademas de pulsando el boton  de cambiar fondo.
Para escribir este code me base en un ejemplo que encontre buscando por la web y adaptandolo a mi necesidad, aparte de la ayuda que me prestaron en este foro para resolver las dudas que me ivan surgiendo, y una vez terminado, aquí les dejo el code esperando que le sea util a alguien que comienza al igual que yo.

Code:
Código (vb) [Seleccionar]

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 = &H1
Const SPI_SETDESKWALLPAPER = 20
Const SPI_SETDESKPATTERN = 21
Const SPIF_SENDWININICHANGE = &H2

Private Sub Check1_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
SavePicture LoadPicture(ruta), "c:\windows\Foto.BMP"
ruta = "c:\windows\Foto.BMP"
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 envia una cadena vacia en lpvParam
    X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "", SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
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)
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
SavePicture LoadPicture(ruta), "c:\windows\Foto.BMP"
ruta = "c:\windows\Foto.BMP"
X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, _
    ruta, SPIF_UPDATEINIFILE Or _
    SPIF_SENDWININICHANGE)
Image1.Picture = LoadPicture(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
SavePicture LoadPicture(ruta), "c:\windows\Foto.BMP"
ruta = "c:\windows\Foto.BMP"
X = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, _
    ruta, SPIF_UPDATEINIFILE Or _
    SPIF_SENDWININICHANGE)
Image1.Picture = LoadPicture(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

Private Sub Dir1_Change()
File1.Path = Dir1.Path
Label1.Visible = File1.ListCount > 0
If Label1.Visible Then
File1.ListIndex = 0
End If
End Sub
 

Y sin mas que dar las gracias a todos los que me ayudaron  me despido hasta otra ocacion.

seba123neo

Hola, esta la api GetWindowsDirectory pero sin embargo en el programa sacas la ruta relativamente poniendo "c:\windows..." ¿y que pasa si tengo disco D?...aparte hay un monton de duplicidad de codigo fuente...este codigo podria quedar a menos de la mitad de lo que es ahora...

saludos.
La característica extraordinaria de las leyes de la física es que se aplican en todos lados, sea que tú elijas o no creer en ellas. Lo bueno de las ciencias es que siempre tienen la verdad, quieras creerla o no.

Neil deGrasse Tyson

pedraosone

hola nuevamente, yo la verdad que de apis se muy poco y esa la encontre en un ejemplo y despues de ver como funcionaba pues vi que me venia bien para mi proyecto y por eso la use, referente a la duplicidad del codigo tienes toda la razon, intentare ver la forma de crear una funcion y llamarla desde donde sea nesesario, en cuanto me sea posible me pondre a intentar reducir el codigo amigo
gracias por el comentario.