Difference between revisions of "FileAssociation"

From Lazarus wiki
(layout, typos. Added category Lazarus to distinguish from FPC only stuff. Please leave it in.)
m (License)
Line 10: Line 10:
  
 
==License==
 
==License==
LGPL (The same as Lazarus).
+
Modified LGPL (The same as Lazarus).
  
 
==Intended platform==
 
==Intended platform==

Revision as of 13:59, 17 February 2013

FileAssociation

Package Name: fileassoc.lpk

Component Name: TFileAssociation (fileassociation.pas)

With this component you can easily register file associations for all Windows versions. This includes Windows Vista/7/8 Default Programs feature.

Install like any package. The component is under the "System" tab.

License

Modified LGPL (The same as Lazarus).

Intended platform

Win32, Win64.

Status

Stable.

Where to download it:

Download (in Lazarus Forum)

Who wrote it

Lainz.

Is support available

Yes, ask in the Lazarus forum, the same page that contains the download.

Test (included in download)

This registers file association for Lazarus.

fileassoc.png

Add a TFileAssociation in the form (assoc), a TButton (btnExec), a TDirectoryEdit (lazDir).

Set these properties in the TFileAssociation:

AppDescription = Open Source IDE for Free Pascal.

AppName = Lazarus IDE

AppNameNoSpaces = LazarusIDE

CmdNameNoSpaces = Open

const
  lazExe = 'lazarus.exe';

...

procedure TForm1.btnExecClick(Sender: TObject);
var
  lazExePath: string;
  AddedToAll: boolean;
begin
  lazExePath := lazDir.Directory + PathDelim + lazExe;
  if FileExistsUTF8(lazExePath) then
  begin
    assoc.CmdData := '"' + lazExePath + '" "%1"';
    assoc.CmdIcon := lazExePath;

    // if you leave it empty the system will use localized 'Open' ('Abrir', 'Ouvrir', etc..)
    // it works for CmdNameNoSpaces 'Open', 'Edit', 'Print'
    // assoc.CmdName := 'Open with Lazarus';

    assoc.ExtData := '.lfm';
    assoc.ExtIcon := lazDir.Directory + '\images\LazarusForm.ico';
    assoc.ExtName := 'Lazarus Form';
    assoc.ExtNameNoSpaces := 'LazarusForm';

    // if can't add to all users try to add to single user
    if not assoc.Execute then
    begin
      AddedToAll := False;
      assoc.RegisterForAllUsers := False;
      // if doesn't works..
      if not assoc.Execute then
      begin
        ShowMessage('Can not write to registry');
        Exit;
      end;
    end
    else
      AddedToAll := True;

    // it needs to be called only one time
    assoc.AddAppToDefaultPrograms := False;

    assoc.ExtData := '.lpi';
    assoc.ExtIcon := lazDir.Directory + '\images\LazarusProject.ico';
    assoc.ExtName := 'Lazarus Project Information';
    assoc.ExtNameNoSpaces := 'LazarusProjectInformation';
    assoc.Execute;

    assoc.ExtData := '.lpk';
    assoc.ExtIcon := lazDir.Directory + '\images\lazaruspackage.ico';
    assoc.ExtName := 'Lazarus Package';
    assoc.ExtNameNoSpaces := 'LazarusPackage';
    assoc.Execute;

    assoc.ExtData := '.lpr';
    assoc.ExtIcon := lazDir.Directory + '\images\lprfile.ico';
    assoc.ExtName := 'Lazarus Program';
    assoc.ExtNameNoSpaces := 'LazarusProgram';
    assoc.Execute;

    assoc.ExtData := '.inc';
    assoc.ExtIcon := lazDir.Directory + '\images\includefile.ico';
    assoc.ExtName := 'Include File';
    assoc.ExtNameNoSpaces := 'IncludeFile';
    assoc.Execute;

    assoc.ExtData := '.pas';
    assoc.ExtIcon := lazDir.Directory + '\images\lprfile.ico';
    assoc.ExtName := 'Pascal Source Code';
    assoc.ExtNameNoSpaces := 'PascalSourceCodePAS';
    assoc.Execute;

    assoc.ExtData := '.pp';
    assoc.ExtIcon := lazDir.Directory + '\images\lprfile.ico';
    assoc.ExtName := 'Pascal Source Code';
    assoc.ExtNameNoSpaces := 'PascalSourceCodePP';
    assoc.Execute;

    // refresh icon cache
    assoc.ClearIconCache;

    if AddedToAll then
      ShowMessage('File Association Registered for All Users.')
    else
      ShowMessage('File Association Registered for Current User.' +
        LineEnding +
        'If you want to register for All Users run this program with Administrative Privileges.');
  end
  else
    ShowMessage(format('The directory %0:s does not contain %1:s.',
      ['"' + lazDir.Directory + '"', '"' + lazExe + '"']));
end;