更换墙纸 // 1.Way:usesRegistry;procedure SetWallpaper(sWallPaperBMPPath: string; bTile: Boolean);varreg: TRegIniFile;beginreg := TRegIniFile.Create('Control Panel');trywith reg dobeginWriteString('', 'Wallpaper', sWallPaperBMPPath);WriteString('', 'TileWallpaper', IntToStr(Ord(bTile)));end;finallyreg.Free;end;SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);end;// 2. Way:procedure TForm1.Button1Click(Sender: TObject);varsWallPaperBMPPath: string;beginsWallPaperBMPPath := 'C:[WinDIR].bmp';if not SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Pointer(sWallPaperBMPPath),SPIF_SENDWININICHANGE) thenShowMessage('Succesful.')elseShowMessage('Failed!');end; // 3. Set the wallpaper for the Active Desktop.{You may have noticed that using SystemParametersInfo to change the wallpaperwhen ActiveDesktop is turned on doesn't work. The reason is because you needto use the IActiveDesktop COM interface. Using SystemParametersInfo still works,but it doesn't update the wallpaper.Requires Internet Explorer 4.0 or later).} usesShlObj, ComObj; function ChangeWallpaper(aFile: String): Boolean;constCLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';varhObj: IUnknown;ADesktop: IActiveDesktop;str: string;wstr: PWideChar;beginhObj := CreateComObject(CLSID_ActiveDesktop);ADesktop := hObj as IActiveDesktop;wstr := AllocMem(MAX_PATH);tryStringToWideChar(aFile, wstr, MAX_PATH);ADesktop.SetWallpaper(wstr, 0);ADesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);finallyFreeMem(wstr);end;end;**************************************活动桌面下更换墙纸：uses shlobj;获得墙纸procedure TForm1.Button1Click(Sender: TObject);varADeskTop:IActiveDesktop;wallpaper:PwideChar;beginADeskTop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;GetMem(wallpaper,128);ADeskTop.GetWallpaper(wallpaper,128,0);ShowMessage(string(wallpaper));FreeMem(wallpaper);end;设置墙纸procedure TForm1.Button1Click(Sender: TObject);varADeskTop:IActiveDesktop;wallpaper:PwideChar;beginADeskTop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;wallpaper:='d:2.bmp';ADeskTop.SetWallpaper(wallpaper,0);ADeskTop.ApplyChanges(AD_APPLY_ALL);end;
// 1.Way:usesRegistry;procedure SetWallpaper(sWallPaperBMPPath: string; bTile: Boolean);varreg: TRegIniFile;beginreg := TRegIniFile.Create('Control Panel');trywith reg dobeginWriteString('', 'Wallpaper', sWallPaperBMPPath);WriteString('', 'TileWallpaper', IntToStr(Ord(bTile)));end;finallyreg.Free;end;SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);end;// 2. Way:procedure TForm1.Button1Click(Sender: TObject);varsWallPaperBMPPath: string;beginsWallPaperBMPPath := 'C:[WinDIR].bmp';if not SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Pointer(sWallPaperBMPPath),SPIF_SENDWININICHANGE) thenShowMessage('Succesful.')elseShowMessage('Failed!');end; // 3. Set the wallpaper for the Active Desktop.{You may have noticed that using SystemParametersInfo to change the wallpaperwhen ActiveDesktop is turned on doesn't work. The reason is because you needto use the IActiveDesktop COM interface. Using SystemParametersInfo still works,but it doesn't update the wallpaper.Requires Internet Explorer 4.0 or later).} usesShlObj, ComObj; function ChangeWallpaper(aFile: String): Boolean;constCLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';varhObj: IUnknown;ADesktop: IActiveDesktop;str: string;wstr: PWideChar;beginhObj := CreateComObject(CLSID_ActiveDesktop);ADesktop := hObj as IActiveDesktop;wstr := AllocMem(MAX_PATH);tryStringToWideChar(aFile, wstr, MAX_PATH);ADesktop.SetWallpaper(wstr, 0);ADesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);finallyFreeMem(wstr);end;end;**************************************活动桌面下更换墙纸：uses shlobj;获得墙纸procedure TForm1.Button1Click(Sender: TObject);varADeskTop:IActiveDesktop;wallpaper:PwideChar;beginADeskTop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;GetMem(wallpaper,128);ADeskTop.GetWallpaper(wallpaper,128,0);ShowMessage(string(wallpaper));FreeMem(wallpaper);end;设置墙纸procedure TForm1.Button1Click(Sender: TObject);varADeskTop:IActiveDesktop;wallpaper:PwideChar;beginADeskTop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;wallpaper:='d:2.bmp';ADeskTop.SetWallpaper(wallpaper,0);ADeskTop.ApplyChanges(AD_APPLY_ALL);end;