Delphi World - Программно управлять меню Инструменты в среде Delphi
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Программно управлять меню Инструменты в среде Delphi

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

//**  class to manage Delphi's Tool list 
//** 
//**  if Delphi is running restart it to see changes 
//************************************************************* 

unit DelphiTool;

 interface

 uses
   Windows, SysUtils, Registry, classes;

 type
   TDelphiVersion = ({dvD5,} dvD6);

   EDelphiTool_AlreadyRegistered = class(Exception);
   EDelphiTool_InvalidIndex = class(Exception);

   TDelphiTool = class
   private
     F_Registry: TRegistry;
     F_ToolCount: Integer;
     F_ToolPath: string;
   protected
     function OpenKey(key: string; CanCreate: Boolean): Boolean;

   public
     constructor Create;
     destructor Destroy; override;

     procedure SetRootKey(root_key: HKEY);
     procedure SetDelphiVersion(version: TDelphiVersion);

     procedure Add(params, path, title, workingDir: string);
     procedure Edit(toolIndex: Integer; params, path, title, workingDir: string);
     procedure Delete(toolIndex: Integer);

     function IndexOf(toolTitle: string): Integer;
     function Count: Integer;
     procedure ToolProperties(toolIndex: Integer;
       out params, path, title, workingDir: string);
   end;


 implementation

 { TDelphiTool }

 constructor TDelphiTool.Create;
 begin
   inherited;
   SetDelphiVersion(dvD6);
   F_Registry := TRegistry.Create;
 end;

 destructor TDelphiTool.Destroy;
 begin
   F_Registry.CloseKey;
   F_Registry.Free;
   inherited;
 end;

 function TDelphiTool.IndexOf(toolTitle: string): Integer;
 var
   found: boolean;
   loop: integer;
   Count: integer;
 begin
   Result := -1;

   if OpenKey(F_ToolPath, True) then
   begin
     loop  := 0;
     found := False;
     while (loop < F_ToolCount) and not found do
     begin
       found := F_Registry.ReadString('Title' + IntToStr(loop)) = toolTitle;
       if not found then Inc(loop);
     end;
   end;

   if found then Result := loop;
 end;

 procedure TDelphiTool.SetRootKey(root_key: HKEY);
 begin
   F_Registry.RootKey := root_key;
 end;

 procedure TDelphiTool.Add(params, path, title, workingDir: string);
 var
   Count: integer;
   suffix: string;
 begin
   if OpenKey(F_ToolPath, True) then
   begin
     try
       if IndexOf(title) < 0 then
       begin
         Count  := F_ToolCount;
         suffix := IntToStr(Count);
         Inc(Count);

         F_registry.WriteString('Params' + suffix, params);
         F_registry.WriteString('Path' + suffix, path);
         F_registry.WriteString('Title' + suffix, title);
         F_registry.WriteString('WorkingDir' + suffix, workingDir);

         F_registry.WriteInteger('Count', Count);
         F_ToolCount := Count;
       end
       else
         raise EDelphiTool_AlreadyRegistered.Create('[Add]: Tool is already registered.');
     finally
       F_Registry.CloseKey;
     end;
   end
 end;

 function TDelphiTool.OpenKey(key: string; CanCreate: Boolean): Boolean;
 begin
   Result := F_Registry.OpenKey(key, CanCreate);
   if F_Registry.ValueExists('Count') then F_ToolCount := F_Registry.ReadInteger('Count')
   else
     F_ToolCount := 0;
 end;

 procedure TDelphiTool.Edit(toolIndex: Integer; params, path, title, workingDir: string);
   // if you don't want to change one property set to '' 
var
   suffix: string;
 begin
   if (toolIndex < 0) or (toolIndex >= F_ToolCount) then
     raise EDelphiTool_InvalidIndex.Create('[Edit]: Invalid index.')
   else
   begin
     if OpenKey(F_ToolPath, True) then
     begin
       try
         suffix := IntToStr(toolIndex);

         if (params <> '') then
           F_registry.WriteString('Params' + suffix, params);
         if (path <> '') then
           F_registry.WriteString('Path' + suffix, path);
         if (title <> '') then
           F_registry.WriteString('Title' + suffix, title);
         if (workingDir <> '') then
           F_registry.WriteString('WorkingDir' + suffix, workingDir);

       finally
         F_Registry.CloseKey;
       end;
     end
   end;
 end;

 procedure TDelphiTool.Delete(toolIndex: Integer);
 var
   suffix, tmp_suffix: string;
   i: integer;
 begin
   if (toolIndex < 0) or (toolIndex >= F_ToolCount) then
     raise EDelphiTool_InvalidIndex.Create('[Delete]: Invalid index.')
   else
   begin
     if OpenKey(F_ToolPath, True) then
     begin
       try
         suffix := IntToStr(toolIndex);
         for i := toolIndex + 1 to F_ToolCount - 1 do
         begin
           tmp_suffix := IntToStr(i);
           F_registry.WriteString('Params' + suffix,
             F_registry.ReadString('Params' + tmp_suffix));
           F_registry.WriteString('Path' + suffix,
             F_registry.ReadString('Path' + tmp_suffix));
           F_registry.WriteString('Title' + suffix,
             F_registry.ReadString('Title' + tmp_suffix));
           F_registry.WriteString('WorkingDir' + suffix,
             F_registry.ReadString('WorkingDir' + tmp_suffix));

           suffix := IntToStr(i);
         end;

         F_registry.DeleteValue('Params' + suffix);
         F_registry.DeleteValue('Path' + suffix);
         F_registry.DeleteValue('Title' + suffix);
         F_registry.DeleteValue('WorkingDir' + suffix);

         F_registry.WriteInteger('Count', F_ToolCount - 1);
         Dec(F_ToolCount);
       finally
         F_Registry.CloseKey;
       end;
     end;
   end;
 end;

 procedure TDelphiTool.SetDelphiVersion(version: TDelphiVersion);
   //************************************************************* 
  //  for versions other then D6 lookup the registry and add lines 
  // like below , also add dvDx entries to TDelphiVersion 
begin
   case version of
     dvD6: F_ToolPath := '\Software\Borland\Delphi\6.0\Transfer';

     //** don't have D5, just guessing, so check it in the registry 
    //** before uncommenting 
    //   dvD5: F_ToolPath:= '\Software\Borland\Delphi\5.0\Transfer'; 
  end;
 end;

 function TDelphiTool.Count: Integer;
 begin
   Result := F_ToolCount;
 end;

 procedure TDelphiTool.ToolProperties(toolIndex: Integer; out params, path,
   title, workingDir: string);
 var
   suffix: string;
 begin
   if (toolIndex < 0) or (toolIndex >= F_ToolCount) then
     raise EDelphiTool_InvalidIndex.Create('[ToolProperties]: Invalid index.')
   else
   begin
     if OpenKey(F_ToolPath, True) then
     begin
       try
         suffix := IntToStr(toolIndex);

         params := F_registry.ReadString('Params' + suffix);
         path := F_registry.ReadString('Path' + suffix);
         title := F_registry.ReadString('Title' + suffix);
         workingDir := F_registry.ReadString('WorkingDir' + suffix);

       finally
         F_Registry.CloseKey;
       end;
     end
   end;
 end;

 end.

 //******************************************************************* 
//**  how to use it? 
//******************************************************************* 
unit Unit1;

 interface

 uses
   Windows, {...}, DelphiTool;

  //... 
 //... 
 //... 

var
   Form1: TForm1;

 implementation

 procedure TForm1.Button1Click(Sender: TObject);
 begin
   with TDelphiTool.Create do
     try
       //  Delete(IndexOf('MyTool')); 
      Add('', Application.ExeName, 'MyTool', ExtractFilePath(Application.ExeName));
       //  Edit(IndexOf('MyTool'), '', '', 'MyTool But Edited', ''); 
    finally
       Free;
     end;
 end;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования