怎樣即時更換壁紙?(100分)

  • 主题发起人 主题发起人 DINGHELLO
  • 开始时间 开始时间
D

DINGHELLO

Unregistered / Unconfirmed
GUEST, unregistred user!
我在寫一個更換壁紙的程序,用了下面一段代碼可以把圖片信息寫入到注冊表中,但要重新啟動后才會更換,
 Reg.Rootkey:=Hkey_Current_User;
Reg.OpenKey('Control Panel/Desktop',False);
Reg.WriteString ('TileWallPaper', '1');
Reg.WriteString('Wallpaper',PicFileName);
Systemparametersinfo(SPI_SETDESKWallpaper,0,nil,SPIF_SendChange);

我現在想執行某名代榪以后馬上就可更換,請各位大俠幫忙!


 
systemparametersinfo(SPI_SETDESKWALLPAPER ,0,pchar(picFileName),SPIF_UPDATEINIFILE );
就可以了
 
systemparametersinfo(SPI_SETDESKWALLPAPER ,0,pchar(picFileName),SPIF_UPDATEINIFILE );
我也試了,還是一樣,我想實現像ACDsee那種馬上更換的效果!
謝謝!
 
哪位大俠幫我一下?
 
哈哈,很容易. 只是分少了一點!
 
不會吧,一百分還少呀,我家境貧寒,兄台幫忙呀!!
 
const
PIC_FILENAME = 'c:/a';
procedure LoadPic(img: TImage);
var
strl: TStringList;
begin
strl := TStringList.Create;
try
strl.LoadFromFile(PIC_FILENAME);
img.Picture.LoadFromFile(strl.Strings[0]);
except
end;
strl.Free;
end;

procedure SavePic(str: string);
var
strl: TStringList;
begin
strl := TStringList.Create;
strl.Add(str);
try
strl.SaveToFile(PIC_FILENAME);
except
end;
strl.free;
end;

procedure Tform.SpeedButton5Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
Image1.Picture.LoadFromFile(OpenPictureDialog1.Filename);
SavePic(OpenPictureDialog1.Filename);
width := width -1;
width := width+1 ;
end;
end;

procedure Tform.FormShow(Sender: TObject);
begin
LoadPic(image1);

end;

給分吧!
 
获得墙纸
procedure TForm1.Button1Click(Sender: TObject);
var
ADeskTop:IActiveDesktop;
wallpaper:PwideChar;
begin
ADeskTop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
GetMem(wallpaper,128);
ADeskTop.GetWallpaper(wallpaper,128,0);
ShowMessage(string(wallpaper));
FreeMem(wallpaper);
end;
设置墙纸
procedure TForm1.Button1Click(Sender: TObject);
var
ADeskTop:IActiveDesktop;
wallpaper:PwideChar;
begin
ADeskTop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
wallpaper:='d:/2.bmp';
ADeskTop.SetWallpaper(wallpaper,0);
ADeskTop.ApplyChanges(AD_APPLY_ALL);
end;
获得桌面主题数
procedure TForm1.Button1Click(Sender: TObject);
var
adesktop:IActiveDesktop;
Count:integer;
begin
adesktop:=createcomobject(clsid_activedesktop) as IActivedesktop;
adesktop.GetDesktopItemCount(Count,0);
ShowMessage(IntToStr(Count));
end;
???????????????????????????
adesktop:=createcomobject(clsid_activedesktop) as IActivedesktop;
Acomponent.dwsize:=SizeOf(TShcomponent);
OleCheck(adesktop.GetDesktopItem(1,acomponent,0));
 
謝謝,我試下,如果可以馬上給分!
 
还有一些资料:
1.获取桌面窗口的HDC。



API 定义如下:



GetDC函数用于获取指定窗口的图形设备描述表



HDC GetDC(



HWND hWnd // 窗口句柄



);



例如:



DeskTopDC:HDC;//定义桌面窗口的图形设备描述表句柄



DeskTopDC:=GetDC(0);



或者DeskTopDC:=GetDC(GetDesktopWindow());



2.创建一个内存位图,把桌面中将要绘图的区域,保存到内存位图中去,以便绘图完成时恢复桌面。为此我定义了一个函数:



procedure savebackground(BKCanvas :TCanvas;//内存位图的画布对象



sp_w:integer;//要保存区域的宽度



sp_h :integer ;//要保存区域的高度



nx:integer;//要保存区域的X坐标



ny:integer);//要保存区域的Y坐标



3.将动画对象透明地拷贝到桌面的绘图区域,笔者用了一个GDIAPI函数方便地实现了此功能。



定义如下:



