Pascal (Lazarus/Delphi)

Add XMP MetaData to JPG or TIFF

See more XMP Examples

Demonstrates how to add XMP metadata to a JPG or TIFF image that doesn't already have XMP metadata. Pascal (Lazarus/Delphi)

program ChilkatDemo;

// Demonstrates using the Chilkat Pascal wrapper via the C bridge DLL.
// Builds as a console application under Lazarus (FPC) or Delphi.

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  SysUtils,
  CkDllLoader,
  Chilkat.Xmp,
  Chilkat.Xml;

// ---------------------------------------------------------------------------

procedure RunDemo;
var
  success: Boolean;
  xmp: TXmp;
  xml: TXml;

begin
  success := False;

  //  This example assumes the Chilkat API to have been previously unlocked.
  //  See Global Unlock Sample for sample code.

  xmp := TXmp.Create;

  //  The first step is to create a new XMP document, which is nothing
  //  more than XML.  The NewXmp method returns an XML document with
  //  the standard XMP boilerplate.  
  xml := xmp.NewXmp();

  //  Add some properties...
  success := xmp.AddSimpleStr(xml,'Iptc4xmpCore:Chilkat','Blah blah');
  //  If you wish to view the XML, save it to a file and review it
  //  with a text editor:
  success := xml.SaveXml('newXmp.xml');
  if (success <> True) then
    begin
      WriteLn(xml.LastErrorText);
      Exit;
    end;

  //  To add the XMP to the JPG (or TIFF), simply load the JPG,
  //  append the XMP, and save:
  success := xmp.LoadAppFile('scream.jpg');
  if (success <> True) then
    begin
      WriteLn(xmp.LastErrorText);
      Exit;
    end;
  success := xmp.Append(xml);
  if (success <> True) then
    begin
      WriteLn(xmp.LastErrorText);
      Exit;
    end;
  success := xmp.SaveAppFile('screamOut.jpg');
  if (success <> True) then
    begin
      WriteLn(xmp.LastErrorText);
      Exit;
    end;


  xmp.Free;

end;

// ---------------------------------------------------------------------------

begin

  try
    RunDemo;
  except
    on E: Exception do
      WriteLn('Unhandled exception: ', E.ClassName, ': ', E.Message);
  end;

  WriteLn;
  {$IFDEF MSWINDOWS}
  WriteLn('Press Enter to exit...');
  ReadLn;
  {$ENDIF}
end.