FileAssociation

From Lazarus wiki
Revision as of 19:51, 16 February 2013 by Swen (talk | contribs) (→‎Who wrote it)
Jump to navigationJump to search

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

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 register 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;