{------------------------------------------------------------------------------}
{                                                                              }
{  Helper functions for working with IPTC fields with ImageEn                  }
{                                                                              }
{  Nigel Cross                                                                 }
{  Xequte Software                                                             }
{  nigel@xequte.com                                                            }
{  http://www.xequte.com                                                       }
{                                                                              }
{  © Xequte Software 2009-2014                                                 }
{                                                                              }
{  Modified 16/4/13                                                            }
{  TListView support added by William Miller, Adirondack Software & Graphics   }
{------------------------------------------------------------------------------}

(*
Copyright (c) 1998-2014 by Carlotta Calandra. All rights reserved.
Copyright (c) 2011-2014 by Xequte software.

This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

Author grants you the right to include the component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE.

ImageEn, IEvolution and ImageEn ActiveX may not be included in any
commercial, shareware or freeware libraries or components.
*)

(*
File version 1005
*)

// STRING GRID SUPPORT
// Define to include methods for loading and saving content to/from TStringGrids
{$DEFINE USE_STRINGGRIDS}


// LIST VIEW SUPPORT
// Define to include methods for loading and saving content to/from TListViews
{$DEFINE USE_LISTVIEW}

unit iexIPTCRoutines;

{$I ie.inc}

{$ifdef IEHASUNICODEWARNS}
{$WARN IMPLICIT_STRING_CAST OFF}
{$WARN IMPLICIT_STRING_CAST_LOSS OFF}
{$endif}

interface

uses
{$IFDEF USE_STRINGGRIDS}
  grids,
{$ENDIF}
{$IFDEF USE_LISTVIEW}
  ComCtrls,
{$ENDIF}
  Windows, ImageEnIO, Classes;

// Removes extraneous characters often found in IPTC Data, such as null terminators
function TidyIPTCStr(const Value: string): string;

// return true if the specified filename supports writing of IPTC Fields
function IPTCCompatibleFile(sFilename: string): boolean;

{$IFDEF USE_STRINGGRIDS}
// sets up a string grid for IPTC editing/display, by adding all property names
// also adds a header row if FixedRow>=1
procedure InitializeIPTCStringGrid(AStringGrid: TStringGrid);
{$ENDIF}

{$IFDEF USE_LISTVIEW}
// sets up a listview for IPTC editing/display, by adding all property names
// also adds a header row if FixedRow>=1
procedure InitializeIPTCListView(AListView: TListView);
{$ENDIF}

{$IFDEF USE_STRINGGRIDS}
// loads the IPTC fields for the specified file into the String Grid
// if bLoadParams=false then it is assumed that AnImageEnIO has already loaded the file
// result is whether the file has any fields specified
function LoadIPTCFields(AStringGrid: TStringGrid;
                        sFilename: string;
                        AnImageEnIO: TImageEnIO;
                        bLoadParams: boolean = true): boolean; overload;
{$ENDIF}

{$IFDEF USE_LISTVIEW}
// loads the IPTC fields for the specified file into the Listview
// if bLoadParams=false then it is assumed that AnImageEnIO has already loaded the file
// result is whether the file has any fields specified
function LoadIPTCFields(AListView: TListView;
                        sFilename: string;
                        AnImageEnIO: TImageEnIO;
                        bLoadParams: boolean = true): boolean; overload;
{$ENDIF}

{$IFDEF USE_STRINGGRIDS}
// save the IPTC fields in the specified stringgrid to the file
procedure SaveIPTCFields(AStringGrid: TStringGrid;
                         sFilename: string;
                         AnImageEnIO: TImageEnIO;
                         const bMaintainFileDates: Boolean; // if true the file date is not modified when saving the file
                         bVerbose: Boolean); overload; // Show Error message for non_JPEG and TIFF files
{$ENDIF}

{$IFDEF USE_LISTVIEW}
// save the IPTC fields in the specified stringgrid to the file
procedure SaveIPTCFields(AListView: TListView;
                         sFilename: string;
                         AnImageEnIO: TImageEnIO;
                         const bMaintainFileDates: Boolean; // if true the file date is not modified when saving the file
                         bVerbose: Boolean); overload; // Show Error message for non_JPEG and TIFF files
{$ENDIF}

{$IFDEF USE_STRINGGRIDS}
// Clear the IPTC fields from the specified ImageEnIO object and in the specified stringgrid
procedure ClearIPTCFields(AStringGrid: TStringGrid; AnImageEnIO: TImageEnIO); overload;
{$ENDIF}

{$IFDEF USE_LISTVIEW}
// Clear the IPTC fields from the specified ImageEnIO object and in the specified stringgrid
procedure ClearIPTCFields(AListView: TListView; AnImageEnIO: TImageEnIO); overload;
{$ENDIF}

// save the IPTC description and keywords to the specified file
procedure WriteIPTCDescriptionAndKeywords(sFilename: string;
                                          sDescription: string;
                                          ssKeywords: TStrings;
                                          AnImageEnIO: TImageEnIO;
                                          const bMaintainFileDates: boolean; // if true the file date is not modified when saving the file
                                          bVerbose: Boolean); // Show Error message for non_JPEG and TIFF files

// saves the IPTC description ot the specified file
procedure WriteIPTCDescription(sFilename: string;
                               sDescription: string;
                               AnImageEnIO: TImageEnIO;
                               const bMaintainFileDates: boolean; // if true the file date is not modified when saving the file
                               bVerbose: Boolean);                // Show Error message for non_JPEG and TIFF files

implementation

uses
  Sysutils, Dialogs, hyieutils;

type
  iptc_item = record
    r: integer;
    d: integer;
    s: string;
  end;

const

  IPTC_COMPATIBLE_EXTENSIONS = '*.TIF;*.TIFF;*.JPE;*.JPG;*.JPEG;';

  iptc : array [0..30] of iptc_item=(
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Title;	                s : 'Title'),    // Object name
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Caption;	            s : 'Caption'),  // Caption/Abstract
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Keywords;	            s : 'Keywords'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Instructions;	        s : 'Special Instructions'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Date_Created;	        s : 'Date Created (YYYYMMDD)'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Time_Created;           s : 'Time Created (HHMMSS±HHMM)'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Byline_1;	            s : 'By-line 1'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Byline_2;	            s : 'By-line 2'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_City;	                s : 'City'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_State_Province;	        s : 'State/Province'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Country_Code;	        s : 'Country/Primary Location Code'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Country;                s : 'Country/Primary Location Name'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Transmission_Reference; s : 'Original Transmission Reference'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Credit;	                s : 'Credit'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Source;	                s : 'Source'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Writer;	                s : 'Writer/Editor'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Edit_Status;            s : 'Edit status'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Urgency;	            s : 'Urgency'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Category;	            s : 'Category'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Category_2;	            s : 'Supplemental Category'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Fixture_Identifier;	    s : 'Fixture Identifier'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Release_Date;	        s : 'Release Date (YYYYMMDD)'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Release_Time;	        s : 'Release Time (HHMMSS±HHMM)'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Reference_Service;	    s : 'Reference Service'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Reference_Date;	        s : 'Reference Date (YYYYMMDD)'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Reference_Number;	    s : 'Reference Number'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Originating_Program;    s : 'Originating Program'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Program_Version;	    s : 'Program Version'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Object_Cycle;	        s : 'Object Cycle (a=AM, b=PM, c=both)'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Copyright_Notice;	    s : 'Copyright Notice'),
    (r : PhotoShop_IPTC_Records;    d : IPTC_PS_Image_Type;             s : 'Image Type'));


                                             
