得到windows聚焦图片(windows 10)

有些Windows聚焦图片确实很漂亮,很希望保留下来,但是Windows聚焦图片总更好,网上有得到聚焦图片的方法,每次都手动去弄真麻烦,于是自己编了一个小程序,自动得到Windows聚焦图片,下面是运行这个小程序得到Windows聚焦图片的效果!

小工具以及源码下载:http://download.csdn.net/detail/sunylat/9741756

解压缩下载文件后,小工具在解压缩后的文件夹中:“Win32Debug”,文件名:“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 =
    'PackagesMicrosoft.Windows.ContentDeliveryManager_cw5n1h2txyewyLocalStateAssets';
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

原文地址:https://www.cnblogs.com/sunylat/p/6308952.html