program WechselHintergrund;
uses Windows,Sysutils,Graphics,Classes,Registry,JPEG,
ActiveX,ShellAPI,ShlObj;
var
Liste : Tstringlist;
Zufall : Integer;
bmp: TBitmap;
mjpeg: TJpegImage;
Datei:
String;
Function ChangeWallpaper(FileName:
String; Style: Integer): Boolean;
Var
reg: TRegistry;
wp:
Array[0..$FF]
Of Char;
Begin
reg := TRegistry.Create;
Try
reg.RootKey := HKEY_CURRENT_USER;
If reg.OpenKey('
\Control Panel\desktop\', True)
Then
Begin
If (Style = 1)
Then
reg.WriteString('
TileWallpaper', '
1')
Else
reg.WriteString('
TileWallpaper', '
0');
reg.WriteString('
WallpaperStyle', IntToStr(Style));
End;
Finally
reg.Free;
End;
StrPCopy(wp, FileName);
Result := SystemParametersInfo(spi_SetDeskWallpaper, 0, @wp, spif_UpdateIniFile);
End;
function GetAllFiles(mask:
string): TStringlist;
{....}
end;
function GetSpecialFolder(hWindow: HWND; Folder: Integer):
String;
var
pMalloc: IMalloc;
pidl: PItemIDList;
Path: PChar;
begin
// get IMalloc interface pointer
if (SHGetMalloc(pMalloc) <> S_OK)
then begin
MessageBox(hWindow, '
Couldn''
t get pointer to IMalloc interface.',
'
SHGetMalloc(pMalloc)', 16);
Exit;
end;
// retrieve path
SHGetSpecialFolderLocation(hWindow, Folder, pidl);
GetMem(Path, MAX_PATH);
SHGetPathFromIDList(pidl, Path);
Result := Path;
FreeMem(Path);
// free memory allocated by SHGetSpecialFolderLocation
pMalloc.Free(pidl);
end;
//------------------------------------------------------------
begin
randomize;
Liste := Tstringlist.create;
Liste := GetAllFiles(Extractfilepath(ParamStr(0))+'
*.jpg');
if Liste.count = 0
then
halt;
Zufall := random(Liste.count);
if fileexists(Liste[Zufall])
then
begin
try
mjpeg := TJpegImage.Create;
mjpeg.LoadFromFile(Liste[Zufall]);
bmp:=TBitmap.Create;
bmp.Assign(mjpeg);
Datei := GetSpecialFolder(0,28) + '
\Microsoft\Wallpaper1.bmp';
bmp.SaveToFile(Datei);
ChangeWallpaper(Datei,2);
Liste.Free;
except
end;
end;
end.