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