如何用代码将jpg,swf,gif文件设为墙纸

Question

如何用代码将jpg,gif或swf文件设为墙纸

Answer 1

转换为bmp，然后调用一个windows的Api函数找找，由类似的代码

Answer 2

JPG必须ActiveDesktop才支持，代码如下：   
  uses   comobj,shlobj;   
    
  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;     
  其他的暂时没找到

Answer 3

procedure  ZoomBmp(Source:   String;   dWidth,   dHeight:   Integer;   var   des:   TBitmap);
var
      ori,imagen:   TBitmap;
      dispositivo_o,   dispositivo_d:   HDC;   
      pepito:   HBitmap;   
begin
  try
      ori   :=   Tbitmap.Create;   
      des   :=   TBItmap.Create;
      imagen :=  TBitmap.Create;
      imagen.LoadFromFile(Source);
      ori.handle   :=   imagen.handle;   
      des.width   :=   dWidth;   
      des.height   :=   dHeight;   
      dispositivo_o   :=   CreateCompatibleDC(0);   
      dispositivo_d   :=   CreateCompatibleDC(0);   
      SelectObject(dispositivo_o,   ori.handle);   
      pepito   :=   SelectObject(dispositivo_d,   des.handle);   
      SetStretchBltMode(dispositivo_d,     STRETCH_HALFTONE);   
      StretchBlt(dispositivo_d,   0,   0,   dWidth,   dHeight,   dispositivo_o,   0,   0,   ori.width,   ori.height,   SRCCOPY);   
      SelectObject(dispositivo_d,   pepito);
  finally
      ori.Free;
      DeleteObject(pepito);
      DeleteDC(dispositivo_o);
      DeleteDC(dispositivo_d);
  end;
end;//==============================================================================
//转换JPG到BMP格式**************************************************************
//==============================================================================
procedure JPG2BMP(const Source, Target:string);
var
    JPG: TJpegImage;
    BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  JPG := TJpegImage.Create;
  try
    JPG.LoadFromFile(Source);
    BMP.Assign(JPG);
    BMP.SaveToFile(Target);
  finally
    BMP.free;
    JPG.Free;
  end;
end;procedure GetBMPSize(Source:String;var x,y:Integer);
var
    BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  try
    BMP.LoadFromFile(Source);
    x:=BMP.Width;
    y:=BMP.Height;
  finally
    BMP.free;
  end;
end;procedure MakeBMP(Source:String;x,y:Integer;c:TColor);
var
    BMP: TBitmap;
begin
  BMP := TBitmap.Create;
  try
    BMP.Width:=x;
    BMP.Height:=y;
    BMP.Canvas.pen.color:=c;
    BMP.Canvas.brush.color:=c;
    BMP.Canvas.Rectangle(0,0,x,y);
    BMP.SaveToFile(Source);
  finally
    BMP.free;
  end;
end;

Answer 4

procedure WriteWallpaperFilePathAndRefresh(Str:String);
var
   Reg:TRegistry;
begin
  try
      Reg:=TRegistry.Create;
      Reg.Rootkey:=   HKEY_CURRENT_USER;
      Reg.OpenKey('Control Panel\Desktop',true);
      Reg.WriteString('Wallpaper',Str);
      Reg.CloseKey;
  finally
      Reg.Free;
  end;
  SystemParametersinfo(SPI_SETDESKWALLPAPER,0,nil,3);end;

Answer 5

procedure ChangeTileWallpaperWallpaperStyle(n:Integer);
var
   Reg:TRegistry;
   i,j:integer;
begin
  try
      Reg:=TRegistry.Create;
      Reg.Rootkey:=   HKEY_CURRENT_USER;
      Reg.OpenKey('Control Panel\Desktop',true);
      Case   n   of
          0:begin//居中
              i:=0;
              j:=0;
              end;
          1:begin//平铺
              i:=1;
              j:=3;
              end;
          2:begin//拉伸
              i:=0;
              j:=2;
              end;
      end;
      Reg.WriteString('TileWallPaper',inttostr(i));
      Reg.WriteString('WallPaperStyle',inttostr(j));
      Reg.CloseKey;
  finally
      Reg.Free;
  end;
  SystemParametersinfo(SPI_SETDESKWALLPAPER,0,nil,3);
end;

Answer 6

thank you all the same!