unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl,
  StdCtrls, ExtCtrls, IniFiles, ComCtrls, Variants, HTMLPars, ComObj, aspPDF_TLB,
  QLocal, QFormLocal, QLocalUserSource;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    btnClose: TButton;
    Label1: TLabel;
    Label2: TLabel;
    ProgressBar1: TProgressBar;
    lblDLLVersion: TLabel;
    OpenDialog1: TOpenDialog;
    btnConvert: TButton;
    PageControl: TPageControl;
    tbsMain: TTabSheet;
    TabSheet2: TTabSheet;
    cbCompress: TCheckBox;
    cbPatternHeader: TCheckBox;
    edOutPDF: TEdit;
    Button3: TButton;
    btnFindCHM: TButton;
    edPrjCHM: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    edTitle: TEdit;
    Label5: TLabel;
    tbsLogs: TTabSheet;
    mmLogs: TMemo;
    cbPatternFooter: TCheckBox;
    cbPatternProdInfo: TCheckBox;
    QUserLanguageSource1: TQUserLanguageSource;
    QFormLocalizer1: TQFormLocalizer;
    procedure btnConvertClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnFindCHMClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    procedure Process_Contents;
    procedure Process_TOC;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  PDF : Variant;
  enlapsed : TDateTime;

const
  SELDIRHELP = 1000;

implementation

{$R *.DFM}


procedure TfrmMain.FormCreate(Sender: TObject);
begin
  PageControl.ActivePage := tbsMain;
  mmLogs.Lines.Add('Program started '+timetostr(now));
 TRY
  PDF := CreateComObject(CLASS_EASYPDF) as IEASYPDF;
  PDF.License( 'easypdf.lic' );
  lblDLLVersion.Caption := PDF.Version  ;
  mmLogs.Lines.Add('PDF Version:  '+PDF.Version);
  PDF := Unassigned;
 EXCEPT
  on E: Exception do begin
    mmLogs.Lines.Add('ERROR COM' + E.message );
    ShowMessage('aspEasyPDF.DLL is not registered on the system or is not licensed');
  end;
 END;
end;

procedure TfrmMain.btnConvertClick(Sender: TObject);
begin
  PageControl.ActivePage := tbsLogs;
  enlapsed := Now;
  mmLogs.Lines.Add('');
  mmLogs.Lines.Add('=========================================================');
  mmLogs.Lines.Add('Running: ' + edPrjCHM.Text);
  Screen.Cursor := crHourGlass;
  PDF := Unassigned;    // Unassign memory to assure there is no existent PDF in memory
  PDF := CreateComObject(CLASS_EASYPDF) as IEASYPDF;
  PDF.License( 'easypdf.lic' );

  if cbCompress.Checked then begin
      PDF.SetProperty( 507, 1 );
      mmLogs.Lines.Add('COMPRESS ON');
  end;
  // ProcessContents
  Process_Contents;
  Process_TOC;

  if cbPatternHeader.Checked then
  begin
    mmLogs.Lines.Add('Adding Patterns Header');
    PDF.AddPattern( 0, 0, 0, 10, '<p align="center"><b>'+edTitle.Text+'</p>');
  end;
  if cbPatternFooter.Checked then
  begin
    mmLogs.Lines.Add('Adding Patterns Footers');
    PDF.AddPattern( 1, 0, 0, 10, '<p align="center"><!-PDF.PAGENUMBER>&nbsp;/&nbsp;<!-PDF.PAGECOUNT></p>');
  end;
  if cbPatternProdInfo.checked then
  begin
    mmLogs.Lines.Add('Adding Product information Footers');
    PDF.AddPattern( 1, 0, 0, 30, '<table align="center" bgcolor="#FFFF00" width="90%" border=1><tr><td align="center">Generated with aspEasyPDF library using demo sample CHM2PDF</td></tr></table>');
  end;

//  mmLogs.Lines.Add('Enlapsed time '+timetostr(now-Enlapsed));
  mmLogs.Lines.Add('');
  mmLogs.Lines.Add('Save file to: '+edOutPDF.Text);
  PDF.Save( edOutPDF.Text );
//  mmLogs.Lines.Add('Enlapsed time '+timetostr(now-Enlapsed));
  mmLogs.Lines.Add('');
  mmLogs.Lines.Add('=========================================================');
  PDF := Unassigned;

  Screen.Cursor := crDefault;
  ShowMessage('OK');
end;

{     Add all contents of the HTML file
}
procedure TfrmMain.Process_Contents;
var
  F: TextFile;
  S, Direc: string;
  cargar, FirstPage : boolean;