// return true if the specified filename support writing of IPTC Fields
function IPTCCompatibleFile(sFilename : string) : boolean;
begin
  result := IEFilenameInExtensions(sFilename, IPTC_COMPATIBLE_EXTENSIONS);
end;

{$IFDEF USE_STRINGGRIDS}
// set up a string grid for IPTC editing/display, by adding all property names
// also adds a header row if FixedRow>=1
procedure InitializeIPTCStringGrid(AStringGrid: TStringGrid);
var
  i: integer;
begin
  with AStringGrid do
  begin
    // add a row for each IPTC plus the header (if tjhere is a fixed row)
    RowCount := high(iptc) + 1 + AStringGrid.FixedRows;

    // header row
    Cells[0, 0] := 'Property';
    Cells[1, 0] := 'Value';

    // fill the fields with the IPTC property names
    for i := low(iptc) to high(iptc) do
      Cells[0, i + AStringGrid.FixedRows] := iptc[i].s;
  end;
end;
{$ENDIF}

{$IFDEF USE_LISTVIEW}
// sets up a listview for IPTC editing/display, by adding all property names
// also adds a header row if FixedRow>=1
procedure InitializeIPTCListView(AListView: TListView);
var
  i: integer;
  iListColumn: TListColumn;
  iListItem: TListItem;
begin
  if AListView.Columns.Count = 0 then
  begin
    { setup the columns }
    iListColumn := AListView.Columns.Add;
    iListColumn.Caption := 'Parameter';
    iListColumn.Width := 200;
    iListColumn.AutoSize := True;
    iListColumn := AListView.Columns.Add;
    iListColumn.Caption := 'Value';
    iListColumn.Width := 450;
    iListColumn.AutoSize := True;
    // fill the fields with the IPTC property names
    for i := low(iptc) to high(iptc) do
    begin
      iListItem := AListView.Items.Add;
      iListItem.Caption := iptc[i].s;
      iListItem.SubItems.Add('');
    end;
  end;
end;
{$ENDIF}

{$IFDEF USE_STRINGGRIDS}
// load the IPTC fields for the specified file into the String Grid
// if bLoadParams=false then it is assumed that AnImageEnIO has already loaded the file
// result is whether the file has any fields specified
function LoadIPTCFields(AStringGrid: TStringGrid;
                        sFilename : string;
                        AnImageEnIO : TImageENIO;
                        bLoadParams : boolean=true) : boolean;
var
  i, iKeyword: integer;
  sValue: string;
  Idx: Integer;
  sKeyword: string;
begin
  result := false;

  if bLoadParams then
    AnImageEnIO.ParamsFromFile(sFilename);

  // set properties to properties grid
  for i := low(iptc) to high(iptc) do
    with AnImageEnIO.Params.IPTC_Info do
    begin
      sValue := '';

      // KEYWORD FIELD
      if (iptc[i].r = PhotoShop_IPTC_Records) and (iptc[i].d = IPTC_PS_Keywords) then
      begin
        // get the keywords
        Idx := AnImageEnIO.Params.IPTC_Info.IndexOf(PhotoShop_IPTC_Records, IPTC_PS_Keywords);
        if idx > -1 then
        begin
          for iKeyword := idx to AnImageEnIO.Params.IPTC_Info.count - 1 do
            if (AnImageEnIO.Params.IPTC_Info.RecordNumber[iKeyword] = PhotoShop_IPTC_Records) and
              (AnImageEnIO.Params.IPTC_Info.DataSet[iKeyword] = IPTC_PS_Keywords) then
            begin
              sKeyword := TidyIPTCStr(AnImageEnIO.Params.IPTC_Info.StringItem[iKeyword]);
              if (sValue <> '') and (sKeyword <> '') then
                sValue := sValue + ',';
              sValue := sValue + sKeyword;
            end;
        end;
      end
      else
      begin
        sValue := TidyIPTCStr(StringItem[IndexOf(iptc[i].r, iptc[i].d)]);
      end;

      AStringGrid.Cells[1, i + AStringGrid.FixedRows] := sValue;
      if sValue <> '' then result := true;
    end;
