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

📄 myfavoritesunit.pas

📁 游戏修改工具(内存高低阶
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  end;

end;
////////////////////////////////////////////
procedure TMyFavoritesForm.DelFavorite(theIndex:Integer);
var theComponent:Tcomponent;
begin
    theComponent:=FindComponent('Panel' + IntToStr(theIndex));
    FreeAndNil(theComponent);
    theComponent:=FindComponent('Image' + IntToStr(theIndex));
    FreeAndNil(theComponent);
    DeleteFavoritesName(theIndex);
end;


procedure TMyFavoritesForm.AddFavoritesClick(Sender: TObject);
var SHFILEINFO:TSHFILEINFO;
    FavoriteSaveFile:TFileStream;
    MyFavotiteFileinfo:TMyFavoriteExeinfo;
begin
  if favoritesNum>=MAX_FAvoritesNUm then
   begin
   Showmessage(Format(String_MAXFavorites,[MAX_FavoritesNUm]));
   exit;
   end;
if OpenDialog1.Execute then
begin
 if 0=ShGetFileInfo(pchar(OpenDialog1.Filename),0,SHFILEINFO,sizeof(SHFILEINFO),SHGFI_EXETYPE) then
 begin
 showmessage(Format(String_InvalidApplcation,[OpenDialog1.Filename]));
 exit;
 end;
 MyFavotiteFileinfo:=GetFavoriteFileinfo(pchar(OpenDialog1.Filename));

 try
  FavoriteSaveFile:=TFileStream.Create(FavoritesFile,fmopenreadwrite or fmshareDenyNone);
  FavoriteSaveFile.Seek(0,soFromEnd);
  FavoriteSaveFile.WriteBuffer(MyFavotiteFileinfo.FilePathName,255);
 finally
 FreeAndNil(FavoriteSaveFile);
 end;
  imagelist_addicon(imageList2.Handle,MyFavotiteFileinfo.theIcon);
  AddFavorite(MyFavotiteFileinfo);
end;

end;

procedure TMyFavoritesForm.FormCreate(Sender: TObject);
var theFileName:String[255];
    TempFileName:String;
    I,FHandle:Integer;
    SHFILEINFO:TSHFILEINFO;
    FavoritesMemStream:TmemoryStream;
    RealFavoritesStream:TmemoryStream;
    MyFavotiteFileinfo:TMyFavoriteExeinfo;
begin
UseNameIndex:=0;
favoritesNum:=0;
FavoritesFile:=pchar(ExtractFilePath(application.ExeName)+'MyFavorites.pkt');
if not FileExists(FavoritesFile) then
 begin
 FHandle:=FileCreate(FavoritesFile);
 if FHandle=-1 then exit;
 CloseHandle(FHandle);
 end;


  FavoritesMemStream:=TmemoryStream.Create;
try
  FavoritesMemStream.LoadFromFile(FavoritesFile);

 if FavoritesMemStream.Size=0 then Exit;
 if (FavoritesMemStream.Size mod 255<>0) then
  begin
   if IDYES=MessageBox(Application.Handle,pchar(String_InValidFavoritesFile),
                pchar(String_InValidFavoritesFileTitle),MB_YESNO) then
   begin
   FavoritesMemStream.clear;
   deleteFile(FavoritesFile);
   exit;
   end   else    Exit;
  end;

  RealFavoritesStream:=TmemoryStream.Create;
  FavoritesMemStream.Seek(0,soFromBeginning);
  for i:=1 to (FavoritesMemStream.Size div 255) do
  begin
   FavoritesMemStream.Read(theFileName,255);
   if not FileExists(theFileName) then    Continue;
   tempFileName:=theFileName;
   if 0=ShGetFileInfo(pchar(tempFileName),0,SHFILEINFO,sizeof(SHFILEINFO),SHGFI_EXETYPE) then
    begin
     showmessage(Format(String_InvalidApplcation,[tempFileName]));
     continue;
    end;
    
    RealFavoritesStream.WriteBuffer(theFileName,255);
    MyFavotiteFileinfo:=GetFavoriteFileinfo(pchar(tempFileName));
    imagelist_addicon(imageList2.Handle,MyFavotiteFileinfo.theIcon);
    AddFavorite(MyFavotiteFileinfo);
    if favoritesNum>=MAX_FavoritesNUm then
     begin
      Showmessage(Format(String_MAXFavorites,[MAX_FavoritesNUm]));
      exit;
     end;
  end; //for end

  try
  RealFavoritesStream.SaveToFile(FavoritesFile);
  finally
  FreeAndNil(RealFavoritesStream);
  end;

  finally
  FreeAndNil(FavoritesmemStream);
  end;



end;

procedure TMyFavoritesForm.clear_tbClick(Sender: TObject);
var    i: Integer;
      Temp:TComponent;
      TempStream:TMemoryStream;
begin
if FavoritesNum=0 then exit;
if IDCANCEL=MessageBox(Application.Handle,
                       pchar(String_ClearFavoritesConfirm),
                       pchar(String_ClearFavoritesConfirmTitle),
                       MB_OKCANCEL)
                        then exit;
  for I := ComponentCount - 1 downto 0 do
  begin
    Temp := Components[I];
    if (Temp is TPanel)and (Temp.Tag<>0) then ///tag 区别普通
    begin
      FreeAndNil(Temp);
    end;
  end;
  
UseNameIndex:=0;
FavoritesNum:=0;
TempStream:=TmemoryStream.Create;
try
TempStream.SetSize(0);
TempStream.SaveToFile(FavoritesFile);
finally
FreeAndNIl(TempStream);
end;

end;

procedure TMyFavoritesForm.delOne_tbClick(Sender: TObject);
var I:Integer;
   TempIndex:integer;
begin
if (FavoritesNum>0) and (SelectImage<>nil) and (SelectImage<>nil)  then
begin
TempIndex:=VCLNameToFileIndex(SelectImage.Name);
if TempIndex<0 then exit;
DeleteFavoritesName(TempIndex);
FreeAndNIl(SelectImage);
FreeAndNIl(SelectPanel);
if (FavoritesNum<>1) or (TempIndex<>FavoritesNum)then
  begin
      for I :=TempIndex  to FavoritesNum-1 do
      begin
      VCLList[i]:=VCLList[i+1];
      end;
  end;
DEC(FavoritesNum);
end;

end;

procedure TMyFavoritesForm.EventImageClick(Sender: TObject);
var I:integer;
    Temp:TComponent;
begin
if sender is TImage then
begin
SelectImage:=Timage(sender);
SelectPanel:=Tpanel(Timage(sender).Parent);
end;
  for I := ComponentCount - 1 downto 0 do
  begin
    Temp := Components[I];
    if (Temp is TPanel) then
    begin
     TPanel(Temp).BevelInner:=bvNone;
     TPanel(Temp).BevelOuter:=bvRaised;
     TPanel(Temp).Color:=clBtnFace;
    end;
  end;
  SelectPanel.BevelInner:=bvLowered;
  SelectPanel.BevelOuter:=bvLowered;
  SelectPanel.Color:=clblue;
end;

procedure TMyFavoritesForm.EventImageDblClick(Sender: TObject);
var StartInfo : TStartupInfo;
  FProcessInfo : TProcessInformation;
begin
if SelectPanel<>nil then
begin
  //init StartInformation
  StartInfo.cb:=sizeof(TStartupInfo);
       StartInfo.lpReserved := NIL;
         StartInfo.lpDesktop:=NIL;
          StartInfo.lpTitle := nil;
  StartInfo.dwFillAttribute := 0;
      StartInfo.cbReserved2 :=0;
      StartInfo.lpReserved2 := NIL;    //这个参数控制Create Window形态
        //STARTF_USESHOWWINDOW 指定这个标志位,指示用ShowWindow的参数建立窗口
          StartInfo.dwFlags := STARTF_USESHOWWINDOW;
      StartInfo.wShowWindow := SW_SHOW;
   //Clear ProcessInfo Structure
  FProcessInfo.hProcess := 0;
  FProcessInfo.hThread := 0;
  FProcessInfo.dwProcessId := 0;
  FProcessInfo.dwThreadId := 0;
if not CreateProcess(NIL,
                  pchar(SelectPanel.Caption),
                  nil,
                  nil,
                  false,
                  CREATE_NEW_CONSOLE or   { creation flags }
                  NORMAL_PRIORITY_CLASS,
                  nil,
                  pchar(ExtractFilePath(SelectPanel.Caption)),
                  StartInfo,
                  FProcessInfo)
                  then

begin
 ShowMessage(Format(String_CanNotExecuteFile,[SelectPanel.Caption]));
 exit;
end;
end;
end;

procedure TMyFavoritesForm.bkScrollBoxClick(Sender: TObject);
var I:integer;
     Temp:Tcomponent;
begin
  for I := ComponentCount - 1 downto 0 do
  begin
    Temp := Components[I];
    if (Temp is TPanel) then
    begin
     TPanel(Temp).BevelInner:=bvNone;
     TPanel(Temp).BevelOuter:=bvRaised;
     TPanel(Temp).Color:=clBtnFace;
    end;
  end;
SelectPanel:=nil;
SelectImage:=nil;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -