本文整理自网络，侵删。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtDlgs, XPMan, StdCtrls, FileCtrl, RzFilSys, ExtCtrls,jpeg,ShlObj;
type
TForm1 = class(TForm)
Button1: TButton;
Button3: TButton;
XPManifest1: TXPManifest;
OpenPictureDialog1: TOpenPictureDialog;
Memo1: TMemo;
Panel1: TPanel;
Label2: TLabel;
Label3: TLabel;
RzDriveComboBox1: TRzDriveComboBox;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure RzDriveComboBox1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
PicPath,UKeyPath:string;
implementation
{$R *.dfm}
function SelectFolderDialog(const Handle:integer;const Caption:string;
const InitFolder:string;var SelectedFolder:string):boolean;
var
BInfo: _browseinfoA;
Buffer: array[0..MAX_PATH] of Char;
ID: IShellFolder;
Eaten, Attribute: Cardinal;
ItemID: PItemidlist;
begin
with BInfo do
begin
HwndOwner := Handle;
lpfn := nil;
lpszTitle := Pchar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS+BIF_NEWDIALOGSTYLE;
SHGetDesktopFolder(ID);
ID.ParseDisplayName(0,nil,'\',Eaten,ItemID,Attribute);
pidlRoot := ItemID;
GetMem(pszDisplayName, MAX_PATH);
end;
if SHGetPathFromIDList(SHBrowseForFolder(BInfo), Buffer) then
begin
SelectedFolder := Buffer;
if Length(SelectedFolder)<>3 then
SelectedFolder := SelectedFolder;
result := True;
end
else begin
SelectedFolder := '';
result := False;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
PicPath:=OpenPictureDialog1.FileName;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
attr:integer;
begin
if FileExists(PicPath) then
begin
if UKeyPath<>'' then
begin
Memo1.Lines.Add('IconArea_Image=BMJ'+ExtractFileExt(PicPath));
if FileExists(UKeyPath+'BMJ'+ExtractFileExt(PicPath)) then
begin
DeleteFile(UKeyPath+'BMJ'+ExtractFileExt(PicPath));
end;
if FileExists(UKeyPath+'Desktop.ini') then
begin
DeleteFile(UKeyPath+'Desktop.ini');
end;
Memo1.Lines.SaveToFile(UKeyPath+'Desktop.ini');
Memo1.Lines.Delete(Memo1.Lines.Count-1);
CopyFile(PChar(PicPath),PChar(UKeyPath+'BMJ'+ExtractFileExt(PicPath)),True);
Application.ProcessMessages;
while FileExists(UKeyPath+'BMJ'+ExtractFileExt(PicPath))=False do
begin
end;
attr := fileGetAttr(UKeyPath+'Desktop.ini');
if not ( (attr and faHidden) = faHidden )then
begin
fileSetAttr(UKeyPath+'Desktop.ini',attr or faHidden);
end;
attr := fileGetAttr(UKeyPath+'BMJ'+ExtractFileExt(PicPath));
if not ( (attr and faHidden) = faHidden )then
begin
fileSetAttr(UKeyPath+'BMJ'+ExtractFileExt(PicPath),attr or faHidden);
end;
Application.MessageBox('保存成功!', '提示', MB_OK +
MB_ICONINFORMATION);
PicPath:='';
end
else
begin
Application.MessageBox('未选择U盘路径,请选择!', '提示', MB_OK +
MB_ICONINFORMATION);
end;
end
else
begin
Application.MessageBox('图片未选择或源文件不存在,请重新选择!', '提示', MB_OK +
MB_ICONINFORMATION);
end;
end;
procedure TForm1.RzDriveComboBox1Change(Sender: TObject);
begin
UKeyPath:=Copy(Trim(RzDriveComboBox1.Text),1,2);
end;
end.
相关阅读 >>
Delphi 使用indy解决tidssliohandlersocketopenssl could not load ssl library错误
Delphi xe webbroker 开发,解决 response 返回中文乱码问题
Delphi rest application 与 webbroker application 区别
更多相关阅读请进入《Delphi》频道 >>