end;
{$ENDIF}

{$IFDEF USE_LISTVIEW}
// loads the IPTC fields for the specified file into the Listview
// if bLoadParams=false then it is assumed that AnImageEnIO has already loaded the file
// result is whether the file has any fields specified
function LoadIPTCFields(AListView: TListView;
  sFilename: string;
  AnImageEnIO: TImageEnIO;
  bLoadParams: boolean = true): boolean;
var
  i, iKeyword: integer;
  sValue: string;
  Idx: Integer;
  sKeyword: string;
begin
  result := false;

  if bLoadParams then
    AnImageEnIO.ParamsFromFile(sFilename);

  // set properties to properties grid
  for i := low(iptc) to high(iptc) do
    with AnImageEnIO.Params.IPTC_Info do
    begin
      sValue := '';

      // KEYWORD FIELD
      if (iptc[i].r = PhotoShop_IPTC_Records) and (iptc[i].d = IPTC_PS_Keywords) then
      begin
        // get the keywords
        Idx := AnImageEnIO.Params.IPTC_Info.IndexOf(PhotoShop_IPTC_Records, IPTC_PS_Keywords);
        if idx > -1 then
        begin
          for iKeyword := idx to AnImageEnIO.Params.IPTC_Info.count - 1 do
            if (AnImageEnIO.Params.IPTC_Info.RecordNumber[iKeyword] = PhotoShop_IPTC_Records) and
              (AnImageEnIO.Params.IPTC_Info.DataSet[iKeyword] = IPTC_PS_Keywords) then
            begin
              sKeyword := TidyIPTCStr(AnImageEnIO.Params.IPTC_Info.StringItem[iKeyword]);
              if (sValue <> '') and (sKeyword <> '') then
                sValue := sValue + ',';
              sValue := sValue + sKeyword;
            end;
        end;
      end
      else
      begin
        sValue := TidyIPTCStr(StringItem[IndexOf(iptc[i].r, iptc[i].d)]);
      end;

      AListView.Items[i].SubItems[0] := sValue;
      if sValue <> '' then result := true;
    end;
end;
{$ENDIF}

// modifies the date/time stamp of a file
// Result is true, unless there is a file load error
function SetFileDate(const sFilename: string; DateTime: TDateTime): boolean;
var
  liHandle: INTEGER;
begin
  result := False;

  if DateTime <> 0 then
    try
      liHandle := FileOpen(sFileName, fmOpenReadWrite or fmShareDenyNone);
      if liHandle > 0 then
      begin
        result := FileSetDate(liHandle, DateTimeToFileDate(DateTime)) <> 0;
        FileClose(liHandle);
      end;

    except
      // ERROR
    end;
end;

{$IFDEF USE_STRINGGRIDS}
// save the IPTC fields in the specified stringgrid to the file
procedure SaveIPTCFields(AStringGrid: TStringGrid;
  sFilename: string;
  AnImageEnIO: TImageEnIO;
  const bMaintainFileDates: Boolean; // if true the file date is not modified when saving the file
  bVerbose: Boolean); // Show Error message for non_JPEG and TIFF files
var
  i, idx: integer;
  dFileDate: TDateTime;
begin
  dFileDate := 0; // to avoid compiler warnings

  // load values from the properties grid
  for i := low(iptc) to high(iptc) do
    with AnImageEnIO.Params.IPTC_Info do
    begin
      idx := IndexOf(iptc[i].r, iptc[i].d);
      if idx < 0 then
        // item doesn't exist, create it
        AddStringItem(iptc[i].r, iptc[i].d, AStringGrid.Cells[1, i + AStringGrid.FixedRows])
      else
        // item already exists, just replace it
        StringItem[idx] := AStringGrid.Cells[1, i + AStringGrid.FixedRows];
    end;

{$WARNINGS OFF} // FileAge is deprecated
  if bMaintainFileDates then
    dFileDate := FileDateToDateTime(FileAge(sFileName));
{$WARNINGS ON}

  case AnImageEnIO.Params.FileType of
    ioJPEG: // inject iptc in jpeg
      AnImageEnIO.InjectJpegIPTC(sFileName);
    ioTIFF: // save iptc in TIFF
      AnImageEnIO.SaveToFile(sFilename);
  else
    if bVerbose then
      messagedlg('The format of the specified file does not support IPTC storage.', mtError,
        [mbok], 0);
  end;

  if bMaintainFileDates and (dFileDate <> 0) then
    SetFileDate(sFilename, dFileDate);
end;
{$ENDIF}

{$IFDEF USE_LISTVIEW}
// save the IPTC fields in the specified stringgrid to the file
procedure SaveIPTCFields(AListView: TListView;
  sFilename: string;
  AnImageEnIO: TImageEnIO;
  const bMaintainFileDates: Boolean; // if true the file date is not modified when saving the file
  bVerbose: Boolean); // Show Error message for non_JPEG and TIFF files
var
  i, idx: integer;
  dFileDate: TDateTime;
  iListItem: TListItem;
begin
  dFileDate := 0; // to avoid compiler warnings

  // load values from the properties grid
  for i := low(iptc) to high(iptc) do
    with AnImageEnIO.Params.IPTC_Info do
    begin
      idx := IndexOf(iptc[i].r, iptc[i].d);
      if idx < 0 then
      begin
        // item doesn't exist, create it
        iListItem := AListView.Items.Item[i];
        AddStringItem(iptc[i].r, iptc[i].d, iListItem.SubItems[0]);
      end
      else
      begin
        // item already exists, just replace it
        iListItem := AListView.Items.Item[i];
        StringItem[idx] := iListItem.SubItems[0];
      end;

{$WARNINGS OFF} // FileAge is deprecated
      if bMaintainFileDates then
        dFileDate := FileDateToDateTime(FileAge(sFileName));
{$WARNINGS ON}

      case AnImageEnIO.Params.FileType of
        ioJPEG: // inject iptc in jpeg
          AnImageEnIO.InjectJpegIPTC(sFileName);
        ioTIFF: // save iptc in TIFF
          AnImageEnIO.SaveToFile(sFilename);
      else
        if bVerbose then
          messagedlg('The format of the specified file does not support IPTC storage.', mtError,
            [mbok], 0);
      end;

      if bMaintainFileDates and (dFileDate <> 0) then
        SetFileDate(sFilename, dFileDate);
    end;
end;
{$ENDIF}

{$IFDEF USE_STRINGGRIDS}
// Clear the IPTC fields from the specified ImageEnIO object and in the specified stringgrid
procedure ClearIPTCFields(AStringGrid: TStringGrid;
  AnImageEnIO: TImageEnIO);
var
  i: integer;
begin
  AnImageEnIO.Params.IPTC_Info.Clear;
  for i := low(iptc) to high(iptc) do
    AStringGrid.Cells[1, i + AStringGrid.FixedRows] := '';
end;
{$ENDIF}

{$IFDEF USE_LISTVIEW}
// Clear the IPTC fields from the specified ImageEnIO object and in the specified stringgrid
procedure ClearIPTCFields(AListView: TListView;
  AnImageEnIO: TImageEnIO);
var
  i: integer;
  iListItem: TListItem;
begin
  AnImageEnIO.Params.IPTC_Info.Clear;
  for i := low(iptc) to high(iptc) do
  begin
    iListItem := AListView.Items.Item[i];
    iListItem.SubItems[0] := '';
  end;
end;
{$ENDIF}

