⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 myfavoritesunit.pas

📁 游戏克星江湖行游戏修改工具全部源码,功能很强的。
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -