تغییر wallpaper

[Batman]

با سلام
دوستان میخواستم بپرسم چجوری میتونم مثل برنامه هایی شبیه webshot
wallpaper ویندوز رو تغییر بدم
ممنونم

[Touska]

با تشکر از آقای Google :

How do you change the Desktop wallpaper for Windows using Delphi?



procedure TForm1.Button1Click(Sender: TObject);
var
PicPath: String;
begin
PicPath := 'C:\WINNT\Prairie Wind.bmp';
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pChar(PicPath), SPIF_SENDCHANGE)
end;


منبع : سایت Code Gear

[aserfg]

SystemParametersInfo (SPI_SETDESKWALLPAPER, 0, 'Sample.bmp',0);

[zman123456]

با سلام
من این دو تا کد رو امتحان کردم ولی Desktop من رو خالی کرد.یعنی عکسی رو براش قرار نداد.آدرس و نام عکس هم درسته.هم نسبی دادم و هم مطلق.

[aserfg]

علت اینه که تصویر باید .bmpباشه

[zman123456]

دقیقا.خودم هم به این نتیجه رسیدم.وقتی فهمیدم که اینو نوشته بودم.

[Batman]

با سلام
دوستان نمیدونم چه کسی تاپیک رو به عنوان راه حل انتخاب کرده اما فکر کنم کلمه عبورم لو رفته
در عین حال این کدها همه bmp رو پشتیبانی میکنه
آیا کدی وجود داره که تمام فرمتهای تصویر رو جواب بده که دیگه نیازی به تبدیل پسوند نباشه
ممنونم

[Batman]

دوستان کسی نظری نداره؟

[Valadi]

جناب Batman
این با 3 روش مختلف
این کد تست بزن با تغییر نام و پسوند فایل
ضمنا باید کامپونت png , gif قبلا نصب کرده باشی

uses
Registry;

procedure SetWallpaper(sWallPaperBMPPath: string; bTile: Boolean);
var
reg: TRegIniFile;
begin
reg := TRegIniFile.Create('Control Panel\Desktop');
try
with reg do
begin
WriteString('', 'Wallpaper', sWallPaperBMPPath);
WriteString('', 'TileWallpaper', IntToStr(Ord(bTile)));
end;
finally
reg.Free;
end;
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;

// 2. Way:

procedure TForm1.Button1Click(Sender: TObject);
var
sWallPaperBMPPath: string;
begin
sWallPaperBMPPath := 'C:\[WinDIR]\wall.bmp';
if not SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Pointer(sWallPaperBMPPath),
SPIF_SENDWININICHANGE) then
ShowMessage('Succesful.')
else
ShowMessage('Failed!');
end;


// 3. Set the wallpaper for the Active Desktop.



uses
ShlObj, ComObj;


function ChangeWallpaper(aFile: String): Boolean;
const
CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
hObj: IUnknown;
ADesktop: IActiveDesktop;
str: string;
wstr: PWideChar;
begin
hObj := CreateComObject(CLSID_ActiveDesktop);
ADesktop := hObj as IActiveDesktop;
wstr := AllocMem(MAX_PATH);
try
StringToWideChar(aFile, wstr, MAX_PATH);
ADesktop.SetWallpaper(wstr, 0);
ADesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
finally
FreeMem(wstr);
end;
end;

[Batman]

راه حل سوم با تمام فرمتها کار میکنه