1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
| unit AideHTML;
{Version 1.0 du 10/10/2009}
{Cette unité permet d'afficher un fichier d'aide au format *.html dans le
navigateur par défaut sans avoir à connaître lequel est-ce et où il se trouve.
Elle fonctionne pour les environnements Windows et Linux. En cas de modif ou
d'ajout d'environnement, soyez sympa de m'en faire part à pr.chauveau@free.fr.
Trois procédures sont proposées :
1 - AideEnligne : à utiliser si le fichier d'aide possède le même nom que
l'application mais avec l'extension .html et se trouve dans le répertoire
de l'application (cas nominal),
2 - AideEnLigne(Nom_du_fichier) : à utiliser si le fichier d'aide a un nom
différent de celui de l'application mais se trouve quand même dans son
répertoire. Nom_du_fichier doit être le nom avec son extension.
3 - AideEnLigne(Rep_du_fichier, Nom_du_fichier) : à utiliser pour un fichier
html dont le nom et/ou le répertoire n'ont rien à voir avec l'application.
}
{$mode objfpc}{$H+}
interface
uses
LCLVersion,
{$IFDEF WIN32}
Windows,
{$ENDIF}
Classes, SysUtils, Dialogs;
procedure AideEnLigne; overload;
procedure AideEnLigne(Fch: string); overload;
procedure AideEnLigne(Rep, Fch: string); overload;
implementation
{$IFDEF UNIX}
uses
{$IF (lcl_major = 0) and (lcl_minor = 9) and (lcl_release < 27)}
Process;
{$ELSE}
UTF8Process;
{$ENDIF}
{$ENDIF}
procedure MessageErreur(Fch: string);
begin
MessageDlg('Le fichier "'+Fch+'" n''a pas été trouvé', mtWarning, [mbOK], 0);
end;
procedure Aide(Rep, Fch: string);
{$IFDEF UNIX}
var
{$IF (lcl_major = 0) and (lcl_minor = 9) and (lcl_release < 27)}
Prc: TProcess;
{$ELSE}
Prc: TProcessUTF8;
{$ENDIF}
{$ENDIF}
begin
{$IFDEF UNIX}
{$IF (lcl_major = 0) and (lcl_minor = 9) and (lcl_release < 27)}
Prc:= TProcess.Create(nil);
{$ELSE}
Prc:= TProcessUTF8.Create(nil);
{$ENDIF}
Prc.CurrentDirectory:= Rep;
Prc.CommandLine:= 'xdg-open '+Fch;
Prc.Execute;
if Prc.ExitStatus <> 0 then
MessageErreur(Fch);
Prc.Free;
{$ENDIF}
{$IFDEF WIN32}
if ShellExecute(0, 'open', PChar(Fch), nil, PChar(Rep), SW_SHOWNORMAL) <= 32 then
MessageErreur(Fch);
{$ENDIF}
end;
procedure AideEnLigne;
begin
Aide(ExtractFileDir(ParamStr(0)),
ChangeFileExt(ExtractFileName(ParamStr(0)),'.html'));
end;
procedure AideEnLigne(Fch: string);
begin
Aide(ExtractFileDir(ParamStr(0)), Fch);
end;
procedure AideEnLigne(Rep, Fch: string);
begin
Aide(Rep, Fch);
end;
end. |
Partager