📄 myfavoritesunit.pas
字号:
unit MyFavoritesUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ChildFormUnit, ComCtrls, ToolWin, ImgList, StdCtrls, Buttons,shellapi,
ExtCtrls,commCtrl, Menus;
resourcestring
String_InvalidApplcation='%s 不是一个合法的应用程序.';
String_FilePathName='名称:';
String_FileName='名称:';
String_FileSize='大小:';
String_FileAccessTime='最后访问时间:';
String_FileVersion='版本:';
String_FileCompany='公司:';
String_InValidFavoritesFile='不合法的收藏文件记录,是否删除?';
String_InValidFavoritesFileTitle='不合法的收藏文件记录信息';
String_MAXFavorites='收藏文件记录最多加入%d ';
String_CanNotExecuteFile='%s 不能被执行,请检查.';
String_ClearFavoritesConfirm='你想删除所有的收藏文件记录吗?';
String_ClearFavoritesConfirmTitle='清空收藏文件记录';
Type
TMyFavoriteExeinfo=record
FilePathName:String[255];
SizeofFile:Dword;
FileVersion:string[40];
CompanyName:string[40];
AccessTime:String[20];
theIcon:Hicon;
end;
type
TMyFavoritesForm = class(TChildForm)
ImageList1: TImageList;
ToolBar1: TToolBar;
OpenDialog1: TOpenDialog;
ImageList2: TImageList;
add_tb: TToolButton;
delOne_tb: TToolButton;
execute_tb: TToolButton;
clear_tb: TToolButton;
bkScrollBox: TScrollBox;
EventImage: TImage;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
procedure AddFavoritesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure clear_tbClick(Sender: TObject);
procedure delOne_tbClick(Sender: TObject);
procedure EventImageClick(Sender: TObject);
procedure EventImageDblClick(Sender: TObject);
procedure bkScrollBoxClick(Sender: TObject);
private
{ Private declarations }
public
procedure DrawInfo(theindex:integer;theImage:Timage;theExeinfo:TMyFavoriteExeinfo);
procedure AddFavorite(theExeinfo:TMyFavoriteExeinfo);
procedure DelFavorite(theIndex:Integer);
procedure DeleteFavoritesName(theIndex:Integer);
function VCLNameToFileIndex(thename:string):integer;
{ Public declarations }
end;
const MAX_FavoritesNUm=255;
var
MyFavoritesForm: TMyFavoritesForm;
FavoritesFile:String;
FavoritesNum:integer=0;
SelectPanel:TPanel;
SelectImage:TImage;
UseNameIndex:Integer; ///保证名字依次选取
VCLList:array[1..MAX_FavoritesNUm] of String;
implementation
{$R *.dfm}
////////获取文件信息/////////////////////////
function GetFavoriteFileinfo(theFile:pchar):TMyFavoriteExeinfo;
var theresult:TMyFavoriteExeinfo;
SHFILEINFO:TSHFILEINFO;
FileAttr:WIN32_FILE_ATTRIBUTE_DATA;
MyFileTime:SYSTEMTIME;
FileVerinfosize:dword;
VerInfo:Pointer;
Translation: Pointer;
InfoPointer: Pointer;
unused:Dword;
VersionValue:String;
const SFinfo='\StringFileInfo\';
begin
///initalize
with theresult do
begin
FilePathName:=theFile;
SizeofFile:=0;
FileVersion:='';
CompanyName:='';
AccessTime:='';
theIcon:=LoadIcon(0,IDI_WINLOGO);
end;
if ShGetFileInfo(thefile,0,SHFILEINFO,sizeof(SHFILEINFO),SHGFI_ICON)<>0 then
theresult.theIcon:=SHFILEINFO.hIcon;
if GetFileAttributesEx(thefile,GetFileExInfoStandard,@FileAttr) then
theresult.SizeofFile:=FileAttr.nFileSizeLow;
if FileTimeToSystemTime(FileAttr.ftLastAccessTime,MyFileTime) then
theresult.AccessTime:=Format('%d-%d-%d',[MyFileTime.wYear,MyFileTime.wMonth,MyFileTime.wDay]);
unused:=0;
FileVerinfosize:=GetFileVersionInfoSize(pchar(theFile),unused);
if FileVerInfosize>0 then
begin
GetMem(VerInfo,FileVerinfosize);
if GetFileVersionInfo(thefile,0,FileVerinfosize,VerInfo) then
begin
VerQueryValue(VerInfo,'\VarFileInfo\Translation', Translation,FileVerinfosize);
VersionValue:=SFInfo+IntToHex(LoWord(Longint(Translation^)),4)+IntToHex(HiWord(Longint(Translation^)),4)+'\';
VerQueryValue(VerInfo, pchar(VersionValue+'CompanyName'),InfoPointer, FileVerinfosize);
theresult.CompanyName := string(pchar(InfoPointer));
VerQueryValue(VerInfo, pchar(VersionValue + 'FileVersion'),InfoPointer, FileVerinfosize);
theresult.FileVersion := string(pchar(InfoPointer));
end;
FreeMem(VerInfo);
end;
result:=theresult;
end;
//////鼠标进入画法////////////
procedure TMyFavoritesForm.DrawInfo(theindex:integer;theImage:Timage;theExeinfo:TMyFavoriteExeinfo);
var MyIcon:Ticon;
begin
MyIcon:=nil;
MyIcon:=TICon.Create;
try
with theImage,theExeinfo do
begin
Canvas.Brush.Color:=clskyBlue;
Canvas.FillRect(theImage.ClientRect);
Canvas.Brush.Color:=clskyBlue;
Canvas.Font.Color:=clBlack;
Canvas.Font.Size:=10;
ImageList2.GetIcon(0,MyIcon);
Canvas.Draw(10,30,Myicon);
ImageList2.Clear;
Canvas.Font.Color:=clBlue;
Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
Canvas.TextOut(40,10,UpperCase(ExtractFileName(FilePathName)));
Canvas.Font.Style:=Canvas.Font.Style-[fsBold];
Canvas.Font.Color:=clBlack;
Canvas.TextOut(450,15,String_FileVersion+FileVersion);
Canvas.TextOut(40,35,String_FileAccessTime+AccessTime);
Canvas.TextOut(450,35,String_FileSize+inttoStr(SizeofFile));
Canvas.TextOut(40,55,String_FilePathName+FilePathName);
Canvas.TextOut(450,55,String_FileCompany+CompanyName);
end;
finally
FreeandNil(MyIcon);
end;
end;
////////控件名对应文件中存放位置////////////////////////////////////////////
Function TMyFavoritesForm.VCLNameToFileIndex(theName:string):integer;
var I:integer;
begin
result:=-999;
for i:=1 to FavoritesNum do
begin
if VCLList[i]=theName then
begin
result:=i;
exit;
end;
end;
end;
/////////////动态增加控件/////////////////////////
procedure TMyFavoritesForm.AddFavorite(theExeinfo:TMyFavoriteExeinfo);
var MyPanel:TPanel;
MyImage:TImage;
begin
Inc(favoritesNum);
inc(UseNameIndex);
MyPanel:=TPanel.Create(self);
with MyPanel do
begin
Name:='Panel'+intToStr(UseNameIndex);
Parent:=bkScrollBox;
Left:=200;
if favoritesNum>0 then top:=85*(favoritesNum+1);///确保排在最后
Width:=100;
Height:=85;
align:=altop;
BevelInner:=BvLowered;
BevelOuter:=bvLowered;
MyPanel.BorderWidth:=3;
Caption:=theExeinfo.FilePathName; ///////
Tag:=999;/////////删除时区别普通
end;
//MyImage:=nil;
MyImage:=TImage.Create(self);
with MyImage do
begin
Name:='Image'+intToStr(UseNameIndex);
Parent:=MyPanel;
Align:=alClient;
Left:=0;
Width:=800;
Height:=85;
Transparent:=false;
Cursor:=crHandPoint;
OnClick:=EventImageClick;
OnDblClick:=EventImageDblClick;
end;
VCLList[favoritesNum]:=MyImage.Name;
DrawInfo(FavoritesNum-1,MyImage,theExeinfo);
end;
//////////////////////////////////////
procedure TMyFavoritesForm.DeleteFavoritesName(theIndex:Integer);
var theMemStreamSource:TMemoryStream;
theMemStreamTarget:TMemoryStream;
I:integer;
begin
theMemStreamSource:=TMemoryStream.Create;
try
theMemStreamSource.LoadFromFile(FavoritesFile);
begin
I:=theMemStreamSource.Size mod 255;
if i<>0 then exit;
I:=theMemStreamSource.Size div 255;
if i=0 then exit;
try
I:=theMemStreamSource.Size;
theMemStreamTarget:=TmemoryStream.Create;
theMemStreamTarget.Seek(0,sofrombeginning);
begin
if theindex=1 then
begin
theMemStreamSource.Seek(theindex*255,sofrombeginning);
if (i-255)=0 then theMemStreamTarget.SetSize(0) else
theMemStreamTarget.CopyFrom(theMemStreamSource,i-255);
end;
if theindex>1 then
begin
theMemStreamSource.Seek(0,sofrombeginning);
theMemStreamTarget.CopyFrom(theMemStreamSource,(theindex-1)*255);
theMemStreamSource.Seek(theindex*255,sofrombeginning);
if (i-theindex*255)>0 then
theMemStreamTarget.CopyFrom(theMemStreamSource,i-theindex*255);
end;
theMemStreamTarget.SaveToFile(FavoritesFile);
end;
finally
FreeAndNil(theMemStreamTarget);
end;
end;
finally
FreeAndNil(theMemStreamSource);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -