![]() |
|
|
|||||||
| Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
![]() |
|
|
Опции темы | Поиск в этой теме | Опции просмотра |
|
|
|
#1
|
|||
|
|||
|
Многоуважаемые программисты, в очередной раз взываю к Вашей милости.
Помогите в таком вопросе : написал я программу.., она что то вроде хитрого текстового редактора, с разными наворотами. В ней создаются текстовые файлы, с расширением, к примеру, .bom, как так сотворить, что бы при клике на этот .bom открывалась моя программа + кликнутый .bom, Подскажите куда копать, если что... Заранее поклон в пол ... Прошу прощения, а тут есть кто нибудь? Последний раз редактировалось RobinStone, 26.05.2014 в 16:18. |
|
#2
|
||||
|
||||
|
Код:
procedure TForm1.RegisterFileType(ext: string; FileName: string);
var
reg: TRegistry;
begin
reg:=TRegistry.Create;
with reg do
begin
RootKey:=HKEY_CLASSES_ROOT;
OpenKey('.'+ext,True);
WriteString('',ext+'file');
CloseKey;
CreateKey(ext+'file');
OpenKey(ext+'file\DefaultIcon',True);
WriteString('',FileName+',0');
CloseKey;
OpenKey(ext+'file\shell\open\command',True);
WriteString('',FileName+' "%1"');
CloseKey;
Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterFileType('mp3', Application.ExeName);
end; |
| Этот пользователь сказал Спасибо NumLock за это полезное сообщение: | ||
RobinStone (26.05.2014)
| ||
|
#3
|
|||
|
|||
|
Хотелось бы что б немного объяснили что куда и откуда, хотя это наверное сам должен, как тут пишут - ручками-ручками...
Последний раз редактировалось M.A.D.M.A.N., 26.05.2014 в 22:00. |
|
#4
|
||||
|
||||
|
Цитата:
Код:
...
var
r: Tregistry;
begin
r:= TRegistry.Create;
with r do
begin
RootKey:= HKEY_CLASSES_ROOT;
OpenKey('.bom', true);
WriteString('', 'Мой текстовик');
CloseKey;
CreateKey('Мой текстовик');
OpenKey('Мой текстовик\DefaultIcon', true);
WriteString('', Application.ExeName + ', 0');
CloseKey;
OpenKey('Мой текстовик\shell\open\command', true);
WriteString('', Application.ExeName + ' %1');
CloseKey;
Free;
end;
...Код:
// RestoreLongName восстанавливает "короткое" имя файла
// Это нужно для запуска при получении параметров от проводника
// Прога конечно, запустится и так, но с мессагой типа "Файл не найден"
Function RestoreLongName(fn: string): string;
function LookupLongName(const filename: string): string;
var
sr: TSearchRec;
begin
if FindFirst(filename, faAnyFile, sr) = 0 then
Result:= sr.Name
else
Result:= ExtractFileName(filename);
SysUtils.FindClose(sr);
end;
function GetNextFN: string;
var
i: integer;
begin
Result:= '';
if Pos('\\', fn) = 1 then
begin
Result:= '\\';
fn:= Copy(fn, 3, length(fn)-2);
i:= Pos('\', fn);
if i <> 0 then
begin
Result:= Result + Copy(fn, 1, i);
fn:= Copy(fn, i + 1, length(fn)-i);
end;
end;
i:= Pos('\', fn);
if i <> 0 then
begin
Result:= Result + Copy(fn, 1, i-1);
fn:= Copy(fn, i + 1, length(fn)-i);
end else
begin
Result:= Result + fn;
fn:= '';
end;
end;
Var
name: string;
Begin
fn:= ExpandFileName(fn);
Result:= GetNextFN;
Repeat
name:= GetNextFN;
Result:= Result + '\' + LookupLongName(Result + '\' + name);
Until length(fn)= 0;
End;Код:
procedure TFPlay.FormShow(Sender: TObject); var s: string; i: integer; begin // Получены параметры от проводника if ParamCount > 0 then begin s:= ParamStr(1); // Имя файла для открытия // Если в имени файла есть пробелы, то шелл передает // его не целиком, а "кусочками" (особенность системы :) // Надо всё это соединить, не забывая про пробелы for i:= 2 to ParamCount do s:= s + ' ' + ParamStr(i); s:=RestoreLongName(s); end; end; |
| Этот пользователь сказал Спасибо Alegun за это полезное сообщение: | ||
RobinStone (27.05.2014)
| ||
|
#5
|
|||
|
|||
|
просто спасибо, что Вы есть...
![]() |