unit MainForm;

{$I ..\..\..\Lib\PDFlibDefines.inc}

interface

uses
{$IFDEF XE2+}
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
  Xml.XMLDoc, Xml.XMLIntf,
{$ELSE}
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ComCtrls,
  XMLDoc, XMLIntf,
{$ENDIF}
  PDFlibrary;

type
  TForm1 = class(TForm)
    Button1: TButton;
    dlgOpen: TOpenDialog;
    dlgSave: TSaveDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function RGBStringToColor(const RGB: string): TColor;
    procedure ConvertRGBToFloatValues(Color: TColor; var R, G, B: Single);
    procedure ProcessStampChildren(PDFlib: TPDFlib; StampNode: IXMLNode; Fonts: TStringList);
    procedure ApplyFormattingFromXML(PDFlib: TPDFlib; const XmlFile: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  PDFlib: TPDFlib;
  SourceFile, XmlFile: string;
begin
  // Set up the open file dialog
  dlgOpen.InitialDir := ExtractFilePath(ParamStr(0));
  dlgOpen.Filter := 'PDF files (*.pdf)|*.pdf';
  
  if dlgOpen.Execute then
  begin
    SourceFile := dlgOpen.FileName;
    
    // Set up the save file dialog
    dlgSave.InitialDir := ExtractFilePath(SourceFile);
    dlgSave.FileName := ChangeFileExt(ExtractFileName(SourceFile), '_formatted.pdf');
    
    if dlgSave.Execute then
    begin
      // Get the resource path
      XmlFile := ExtractFilePath(ParamStr(0)) + 'long-title.xml';
      
      // Create a PDFlib instance
      PDFlib := TPDFlib.Create;
      try
        // Load the source PDF file
        if PDFlib.LoadFromFile(SourceFile, '') = 0 then
        begin
          ShowMessage('Failed to load file: ' + SourceFile);
          Exit;
        end;
        
        // Set the origin to the top-left corner
        PDFlib.SetOrigin(1);
        
        // Set the measurement unit to points
        PDFlib.SetMeasurementUnits(0);
        
        // Apply the formatting defined in the XML file
        ApplyFormattingFromXML(PDFlib, XmlFile);
        
        // Compress the content and save
        PDFlib.CompressContent;
        PDFlib.CompressFonts(1); // Compress fonts
        PDFlib.CompressImages(1); // Ensure images are also compressed
        
        if PDFlib.SaveToFile(dlgSave.FileName) = 1 then
          ShowMessage('PDF file created successfully: ' + dlgSave.FileName)
        else
          ShowMessage('Failed to save file');
      finally
        PDFlib.Free;
      end;
    end;
  end;
end;

function TForm1.RGBStringToColor(const RGB: string): TColor;
var
  Parts: TStringList;
  R, G, B: Integer;
begin
  Result := clBlack; // Default to black
  
  Parts := TStringList.Create;
  try
    Parts.Delimiter := ' ';
    Parts.DelimitedText := RGB;
    
    if Parts.Count >= 3 then
    begin
      R := StrToIntDef(Parts[0], 0);
      G := StrToIntDef(Parts[1], 0);
      B := StrToIntDef(Parts[2], 0);
      Result := (B shl 16) or (G shl 8) or R;
    end;
  finally
    Parts.Free;
  end;
end;

procedure TForm1.ConvertRGBToFloatValues(Color: TColor; var R, G, B: Single);
var
  RGBValue: Integer;
begin
  RGBValue := ColorToRGB(Color);
  R := GetRValue(RGBValue) / 255.0;
  G := GetGValue(RGBValue) / 255.0;
  B := GetBValue(RGBValue) / 255.0;
end;

procedure TForm1.ApplyFormattingFromXML(PDFlib: TPDFlib; const XmlFile: string);
var
  XMLDoc: IXMLDocument;
  RootNode, StampNode: IXMLNode;
  i: Integer;
  RectParts: TStringList;
  Fonts: TStringList; // Store loaded fonts
begin
  // Check if the XML file exists
  if not FileExists(XmlFile) then
  begin
    ShowMessage('XML file not found: ' + XmlFile);
    Exit;
  end;
  
  // Create an XML document object
  XMLDoc := TXMLDocument.Create(nil);
  RectParts := TStringList.Create;
  Fonts := TStringList.Create;
  
  try
    // Load the XML file
    XMLDoc.LoadFromFile(XmlFile);
    XMLDoc.Active := True;
    
    // Get the root node and find the stamp node
    RootNode := XMLDoc.DocumentElement;
    
    if RootNode = nil then
    begin
      ShowMessage('Invalid XML file structure');
      Exit;
    end;
    
    // Debug the XML structure
    // ShowMessage('Root node name: ' + RootNode.NodeName);
    
    // Look for the ps:stamp node
    StampNode := nil;
    for i := 0 to RootNode.ChildNodes.Count - 1 do
    begin
      if RootNode.ChildNodes[i].NodeName = 'ps:stamp' then
      begin
        StampNode := RootNode.ChildNodes[i];
        Break;
      end;
    end;
    
    if StampNode = nil then
    begin
      ShowMessage('Cannot find ps:stamp node in XML');
      Exit;
    end;
    
    // Process all pages
    for i := 1 to PDFlib.PageCount do
    begin
      PDFlib.SelectPage(i);
      
      // Process all child nodes of stamp
      ProcessStampChildren(PDFlib, StampNode, Fonts);
    end;
    
  finally
    RectParts.Free;
    Fonts.Free;
    XMLDoc := nil;
  end;
end;

procedure TForm1.ProcessStampChildren(PDFlib: TPDFlib; StampNode: IXMLNode; Fonts: TStringList);
var
  i, j, FontID: Integer;
  ChildNode: IXMLNode;
  NodeName, FontPath, Text, ColorStr, Position: string;
  FontSize: Double;
  Color: TColor;
  R, G, B: Single;
  X, Y: Double;
  ImageFilename, ImageRect: string;
  RectParts: TStringList;
  ImgX, ImgY, ImgWidth, ImgHeight: Double;
  ImageID: Integer;
  AllTexts: string; // Used to collect all text for font subsetting
begin
  RectParts := TStringList.Create;
  try
    // Collect all the text to be displayed for font subsetting
    AllTexts := '';
    for i := 0 to StampNode.ChildNodes.Count - 1 do
    begin
      ChildNode := StampNode.ChildNodes[i];
      NodeName := ChildNode.NodeName;
      
      // Remove namespace prefix if present
      if Pos(':', NodeName) > 0 then
        NodeName := Copy(NodeName, Pos(':', NodeName) + 1, Length(NodeName));
      
      if NodeName = 'filltext' then
      begin
        Text := ChildNode.Attributes['text'];
        if Text <> '' then
          AllTexts := AllTexts + Text;
      end;
    end;
    
    // Process each child of the stamp node
    for i := 0 to StampNode.ChildNodes.Count - 1 do
    begin
      ChildNode := StampNode.ChildNodes[i];
      NodeName := ChildNode.NodeName;
      
      // Remove namespace prefix if present
      if Pos(':', NodeName) > 0 then
        NodeName := Copy(NodeName, Pos(':', NodeName) + 1, Length(NodeName));
      
      // Process image nodes
      if NodeName = 'image' then
      begin
        // Get the image filename and rectangle area
        ImageFilename := ChildNode.Attributes['filename'];
        ImageRect := ChildNode.Attributes['rect'];
        
        if (ImageFilename <> '') and (ImageRect <> '') then
        begin
          // Parse the rectangle coordinates
          RectParts.Clear;
          RectParts.Delimiter := ' ';
          RectParts.DelimitedText := ImageRect;
          
          if RectParts.Count >= 4 then
          begin
            ImgX := StrToFloatDef(RectParts[0], 0);
            ImgY := StrToFloatDef(RectParts[1], 0);
            ImgWidth := StrToFloatDef(RectParts[2], 0);
            ImgHeight := StrToFloatDef(RectParts[3], 0);
            
            // Load the image
            PDFlib.CompressImages(1);
            ImageID := PDFlib.AddImageFromFile(ExtractFilePath(ParamStr(0)) + ImageFilename, 0);
            
            if ImageID > 0 then
            begin
              // Draw the image
              PDFlib.SelectImage(ImageID);
              PDFlib.DrawImage(ImgX, ImgY, ImgWidth, ImgHeight);
            end
            else
            begin
              ShowMessage('Failed to load image: ' + ImageFilename);
            end;
          end;
        end;
      end
      // Process text nodes
      else if NodeName = 'filltext' then
      begin
        // Get the text attributes
        Text := ChildNode.Attributes['text'];
        FontPath := ChildNode.Attributes['font'];
        Position := ChildNode.Attributes['position'];
        ColorStr := ChildNode.Attributes['color'];
        
        try
          FontSize := StrToFloatDef(ChildNode.Attributes['size'], 10);
        except
          FontSize := 10; // Default font size
        end;
        
        if (Text <> '') and (FontPath <> '') and (Position <> '') then
        begin
          // Parse the position coordinates
          RectParts.Clear;
          RectParts.Delimiter := ' ';
          RectParts.DelimitedText := Position;
          
          if RectParts.Count >= 2 then
          begin
            X := StrToFloatDef(RectParts[0], 0);
            Y := StrToFloatDef(RectParts[1], 0);
            
            // Find or load the font
            j := Fonts.IndexOf(FontPath);
            if j >= 0 then
              FontID := Integer(Fonts.Objects[j])
            else
            begin
              // Load subset fonts
              FontID := PDFlib.AddTrueTypeSubsettedFont(FontPath, AllTexts, 5);
              
              if FontID > 0 then
                Fonts.AddObject(FontPath, TObject(FontID))
              else
                ShowMessage('Failed to load font: ' + FontPath);
            end;
            
            // Set the color
            if ColorStr <> '' then
            begin
              Color := RGBStringToColor(ColorStr);
              ConvertRGBToFloatValues(Color, R, G, B);
              PDFlib.SetTextColor(R, G, B);
            end;
            
            // Draw the text
            if FontID > 0 then
            begin
              PDFlib.SelectFont(FontID);
              PDFlib.SetTextSize(FontSize);
              PDFlib.DrawText(X, Y, Text);
            end;
          end;
        end;
      end;
    end;
  finally
    RectParts.Free;
  end;
end;

end.