begin
  Direc := ExtractFileDir( edPrjCHM.Text );
  AssignFile(F, edPrjCHM.Text);   { File selected in dialog box }
  Reset(F);
  Cargar    := False;
  FirstPage := True;
  while not eof(f) do
  begin
    Readln(F, S);                          { Read the first line out of the file }
    if Pos('[', s)  = 1 then Cargar := False;
    if (cargar) and (s <> '') then
    begin
      try
        if FileExists( Direc + '\' + S ) then begin
              PDF.SetMargins (20,20,35,50);
              if not FirstPage then PDF.AddPage;
              mmLogs.Lines.Add('AddLink ' + s);
              PDF.AddLink('', S, 2);
              mmLogs.Lines.Add('AddHTML file:///'+Direc + '\' + S);
              PDF.AddHTML( 'file:///'+Direc + '\' + S );
              FirstPage := False;
              Application.ProcessMessages;
        end;
      except
        on E: Exception do begin
            mmLogs.Lines.Add('ERROR: ' + E.message );
        end;
      end;
    end;
    if s = '[FILES]' then Cargar := True;
  end;
  CloseFile(F);
end;


{ Create the TOC index with Outlines on the PDF
}
procedure TfrmMain.Process_TOC;
var
  hhpIni    : TIniFile;
  TocFile   : String;
  HTMLParser: THTMLParser;
  obj       : TObject;
  HTMLTag   :THTMLTag;
  HTMLParam :THTMLParam;
  i,j       : integer;
  Name,Local:string;
  OL_object : boolean;
  ParType   : integer;
  //  Store the tree level pointers
  tocs_indx : array[0..20] of string;
  ntocs_indx: integer;
begin
  OL_object := False;
  ntocs_indx:= 0;

  hhpIni  := TIniFile.Create( edPrjCHM.Text );
  TocFile := hhpIni.ReadString('OPTIONS','Contents file','');
  hhpIni.Free;

  TocFile := ExtractFileDir( edPrjCHM.Text ) + '\' + TocFile;

  if FileExists( TocFile ) then
  begin
    HTMLParser := THTMLParser.Create;
    HTMLParser.Memory.LoadFromFile( TocFile );
    HTMLParser.Execute;
    //
    for i:= 0 to HTMLParser.parsed.count - 1 do
    begin
      obj := HTMLParser.parsed[i];
      try
       // TAGS
       if obj.classtype = THTMLTag then
       begin
          HTMLTag := THTMLTag(obj);
          // UL
          if SameText(HTMLTag.Name,'UL') then
          begin
            inc( ntocs_indx );
          end;
          // /UL
          if SameText(HTMLTag.Name,'/UL') then
          begin
            dec( ntocs_indx );
          end;
          // LI
          if SameText(HTMLTag.Name,'LI') then
          begin
          end;
          // /LI
          if SameText(HTMLTag.Name,'/LI') then
          begin
          end;
          // OBJECT
          if SameText(HTMLTag.Name,'OBJECT') then
          begin
            OL_object := false;
            if HTMLTag.Params <> nil then
              for j:= 0 to HTMLTag.Params.count -1 do
              begin
                HTMLParam:=HTMLTag.Params[j];
                // Name
                if SameText(HTMLParam.Key,'TYPE') then
                    if (lowercase(HTMLParam.Value) = 'text/sitemap') then
                         OL_object := true;
              end;
          end;
          // /OBJECT
          if SameText(HTMLTag.Name,'/OBJECT') then
          begin
            if OL_object then
                 tocs_indx[ntocs_indx] := PDF.AddOutline(tocs_indx[ntocs_indx-1], Name, Local, 3);
            OL_object := False;
            Name      := '';
            Local     := '';
          end;
          // PARAM
          if SameText(HTMLTag.Name,'PARAM') then
          begin
            ParType := -1;
            if HTMLTag.Params <> nil then
              for j:= 0 to HTMLTag.Params.count -1 do
              begin
                HTMLParam:=HTMLTag.Params[j];
                // Name and Local
                if SameText(HTMLParam.Key,'NAME') then 
                    if (LowerCase(HTMLParam.Value) = 'name') then ParType := 0
                     else
                    if (LowerCase(HTMLParam.Value) = 'local') then ParType := 1;
                // Value
                if SameText(HTMLParam.Key,'VALUE') then
                    if ParType = 0 then Name := HTMLParam.Value
                      else
                        if ParType = 1 then Local := HTMLParam.Value;
              end;
          end;
       end;
      except
      end;
    end;
    HTMLParser.Free;
  end;

end;

procedure TfrmMain.btnFindCHMClick(Sender: TObject);
var
  Fil : string;
begin
  OpenDialog1.DefaultExt := 'hhp';
  OpenDialog1.Filter := 'Help Project file|*.hhp';
  if OpenDialog1.Execute then begin
       edPrjCHM.Text := OpenDialog1.FileName;
       Fil := ExtractFileName( edPrjCHM.Text );
       edOutPDF.Text := lowercase(ExtractFileDir( edPrjCHM.Text ) + '\'+Copy( Fil, 1, Length(Fil )-3 ) + 'pdf');
  end;
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.Button3Click(Sender: TObject);
var
  Dir: string;
  Fil: string;
begin
  Dir := ExtractFileDir( edOutPDF.Text );
  if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
  begin
    Fil := ExtractFileName( edPrjCHM.Text );
    edOutPDF.Text := lowercase(Dir + '\'+Copy( Fil, 1, Length(Fil )-3 ) + 'pdf');
  end;
end;

end.
