得到windows聚焦图片（windows 10）

豆包ko

　　有些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