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 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, PDFCreator_TLB, StdCtrls, ExtCtrls;
const
{Time-out}
MaxTime = 20;
type
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
OpenDialog1: TOpenDialog;
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Déclarations privées }
{ Instance de PDF Creator }
PDFCreator: TclsPDFCreator;
{Instance du gestionnaire d'erreurs de PDF Creator.
Sera affecté en cas d'erreur uniquement.}
PDFError: clsPDFCreatorError;
{Flag indiquant la disponibilité du document produit}
ReadyState: boolean;
{Méthode chargée du lancement de l'impression.
Le paramètre FileType indique le type de document à produire.}
//procedure PrintIt(FileType: integer);
{Gestionnaire des erreurs pour PDF Creator}
procedure PDFCreatorError(Sender: TObject);
{Gestionnaire permettant un traitement lorsque PDF Creator a fini
la production d'un document PDF.}
procedure PDFCreatorReady(Sender: TObject);
public
{ Déclarations publiques }
{Convertire le fichier vers pdf}
procedure ConvertToPdf(FileType: integer; CheminFichier:String);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if(OpenDialog1.Execute())then
ConvertToPdf(0,OpenDialog1.FileName);
end;
procedure TForm1.ConvertToPdf(FileType: integer;CheminFichier : String);
Var
FName, Error, Parameters : String;
DefaultPrinter: Widestring;
Opt: clsPDFCreatorOptions;
begin
Error := '';
//instanciation de PDF Creator
Timer1.Enabled := False;
PDFCreator := TclsPDFCreator.Create(Self);
//Connexion des gestionnaires d'évènements
PDFCreator.OneError := PDFCreatorError;
PDFCreator.OneReady := PDFCreatorReady;
//pas de traitement au démarrage
Parameters := '/NoProcessingAtStartup';
//teste si on peut démarrer le serveur
if not PDFCreator.cStart(Parameters, False) then
begin
Error:= 'Status : Erreur[' + IntToStr(PDFError.Number)
+ '] : ' + PDFError.Description;
MessageBox(0,'Erreur de connexion au PDFCreator','ERREUR',MB_ICONERROR or MB_OK);
end;
if Error = '' then
begin
FName := ExtractFileName(CheminFichier);
FName := ChangeFileExt(FName,'');
//Options de conversion du document
Opt := PDFCreator.cOptions;
Opt.UseAutosave := 1;
Opt.UseAutosaveDirectory := 1;
Opt.AutosaveDirectory := ExtractFilePath(CheminFichier);
Opt.AutosaveFormat := FileType;
//non documenté !
// if FileType = 5 then
// Opt.BitmapResolution := 72;
Opt.AutosaveFilename := FName;
PDFCreator.cOptions := Opt;
PDFCreator.cClearCache;
//sauvegarde du nom de l'imprimante actuelle
DefaultPrinter := PDFCreator.cDefaultPrinter;
PDFCreator.cDefaultPrinter := 'PDFCreator';
PDFCreator.cPrintFile(CheminFichier);
PDFCreator.cPrinterStop := False;
ReadyState := False;
//Boucle d'attente de fin de traitement
Timer1.Interval := MaxTime * 1000;
Timer1.Enabled := True;
while not ReadyState and Timer1.Enabled do
Application.ProcessMessages;
// si timeout...
if not ReadyState then
MessageBox(0, 'Une erreur s''est produite : dépassement du temps alloué', 'Création de la page de test', MB_ICONEXCLAMATION or MB_OK);
PDFCreator.cPrinterStop := True;
//restauration du nom de l'imprimante
PDFCreator.cDefaultPrinter := DefaultPrinter;
//Fermeture du seveur
PDFCreator.cClose;
PDFCreator.Free;
end;
end;
procedure TForm1.PDFCreatorError(Sender: TObject);
begin
//Affectation de l'interface
PDFError := PDFCreator.cError;
end;
procedure TForm1.PDFCreatorReady(Sender: TObject);
var
Error : String;
begin
//La conversion en PDF s'est correctement déroulée
Error := 'Status : "' + PDFCreator.cOutputFilename + '" créé !';
PDFCreator.cPrinterStop := True;
ReadyState := True;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
//arrêt du timer
Timer1.Enabled := False;
end;
end. |
Partager