BOOL TransparentBlt(HDC hdcDest,//目标图形设备描述表句柄



int nXOriginDest,//绘图矩形的X坐标



int nYOriginDest,//绘图矩形的Y坐标



int nWidthDest,//绘图矩形的宽度



int hHeightDest,//绘图矩形的高度



HDC hdcSrc,//源图形设备描述表句柄



int nXOriginSrc,//源绘图矩形的X坐标



int nYOriginSrc,//源绘图矩形的Y坐标



int nWidthSrc,//源绘图矩形的宽度



int nHeightSrc,//源绘图矩形的高度



UINT crTransparent//设置透明色RGB(r,g,b)



);



注意:



Windows NT: 需要5.0或以上版本



Windows: 需要 Windows 98 或 以上版本



其它低版本不支持。



此函数包含在msimg32.dll.



笔者定义了一个tranbit函数来动态调用TransparentBlt函数,具体定义见第三节。



4.将第二步生成的内存位图拷贝到桌面。这样一帧动画就显示完成。不断循环1-4步,你就能看到连续的动画场景了。



3.具体代码


以下是一个演示程序,在DELPHI5.0+WINDOWS2000P中调试通过。创建一个窗体Form1,放上两个Image控件,命名为Image1,Image2,再放上一个Timer控件,命名为Timer1。准备两张位图,一张放入Image1,另一张放入Image2。笔者用了如下样式的位图(截取了一部分),你可以自己画动画对象,也可以借用别人的,笔者就是用微软画的图片。






从图片你可以看出,图片中包括了许多连续的动画帧,一张图片完成一个动作,如旋转一周等,每帧动画大小完全一样,除了动画对象其它像素用一种透明色填充。好了你可以看具体的代码了。







unit Unitmain;



interface



uses



Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,



ExtCtrls, StdCtrls,mmsystem;







type



TForm1 = class(TForm)



Timer1: TTimer;//爆炸定时器



Image1: TImage;//储存爆炸的图片



Image2: TImage;//储存飞行器的图片



procedure Timer1Timer(Sender: TObject);



procedure FormCreate(Sender: TObject);



procedure FormClose(Sender: TObject; var Action: TCloseAction);



private



{ Private declarations }



DeskTopDC:HDC;//桌面窗口的图形设备描述表句柄



stop:boolean;//控制循环的变量



expnum:integer;//爆炸的当前次数



procedure Explode(X:integer;Y:integer);//爆炸函数



procedure shipmove(X:integer;Y:integer);//飞行器函数



public



{ Public declarations }



end;







var



Form1: TForm1;







implementation







{$R *.DFM}







//保存桌面背景



procedure savebackground(BKCanvas :TCanvas;



sp_w:integer;



sp_h :integer ;



nx:integer;



ny:integer);



var sc:TCanvas;



begin



sc:=TCanvas.Create;



try



sc.Handle:=GetDC(0);



bkcanvas.CopyRect( rect(0,0,sp_w, sp_h), sc,rect(nx, ny, nx+sp_w, ny+sp_h));



ReleaseDC(0, sc.handle);



finally



sc.free;



end;



end;







//透明拷贝图像函数



//静态调用API函数TransparentBlt



procedure tranbit(hdcDest:HDC;



nXOriginDest:integer;



nYOriginDest:integer;



nWidthDest:integer;



hHeightDest:integer;



hdcSrc:HDC;



nXOriginSrc:integer;



nYOriginSrc:integer;



nWidthSrc:integer;



nHeightSrc:integer;



crTransparent:UINT) ;



Var



LibHandle:HWND;//动态连接库句柄



//函数原型定义



DllName:Procedure(hdcDest:HDC;



nXOriginDest:integer;



nYOriginDest:integer;



nWidthDest:integer;



hHeightDest:integer;



hdcSrc:HDC;



nXOriginSrc:integer;



nYOriginSrc:integer;



nWidthSrc:integer;



nHeightSrc:integer;



crTransparent:UINT);Stdcall;



begin



//以下是静态调用dll中函数的例行公事



LibHandle:=LoadLibrary('msimg32.dll');



if LibHandle<32 then



begin



MessageBox(Form1.Handle,'Not Found msimg32.dll','Error',0);



Exit;



end;



@DllName:=GetProcAddress(LibHandle,'TransparentBlt');



if @DllName=nil then



begin



MessageBox(Form1.Handle,'Not Found TransparentBlt in msimg32.dll','Error',0);



FreeLibrary(LibHandle);



Exit;



end;



try



TransparentBlt(hdcDest,



nXOriginDest,



nYOriginDest,



nWidthDest,



hHeightDest,



hdcSrc,



nXOriginSrc,



nYOriginSrc,



nWidthSrc,



nHeightSrc,



crTransparent);



