Obtener Wallpaper en XP

[MaMu]

Empezado por seoane

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

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.

[[seoane]]

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

[MaMu]

Empezado por seoane

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.

[MaMu]

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?

[MaMu]

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.

[[seoane]]

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

[dec]

Hola,

Cuando comparamos cadenas con funciones que retornan cadenas... suele forzarse el "case" de estas de modo que podamos estar seguros de qué comparamos. Esto es, nos valemos de funciones como "LowerCase" o "UpperCase":

Código Delphi [-]
if UpperCase(ExtractFileExt(FArchivo)) = '.JPG' then
  {...}

[[seoane]]

Empezado por dec

Cuando comparamos cadenas con funciones que retornan cadenas... suele forzarse el "case" de estas de modo que podamos estar seguros de qué comparamos. Esto es, nos valemos de funciones como "LowerCase" o "UpperCase"

O usamos AnsiSameText

De todas formas, ya que carga la imagen previamente en un TImage, por que no comprobar el formato gráfico de la imagen cargada, en vez de andar comprobando su extensión.