Cambiar wallpaper

[seoane]

Este codigo surgio cuando estaba encargado del mantenimiento de mas de 100 equipos, estos tenian que mostrar siempre el mismo fondo de pantalla, y los usuarios tenian muchas ganas de jugar. Los directivas de grupo para evitar el cambio fallan en diversas circunstancias (IExplorer, Vista previa) asi que corte por lo sano y como script de inicio de sesion coloque esto, que machaca cualquier configuracion previa y coloca el fondo correcto.

uses Registry, Jpeg;

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;


Ejemplo de uso:

SetWallpaper('d:\Fondo.jpg','d:\Copia.bmp');