// save the IPTC description to the specified file
procedure _WriteIPTCDescriptionAndKeywords(sFilename: string;
                                           bSaveDescription: boolean;
                                           sDescription: string;
                                           bSaveKeywords: boolean;
                                           ssKeywords: TStrings;
                                           AnImageEnIO: TImageEnIO;
                                           const bMaintainFileDates: boolean; // if true the file date is not modified when saving the file
                                           bVerbose: Boolean); // Show Error message for non_JPEG and TIFF files
var
  dFileDate: TDateTime;
begin
  dFileDate := 0; // to avoid compiler warnings

  AnImageEnIO.ParamsFromFile(sFilename);
  sDescription := StringReplace(sDescription, #13#10, ' ', [rfReplaceAll]);

  if AnImageEnIO.Params.FileType = ioTIFF then
    AnImageEnIO.LoadFromFile(sFilename);
  // need to load the actual image too becuase we will save it later

// DESCRIPTION :
  if bSaveDescription then
  begin
    AnImageEnIO.Params.WriteIPTCField(PhotoShop_IPTC_Records, IPTC_PS_Caption, sDescription);
  end;

  // KEYWORDS :
  if bSaveKeywords and Assigned(ssKeywords) then
  begin
    AnImageEnIO.Params.WriteIPTCField(PhotoShop_IPTC_Records, IPTC_PS_Keywords, ssKeywords);
  end;

{$WARNINGS OFF} // FileAge is deprecated
  if bMaintainFileDates then
    dFileDate := FileDateToDateTime(FileAge(sFileName));
{$WARNINGS ON}

  case AnImageEnIO.Params.FileType of
    ioJPEG: // inject iptc in jpeg
      AnImageEnIO.InjectJpegIPTC(sFileName);
    ioTIFF: // save iptc in TIFF
      AnImageEnIO.SaveToFile(sFilename);
  else
    if bVerbose then
      messagedlg('The format of the specified file does not support IPTC storage.', mtError,
        [mbok], 0);
  end;

  if bMaintainFileDates and (dFileDate <> 0) then
    SetFileDate(sFilename, dFileDate);
end;

// save the IPTC description to the specified file
procedure WriteIPTCDescriptionAndKeywords(sFilename: string;
                                          sDescription: string;
                                          ssKeywords: TStrings;
                                          AnImageEnIO: TImageEnIO;
                                          const bMaintainFileDates: boolean; // if true the file date is not modified when saving the file
                                          bVerbose: Boolean); // Show Error message for non_JPEG and TIFF files
begin
  _WriteIPTCDescriptionAndKeywords(sFilename,
    TRUE,
    sDescription,
    TRUE,
    ssKeywords,
    AnImageEnIO,
    bMaintainFileDates,
    bVerbose);
end;

// save the IPTC description to the specified file
procedure WriteIPTCDescription(sFilename: string;
                               sDescription: string;
                               AnImageEnIO: TImageEnIO;
                               const bMaintainFileDates: boolean; // if true the file date is not modified when saving the file
                               bVerbose: Boolean); // Show Error message for non_JPEG and TIFF files
begin
  _WriteIPTCDescriptionAndKeywords(sFilename,
    TRUE,
    sDescription,
    FALSE,
    nil,
    AnImageEnIO,
    bMaintainFileDates,
    bVerbose);
end;

// Remove extraneous characters often found in IPTC Data, such as null terminators
function TidyIPTCStr(const Value: string): string;
begin
  Result := Value;

  // Picasa adds a null terminator
  while (result <> '') and (result[length(result)] = #0) do
    setlength(result, length(result) - 1);

  // Remove #$D which appear in many photoshop descriptions
  result := StringReplace(Result, #$D, ' ', [rfReplaceAll]);
end;

{!!
<FS>iexIPTCRoutines

<FN>iexIPTCRoutines.pas provides helper functions for working with the IPTC data held in compatible files (i.e. JPEG and TIFF files). It includes an array of all common IPTC fields and provides methods for displaying and saving data in a TStringGrid or TListView.

!!}

end.