Добавить пункт в меню Windows

← →
ERASER (2004-08-04 09:24) [0]

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

← →
Кириешки © (2004-08-04 09:43) [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.

Добавить пункт в меню Windows Найти похожие ветки