得到windows聚焦圖片（windows 10）

有些Windows聚焦圖片確實很漂亮，很希望保留下來，但是Windows聚焦圖片總更好，網上有得到聚焦圖片的方法，每次都手動去弄真麻煩，於是自己編了一個小程序，自動得到Windows聚焦圖片，下面是運行這個小程序得到Windows聚焦圖片的效果！

小工具以及源碼下載：http://download.csdn.net/detail/sunylat/9741756

解壓縮下載文件后，小工具在解壓縮后的文件夾中：“Win32\Debug”，文件名：“Project1.exe”。

運行效果截圖：

我用這個小工具保存下來的Windows聚焦圖片：

 

全部源碼：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm2 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    clearLogBtn: TButton;
    logMemo: TMemo;
    Splitter1: TSplitter;
    Panel3: TPanel;
    Button2: TButton;
    procedure clearLogBtnClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }

    // 得到特殊目錄
    function GetSpecialDir(SpecialDirID: Integer): string;

    // 得到用戶目錄
    function GetAppdataLocal: string;

    //重命名所有文件擴展名
    procedure Rename(filePath: string);

  public
    { Public declarations }
    procedure MyLog(tempLog: string); // log方法
  end;

var
  Form2: TForm2;

  logInfo: string; // log信息

implementation

{$R *.dfm}

uses
  ShlObj, {GetSpecialDir用單元}
  System.IOUtils,
  shellapi;

procedure TForm2.Button2Click(Sender: TObject);
const
  pictureDir =
    '\Packages\Microsoft.Windows.ContentDeliveryManager_cw5n1h2txyewy\LocalState\Assets';
var
  picturePath: string;
  pictureTempPath: string;
begin

  //windows聚焦圖片存放目錄
  picturePath := self.GetAppdataLocal + pictureDir;

  //存放得到圖片的目錄
  pictureTempPath := ExtractFilePath(paramstr(0)) + 'picture';

  //刪除先前處理圖片的目錄
  if TDirectory.Exists(pictureTempPath) = true then
  begin
    TDirectory.Delete(pictureTempPath,true);
  end;
  //拷貝windows聚焦圖片到臨時目錄
  TDirectory.Copy(picturePath, pictureTempPath);

  //如果臨時存放圖片目錄不為空，則繼續處理
  if TDirectory.IsEmpty(pictureTempPath) = false then
  begin
    //重命名所有文件為擴展名是"jpg"的圖片類型文件
    self.Rename(pictureTempPath);

    //打開存放圖片目錄
    ShellExecute(Handle, 'open', 'Explorer.exe', PChar(pictureTempPath), nil,
      SW_NORMAL);
  end;

 end;

procedure TForm2.clearLogBtnClick(Sender: TObject);
begin
  logMemo.Clear;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin

end;

// log方法
procedure TForm2.MyLog(tempLog: string);
var
  temp: string;
  oldLog: string;
begin
  if Trim(tempLog) <> '' then
  begin

    oldLog := Trim(logMemo.Text);
    logMemo.Clear;

    temp := FormatDateTime('yyyy-mm-dd hh:mm:ss', now) + ' ' + Trim(tempLog);
    if oldLog = '' then
    begin
      logMemo.Lines.Add(temp);
      logMemo.Lines.Add('');
    end
    else
    begin
      logMemo.Lines.Add(temp);
      logMemo.Lines.Add('');
      logMemo.Lines.Add(oldLog);
    end;

  end;

end;

// 得到特殊目錄
function TForm2.GetSpecialDir(SpecialDirID: Integer): string;
var
  pidl: PItemIDList;
  Path: array [0 .. MAX_PATH] of Char;
begin
  SHGetSpecialFolderLocation(0, SpecialDirID, pidl);
  SHGetPathFromIDList(pidl, Path);
  Result := Path;
end;

// 得到用戶目錄
function TForm2.GetAppdataLocal: string;
begin
  Result := GetSpecialDir(CSIDL_LOCAL_APPDATA);
end;

procedure TForm2.Rename(filePath: string);
const
  batFile = 'tmp.cmd'; // 保存各種要執行命令的bat文件名
var
  tempList: TStringList;
begin

  try

    // 進入當前目錄
    ChDir(filePath);

    tempList := TStringList.Create;
    with tempList do
    begin
      Add('ren *.* *.jpg');
      Add('del ' + batFile);
      SaveToFile(batFile);

      SaveToFile(batFile);
    end;

  finally

    tempList.Free;

    // 執行bat文件
    WinExec(batFile, SW_HIDE);
  end;

end;

end.

 參考：http://www.iplaysoft.com/save-win10-spotlight-wallpapers.html