Obtener Wallpaper en XP
 

Existe alguna forma de saber cual es el wallpaper (Papel Tapiz, Fondo de Escritorio) que esta usando windows XP? Me refiero a saber cual esta configurado para mostrarse.

Saludos

Hola,

Código Delphi [-]
function GetWallpaperBitmap(): string;
const
  SPI_GETDESKWALLPAPER = $0073;
var
  wpFName: array [0..MAX_PATH] of char;
begin
  SystemParametersInfo(SPI_GETDESKWALLPAPER,MAX_PATH,@wpFName,0);
  result := wpFName;
end;

Según pude encontrarlo aquí... :)

Gracias, me vino al pelete, ya que no queria hacerlo leyendo el registro de windows. Ahora bien, tenes idea porque no puedo cambiarlo por codigo cuando la extensión no es BMP, por ejemplo JPG.

Probé con esto, pero los JPG no me los toma, y todos los wallpapers que tengo son JPG...

Código Delphi [-]
 Bitmap:='c:\file\back.bmp';
      SystemParametersInfo(SPI_SETDESKWALLPAPER,0,Pchar(BitMap),SPIF_UPDATEINIFILE +
                           SPIF_SENDWININICHANGE);

Saludos y gracias again

Pues la razón es que los wallpaper solo pueden ser bmps. Cuando tu escoges una imagen jpg como fondo de pantalla (desde el Internet Explorer, el "Vista previa", etc ...), lo que hacen es convertirla a bmp, guardar la imagen en una carpeta temporal y usar ese bmp como fondo de pantalla.

Otra cosa es que tengas el "Active Desktop" activado. Así si que puedes ver jpgs, gifs, paginas webs, etc ... como fondo de pantalla. Pero entonces se maneja de forma diferente.

De todas formas mira el truco 64. Creo que resolvera tu problema.

Hola,

Parece que no se admite sino el formato BMP. Tal vez Windows convierta los archivos JPG a BMP cuando selecciona uno. En la ayuda de la función "SystemParametersInfo" puede leerse esto en relación a la constante "SPI_SETDESKWALLPAPER":

En Torry's tienes un componente de nombre WallpaperChanger, que "admite" archivos JPG, empero, los convierte a BMP previamente. En todo caso tal vez te sea de algún modo útil. :)

Bueno, muchas gracias a ambos por las respuestas, acabo de probare las dos soluciones y a ver si andan de maravillas.

Gracias again, Saludos

No no, no me funcionan

Instalé el componente, pero no pasa nada, que puede ser??

Código Delphi [-]
  abfImage1.Picture.LoadFromFile('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
  WPChanger1.Wallpaper:='C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text;

Saludos

:confused: Probaste el truco que te recomende ???

Hola,

Conste que yo no miré siquiera el componente que enlazé... pero lo hize porque intuía que podías sacar tus propias conclusiones de él... o usarlo, si es que lo veías oportuno. Pero, en todo caso, si no funciona, el asunto parece claro: hasta Windows Vista no se admiten "wallpapers" que no sean archivos BMP, por lo tanto cualquier otro tipo de archivo hay que convertirlo a BMP para poder asignarlo como "wallpaper" en Windows.

Por ahí van los tiros del truco de Seoane. :)

Si, y no le puedo encontrar la vuelta, mira:

