• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

softklin

[Resolvido] Trocar o wallpaper do ambiente de trabalho

10 mensagens neste tópico

Olá pessoal.

Estou a desenvolver uma pequena aplicação que tem como objectivo trocar o wallpaper. Já pesquisei como trocar o wallpaper via código de VB e encontrei algumas soluções, desde a inclusão de uma biblioteca, a modificar chaves de registo.

Pois bem, o máximo que consegui fazer foi remover o wallpaper actual e fazer com que o ambiente de trabalho ficasse com uma cor sólida. Deixo aqui o código para esta "proeza":

' temos de converter para bitmap
Dim img As Image = Image.FromFile(lstImages.SelectedItem)
Dim bitmap As New Bitmap(img, img.Width, img.Height)
Dim theName As String = Application.StartupPath & "\Wallpaper1.bmp"
bitmap.Save(theName)

Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "Wallpaper", theName)
Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "OriginalWallpaper", theName)
Microsoft.Win32.Registry.SetValue("HKEY_CURRENT_USER\Control Panel\Desktop", "ConvertedWallpaper", lstImages.SelectedItem)
SystemParametersInfo(20, 0, theName, 1)

bitmap.Dispose()
img.Dispose()

O caminho completo da imagem vem de uma listbox, e está correcto, já confirmei. o bitmap que tento criar na mesma directoria do programa também funciona, e é gerado correctamente. A única coisa que não funciona é o wallpaper! :\

Detalhe: para por a função SystemParametersInfo a funcionar, tive de incluir uma linha adicional:

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer

(sorry pela linha...)

Alguém tem alguma pista para a razão de isto não funcionar? NOTA: estou em Windows XP, ainda não testado em Vista. Uso o VB 2008 Express.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Obrigado pela resposta, jpaulino.

Infelizmente, testei o código, mas deu o mesmo resultado, ou seja, uma cor sólida no ambiente de trabalho. Contudo adaptei à minha situação, pus o código assim:

' temos de converter para bitmap
Dim img As Image = Image.FromFile(lstImages.SelectedItem)
Dim bitmap As New Bitmap(img, img.Width, img.Height)
Dim theName As String = Application.StartupPath & "\Wallpaper1.bmp"
bitmap.Save(theName)

Dim key As Microsoft.Win32.RegistryKey = My.Computer.Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True)
' centrar o wallpaper
key.SetValue("WallpaperStyle", "1")
key.SetValue("TileWallpaper", "0")

SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, theName, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)

bitmap.Dispose()
img.Dispose()

As constantes e declaração do user32.dll estão definidas como está na página, copy/paste. No entanto, vou testar numa máquina virtual que tenho aqui, para ver se dá o mesmo erro, pode ser uma situação especifica do meu computador...

EDIT: Também não funciona ;) O mesmo problema, fica com uma cor sólida...

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Não testei mais, porque nem sei o que hei-de fazer :)

Estava à espera do teu feedback, como disseste que ias testar. Mas agora que vejo, o artigo tem data de 2006 e os códigos que tenho visto também não eram muito mais recentes, será alguma funcionalidade bloqueada pelo SP2 ou alguma actualização?

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Olá,

Desculpa lá mas é tanta coisa que ficam sempre coisas para trás! Hoje ao dar uma olhada nos emails em atraso lá vi este  :-[

Não sei se já conseguiste ou se ainda precisas, mas de qualquer maneira vê este exemplo:

Declaração da API e função:

    Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer
    Private Const SPI_SETDESKWALLPAPER = 20
    Private Const SPIF_UPDATEINIFILE = &H1

    ''' <summary>
    ''' Muda o wallpaper do computador
    ''' </summary>
    ''' <param name="imagePath">Endereço da imagem</param>
    ''' <remarks></remarks>
    Private Sub SetWallpaper(ByVal imagePath As String)

        ' Verifica se o ficheiro existe
        If Not IO.File.Exists(imagePath) Then
            Throw New Exception("O ficheiro não existe!")
        End If

        Try

            ' Cria o ficheiro *.bmp
            Dim imgName As String = IO.Path.ChangeExtension(imagePath, "bmp")
            Dim bm As Bitmap = Image.FromFile(imagePath)
            bm.Save(imgName, ImageFormat.Bmp)

            ' Define o novo wallpaper
            SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, imgName, SPIF_UPDATEINIFILE)

        Catch ex As Exception
            Throw New Exception(ex.Message)
        End Try

    End Sub

Depois para utilizar é só fazer:

    Private Sub btnWallpaper_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnWallpaper.Click
        SetWallpaper("c:\headerphoto07.jpg")
    End Sub

Espero que ainda ajude!

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Jpaulino, mesmo na altura certa! :D Já estava a desistir da ideia, mas este código veio mesmo a calhar!

Funciona muito bem, e troca de imediato o wallpaper no XP. Hei-de testar no Vista, mas mesmo já dando no XP serve bem :)

Obrigado pela tua ajuda mais uma vez, está resolvido!

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Jpaulino, mesmo na altura certa! :) Já estava a desistir da ideia, mas este código veio mesmo a calhar!

Funciona muito bem, e troca de imediato o wallpaper no XP. Hei-de testar no Vista, mas mesmo já dando no XP serve bem :)

Obrigado pela tua ajuda mais uma vez, está resolvido!

Ainda bem que foi a tempo :D

No Vista não testei, porque não uso, mas depois diz se funciona também no Vista (se conseguires testar).

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Boas, jpaulino, o código que forneceste também funciona no Windows Vista :(

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora