| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Добавить пункт в меню Windows [D5, D6, Win95/98, Win2k, WinXP]

ERASER ©   (2004-08-04 09:24:00) 

Подскажите пожалуйста как добавить свой пункт в меню Windows которое выходит по правому клику на файле?

---

Кириешки   (2004-08-04 09:43:00) [1]

Вот эти процедуры делают следующее :
1) Добавляют в системное меню в пункт "создать" ваш тип файла
2) Регистрируют ваш тип файлов, и др. Разберетесь сами. Тут не такие и сложные функции

interface

uses windows,registry,dialogs;

type
    TFileNewType = (ftNullFile, ftFileName, ftCommand); //This is the type of
                                                       //entry to add to the
                                                       //new-menu

procedure registerfiletype(ft,key,desc,icon,prg:string);
procedure deregisterFileType(ft: String);
procedure FileTAddAction(key, name, display, action: String);
procedure FileTDelAction(key, name: String);
procedure FileTAddNew(ft, param: String; newType: TFileNewType);
procedure FileTDelNew(ft: String);

implementation

procedure FileTDelNew(ft: String);
var myReg:TRegistry;
begin
myReg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
if not myReg.KeyExists(ft) then
begin
MyReg.Free;
Exit;
end;
MyReg.OpenKey(ft, true);
if MyReg.KeyExists('ShellNew') then
MyReg.DeleteKey('ShellNew');
MyReg.CloseKey;
MyReg.Free;
end;

procedure FileTAddNew(ft, param: String; newType: TFileNewType);
var myReg:TRegistry;
begin
myReg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
if not myReg.KeyExists(ft) then
begin
MyReg.Free;
Exit;
end;
myReg.OpenKey(ft+'\ShellNew', true);
case NewType of
ftNullFile : MyReg.WriteString('NullFile', '');
ftFileName : MyReg.WriteString('FileName', param);
ftCommand  : MyReg.WriteString('Command', param);
end;
MyReg.CloseKey;
MyReg.Free;
end;

procedure FileTDelAction(key, name: String);
var myReg: TRegistry;
begin
myReg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;

if key[1] = '.' then
key := copy(key,2,maxint)+'_auto_file';

if key[Length(key)-1] <> '\' then //Add a \ if necessary
key:=key+'\';
myReg.OpenKey('\'+key+'shell\', true);
if myReg.KeyExists(name) then
myReg.DeleteKey(name);
myReg.CloseKey;
myReg.Free;
end;

procedure FileTAddAction(key, name, display, action: String);
var
myReg:TRegistry;
begin
myReg:=Tregistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
if name='' then name:=display;

if key[1] = '.' then
key:= copy(key,2,maxint)+'_auto_file';

if key[Length(key)-1] <> '\' then //Add a \ if necessary
key:=key+'\';
if name[Length(name)-1] <> '\' then //dito. For only two calls, I won't write a function...
name:=name+'\';

myReg.OpenKey(key+'Shell\'+name, true);
myReg.WriteString('', display);
MyReg.CloseKey;
MyReg.OpenKey(key+'Shell\'+name+'Command\', true);
MyReg.WriteString('', action);
myReg.Free;
end;

procedure deregisterFileType(ft: String);
var
myreg:TRegistry;
key: String;
begin
myreg:=TRegistry.Create;
myReg.RootKey:=HKEY_CLASSES_ROOT;
{
1.01: Added the following if-statement: I thought
      TRegistry.OpenKey would raise an exception when
      the key does not exist. Actually it opens NO key
      and returns False. The myReg.DeleteKey then
      deleted the WHOLE HKEY_CLASSES_ROOT-Key. Ups.
}
if myReg.OpenKey(ft, False) = false then
Exit;
key:=MyReg.ReadString('');
MyReg.CloseKey;
myReg.DeleteKey(ft);
myReg.DeleteKey(key);
myReg.Free;
end;

procedure registerfiletype(ft,key,desc,icon,prg:string);
var myreg : treginifile;
   ct : integer;
begin

    // make a correct file-extension
    ct := pos('.',ft);
    while ct > 0 do begin
          delete(ft,ct,1);
          ct := pos('.',ft);
    end;
    if (ft = '') or (prg = '') then exit; //not a valid file-ext or ass. app
    ft := '.'+ft;
    myreg := treginifile.create('');
    try
       myreg.rootkey := hkey_classes_root; // where all file-types are described
       if key = '' then key := copy(ft,2,maxint)+'_auto_file'; // if no key-name is given,
                                                            // create one
       myreg.writestring(ft,'',key); // set a pointer to the description-key
       myreg.writestring(key,'',desc); // write the description
       if icon <> '' then
          myreg.writestring(key+'\DefaultIcon','',icon); // write the def-icon if given
       myreg.writestring(key+'\shell\open\command','',prg+' "%1"'); //association
    finally
           myreg.free;
    end;
//     showmessage('File-Type '+ft+' associated with'#13#10+
//     prg+#13#10);

end;
end.

---

Наверх