Código Delphi [-]
procedure TLocal.dxButton11Click(Sender: TObject);
var exten,root : string;
begin
root:=ExtractFilePath(Application.ExeName);
//Lo curioso de la línea que sigue, es que me toma los jpg, y digo curioso 
//por no decir raro, ya que me fije y el componente no admite otra ext. que
//no sea BMP, y me toma los JPG, cosa "e mandiga, vió?"
abfImage1.Picture.LoadFromFile('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
exten:=ExtractFileExt(ComboBox1.Text);
if (exten='JPG') then SetWallpaper('C:\WINDOWS\Web\Wallpaper'+ComboBox1.Text,root+'temp\nuevo.bmp')
else Exit;

end;

Voy a probar con la clasica reiniciada de compu.

"Close your windows, Open your Windows" (Microsoft Technical Support)

Saludos

Hola,

En el código de arriba veo dos cosas posiblemente problemáticas. Primero no compruebas si el archivo en cuestión existe o no. Puede parecer una tontería, pero, si no lo compruebas no sabrás si existe o no.

Y segundo, comparas el resultado de "ExtractFileExt" con "JPG", así, en mayúsculas, y creo recordar que esa función retorna el resultado en minúsculas... y que incluso llega a incluir el punto al principio, es decir, algo así en este caso: ".jpg".

Solo 2 cosas sobre tu código. Primero usas:

Código Delphi [-]
'C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text

Y luego usas:

Código Delphi [-]
'C:\WINDOWS\Web\Wallpaper'+ComboBox1.Text

Así que en uno sobra un '\' o falta en el otro.

Y también asegurate de que el directorio "root+'temp\" existe, y de que la variable root tiene el '\' al final.

Una vez corregido eso, podemos entrar a discutir el truco ;)

Hasta ahora llevo esto

Código Delphi [-]
procedure TLocal.FormShow(Sender: TObject);
var i:integer;
begin
ComboBox1.Clear;
  for i:=0 to FileListBox1.Items.Count-1 do
    begin
      ComboBox1.Items.Add(FileListBox1.Items.Strings[i]);
    end;
ComboBox1.ItemIndex:=0;
Edit1.Text:=GetWallpaperBitmap(); //Lo carga lo más bien
abfImage1.Picture.LoadFromFile(Edit1.Text);
end;

y esto

Código Delphi [-]
procedure TLocal.dxButton11Click(Sender: TObject);
var exten,root : string;
begin
root:=ExtractFilePath(Application.ExeName);
abfImage1.Picture.LoadFromFile('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
exten:=ExtractFileExt(ComboBox1.Text);
if (exten='JPG') then SetWallpaper('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text,root+'temp\nuevo.bmp');
Local.OnShow(self);
end;

Me sigue dejando el que estaba, chequié el registro de windows, y la clave permanece sin ser alterada.

No doy con la tecla :(

Lo de las barras solo salió mal acá, corté y pegué mal y lo retoque a ojo, se ve que se me pasó. Sabes que me adelanté a lo que haces mención y habia incluido estas lineas para chequear las rutas:

Código Delphi [-]
showmessage('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
showmessage(root+'temp\nuevo.bmp');

y las dos salen bien, el directorio existe, pero en ningun momento se crea el bmp. No se que pasa.

Vamos por partes. Si el bmp no se crea te tiene que salir un mensaje de error ,¿cual es?

No me sale absolutamente nada.

Este es el código completo, perdon por la desproligidad

Código Delphi [-]
unit Unit2;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dxCore, dxWinXPBar, StdCtrls, ExtCtrls, dxButtons, dxCheckCtrls,
  JvExControls, JvComCtrls, ExtDlgs,  abfControls, Jpeg, Registry, INIFiles,
  FileCtrl;
type
    TLocal = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox3: TGroupBox;
    dxWinXPBar2: TdxWinXPBar;
    Bevel1: TBevel;
    dxButton1: TdxButton;
    dxCheckbox5: TdxCheckbox;
    dxCheckbox6: TdxCheckbox;
    dxCheckbox7: TdxCheckbox;
    dxCheckbox8: TdxCheckbox;
    dxCheckbox9: TdxCheckbox;
    dxCheckbox10: TdxCheckbox;
    dxCheckbox11: TdxCheckbox;
    dxCheckbox12: TdxCheckbox;
    dxWinXPBar4: TdxWinXPBar;
    GroupBox5: TGroupBox;
    dxWinXPBar9: TdxWinXPBar;
    Label5: TLabel;
    Label6: TLabel;
    Edit5: TEdit;
    dxButton2: TdxButton;
    Label1: TLabel;
    Edit8: TEdit;
    dxButton3: TdxButton;
    dxCheckbox13: TdxCheckbox;
    Label2: TLabel;
    Edit9: TEdit;
    dxButton4: TdxButton;
    dxCheckbox14: TdxCheckbox;
    dxButton6: TdxButton;
    dxButton7: TdxButton;
    dxButton8: TdxButton;
    JvIPAddress1: TJvIPAddress;
    dxButton5: TdxButton;
    GroupBox2: TGroupBox;
    dxWinXPBar1: TdxWinXPBar;
    Label3: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    ComboBox1: TComboBox;
    Label7: TLabel;
    Edit2: TEdit;
    dxButton9: TdxButton;
    dxButton10: TdxButton;
    dxButton11: TdxButton;
    OpenPictureDialog1: TOpenPictureDialog;
    FileListBox1: TFileListBox;
    Image1: TImage;
    abfImage1: TabfImage;
    procedure dxButton1Click(Sender: TObject);
    procedure dxCheckbox11Click(Sender: TObject);
    procedure dxCheckbox8Click(Sender: TObject);
    procedure dxButton6Click(Sender: TObject);
    procedure dxButton9Click(Sender: TObject);
    procedure dxButton10Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure dxButton11Click(Sender: TObject);

  private
     { Private declarations }
     procedure NiTeMenees(var m: TWMWINDOWPOSCHANGED); message    
    WM_WINDOWPOSCHANGING ;
  
  public
    { Public declarations }
  end;
var
  Local: TLocal;
implementation
uses Unit1;

procedure TLocal.NiTeMenees(var m : TWMWINDOWPOSCHANGED);
   begin
  //       m.windowpos.x := Main.dxContainer3.Left+15;  {Left/Posicion X}
  //       m.windowpos.y := Main.dxContainer3.Top+40;  {Left/Posicion X}
   end;
function GetWallpaperBitmap(): string;
const
  SPI_GETDESKWALLPAPER = $0073;
var
  wpFName: array [0..MAX_PATH] of char;
begin
  SystemParametersInfo(SPI_GETDESKWALLPAPER,MAX_PATH,@wpFName,0);
  result := wpFName;
end;
procedure SetWallpaper(Original, Copia: string);
var
  Imagen: TPicture;
  Bitmap: TBitmap;
begin
  // Convertimos la imagen a bmp, y ajustamos su tamaño
  Imagen:= TPicture.Create;
  Bitmap:= TBitmap.Create;
  try
    Imagen.LoadFromFile(Original);
    Bitmap.Width:= GetSystemMetrics(SM_CXSCREEN);
    Bitmap.Height:= GetSystemMetrics(SM_CYSCREEN);
    Bitmap.Canvas.StretchDraw(Bitmap.Canvas.ClipRect,Imagen.Graphic);
    Bitmap.SaveToFile(Copia);
  finally
    Bitmap.Free;
    Imagen.Free;
  end;
  // Y ahora hacemos el cambio
  if FileExists(Copia) then
  begin
    with TRegistry.Create do
    begin
      RootKey:= HKEY_CURRENT_USER;
      if OpenKey('Control Panel\Desktop', FALSE) then
      begin
        WriteString('Wallpaper', Copia);
        WriteString('ConvertedWallpaper', Copia);
        WriteString('OriginalWallpaper', Copia);
        WriteString('TileWallpaper', '0');
        WriteString('WallpaperStyle', '2');
        CloseKey;
      end;
    end;
    SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar(Copia),SPIF_SENDCHANGE);
  end;
end;
{$R *.dfm}
procedure TLocal.dxButton1Click(Sender: TObject);
begin
Close;
end;
procedure TLocal.dxCheckbox11Click(Sender: TObject);
begin
if dxCheckBox11.Checked=True
 then begin
        dxCheckBox8.Enabled:=False;
        dxCheckBox6.Enabled:=False;
      end
 else begin
        dxCheckBox8.Enabled:=True;
        dxCheckBox8.Checked:=False;
        dxCheckBox6.Enabled:=True;
        dxCheckBox6.Checked:=False;
      end;
end;
procedure TLocal.dxCheckbox8Click(Sender: TObject);
begin
if dxCheckBox8.Checked=True
 then begin
        dxCheckBox11.Enabled:=False;
        dxCheckBox6.Enabled:=False;
      end
 else begin
        dxCheckBox11.Enabled:=True;
        dxCheckBox11.Checked:=False;
         dxCheckBox6.Enabled:=True;
        dxCheckBox6.Checked:=False;
      end;
end;
procedure TLocal.dxButton6Click(Sender: TObject);
begin
//ip servidor
JvIPAddress1.Text:='192.168.1.1';
//permisos servidor
dxCheckBox14.Checked:=True;
//extensiones

//licencia
 
end;
procedure TLocal.dxButton9Click(Sender: TObject);
begin
OpenPictureDialog1.Execute;
if OpenPictureDialog1.FileName<>''
then begin
  Edit2.Text:=OpenPictureDialog1.FileName;
  abfImage1.Picture.LoadFromFile(Edit2.Text);
end;
end;
procedure TLocal.dxButton10Click(Sender: TObject);
var tema:string;
begin
tema:=Trim(Edit2.Text);
if (tema<>'') then begin
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,Pchar(tema),SPIF_UPDATEINIFILE +
    SPIF_SENDWININICHANGE);
end;
Local.OnShow(self);
end;
procedure TLocal.FormShow(Sender: TObject);
var i:integer;
begin
ComboBox1.Clear;
  for i:=0 to FileListBox1.Items.Count-1 do
    begin
      ComboBox1.Items.Add(FileListBox1.Items.Strings[i]);
    end;
ComboBox1.ItemIndex:=0;
Edit1.Text:=GetWallpaperBitmap();
abfImage1.Picture.LoadFromFile(Edit1.Text);
end;
procedure TLocal.ComboBox1Change(Sender: TObject);
begin
abfImage1.Picture.LoadFromFile('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
end;
procedure TLocal.dxButton11Click(Sender: TObject);
var exten,root,tema : string;
begin
root:=ExtractFilePath(Application.ExeName);
abfImage1.Picture.LoadFromFile('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
tema:=Trim('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
exten:=ExtractFileExt(ComboBox1.Text);
if (exten='JPG')
    then SetWallpaper('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text,root+'temp\nuevo.bmp')
    else  SystemParametersInfo(SPI_SETDESKWALLPAPER,0,Pchar(tema),SPIF_UPDATEINIFILE + SPIF_SENDWININICHANGE);
showmessage('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
showmessage(root+'temp\nuevo.bmp');
Local.OnShow(self);
end;
end.

Bueno, encontre un error, resulta que esta linea

Código Delphi [-]
exten:=ExtractFileExt(ComboBox1.Text);

Trato a la extensión como una string, cuyo resultado me devueve, sea BMP o JPG lo siguiente: ".jpg" y ".bmp"

y cuando comparaba, lo hacia mal, me faltaba el puntito

Código Delphi [-]
if (exten='JPG')

asi que lo cambie por

Código Delphi [-]
if (exten='.JPG')

Y ahora si me escribe en el registro, y en el OnShow, detecta el nombre nuevo, ahora el tema esta que me muestra toda la pantalla gris, como cuando no ponemos ningun wallpaper, por que es?

Listo. Ya está, el error se solucionó cuando quite el tratamiento de la extensión, dejandolo asi

Código Delphi [-]
procedure TLocal.dxButton11Click(Sender: TObject);
var root : string;
begin
root:=ExtractFilePath(Application.ExeName);
abfImage1.Picture.LoadFromFile('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text);
SetWallpaper('C:\WINDOWS\Web\Wallpaper\'+ComboBox1.Text,root+'temp\nuevo.bmp');
Local.OnShow(self);
end;

Asi me funciona sea BMP o sea JPG, creandomelo en root+'temp\nuevo.bmp' perfectamente. Me parece que biene por ese lado, digamos una suerte de sensibilidad de ExtractFileExt a lo pChar y a lo pAnsiChar, cosa que desconozco, pero aun pifiandole me inclino por ese lado.

Aquí un ejemplito de como lo haría yo.