finally



FreeLibrary(LibHandle);



end;



end;







//爆炸函数



//在桌面的X,Y坐标处发生爆炸



procedure TForm1.Explode(X:integer;Y:integer);



var



BitMapB : TBitMap;//保存桌面指定区域的内存位图



w:integer;//一帧动画的宽度



h:integer;//一帧动画的高度



i:integer;



j:integer;



begin



BitMapB:=TBitMap.Create;



try



//动画位图为4*5=20帧



w:=Image1.Width div 4;//计算每帧的宽度



h:=image1.Height div 5;//计算每帧的高度



//初始化内存为图的大小



BitMapB.Height :=h;



BitMapB.Width :=w;



//保存桌面上指定区域的位图



//注意,由于爆炸是在同一位置完成的,所以只要保存爆炸区域一次就行了。



savebackground(BitMapB.canvas,w,h,X,Y);



for i:=0 to 4 do



begin



for j:=0 to 3 do



begin



//把相应帧画到桌面上



tranbit(DeskTopDC ,x,y,w,h,



image1.Canvas.Handle,j*w,i*h,w,h,RGB(208,2,178));



Sleep(20);//显示速度太快,停顿20毫秒



//恢复桌面



bitblt(DeskTopDC,X,Y,w,h,BitMapB.Canvas.handle,0,0,srccopy);



end;



end;



finally



BitMapB.Free;



end;



end;







//飞行器的飞行函数



//参数x,y指定飞行器飞行的目的地



procedure TForm1.shipmove(X:integer;Y:integer);



var



w:integer;



h:integer;



i:integer;



j:integer;



k:integer;



l:integer;



BitMapB : TBitMap;



begin



Randomize();



BitMapB:=TBitMap.Create;



try



//动画位图为4*16-3帧空帧=61帧



w:=Image2.Width div 4;



h:=image2.Height div 16;



BitMapB.Height :=h;



BitMapB.Width :=w;



k:=0;



l:=0;



while not stop do



for i:=0 to 15 do



for j:=0 to 3 do



begin



if (i=15) and (i>0) then break;//如果是空帧就不画了



//保存桌面上指定区域的位图



//注意,由于飞行是在不同位置完成的,所以要保存即将被绘图的桌面区域



savebackground(BitMapB.canvas,w,h,k,l);



tranbit(DeskTopDC ,k,l,w,h,image2.Canvas.Handle,j*w,i*h,w,h,RGB(208,2,178));







sleep(10);



bitblt(DeskTopDC,k,l,w,h,BitMapB.Canvas.handle,0,0,srccopy);



if(k<x)then k:=k+1;



if(l<y)then l:=l+1;



if timer1.Enabled =false then



if(k>x-10)then//到达目的地就停止飞行,并引爆炸弹



begin



stop:=true;



timer1.Enabled :=true;//炸弹引爆器



end;



end;



finally



BitMapB.Free;



end;



end;







procedure TForm1.Timer1Timer(Sender: TObject);



var



x,y:integer;



begin







if(expnum = 0) then



begin



Explode(screen.width div 2-20,screen.Height div 2-20);



sndPlaySound('explosion.wav',SND_NOSTOP);



expnum:=expnum+1;



end



else if expnum<10 then//爆炸最多10次



begin



//产生随机位置



x:=Random(screen.Width-100);



y:=Random(Screen.Height-100);



Explode(x,y);//爆炸



sndPlaySound('explosion.wav',SND_NOSTOP);//播放爆炸声音



expnum:=expnum+1;



end



else



begin



stop:=true;



timer1.Enabled :=false;



close();



end;



end;







procedure TForm1.FormCreate(Sender: TObject);



begin



DeskTopDC:=GetDC(0);



chdir(ExtractFilePath(application.ExeName));



stop:=false;



expnum:=0;



//飞行器开始飞行,目的地为屏幕中央



self.shipmove(screen.width div 2,screen.Height div 2);



end;







procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);



begin



stop:=true;



Timer1.Enabled :=false;



ReleaseDC(0, DeskTopDC);



end;







end.

 
IActiveDesktop這種類型要引用哪個單元?
 
41426277: 引用 shlobj,ComObj 兩個單元后,用你的代碼就搞定了,謝謝!
 
我的不比41426277提供的好嗎?
強烈要求補分!
 
weifang兄,你的代碼我運行后出現錯誤,就沒再去試了,我看不懂你的代碼是實現什么的,而 41426277的可以實現我的功能,所以給分給他,不好意思!
 
后退
顶部