fpExif: Fix writing of multi-string IPTC tags. Nicer display text for IPTC CodeCharacterSet tag.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8992 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpexif/fpeiptcdata.pas

@@ -60,6 +60,12 @@ type
     property MaxLength: Integer read FMaxLen;
   end;
 
+  TIptcCodedCharacterSetTag = class(TIptcStringTag)
+  protected
+    function GetAsString: String; override;
+    procedure SetAsString(const AValue: String); override;
+  end;
+
   TIptcMultiStringTag = class(TIptcStringTag)
   protected
     function GetAsString: String; override;
@@ -136,7 +142,7 @@ begin
   with IptcTagDefs do begin
     Clear;
     // NOTE: The Count field is "abused" as MaxLength of string value
-    AddStringTag(I+$015A {1:90},  'CodedCharacterSet', 32,    rsCodedCharSet,   '', TIptcStringTag);
+    AddStringTag(I+$015A {1:90},  'CodedCharacterSet', 32,    rsCodedCharSet,   '', TIptcCodedCharacterSetTag);
     AddUShortTag(I+$0200 {2: 0},  'RecordVersion',     1,     rsRecordVersion);
     AddStringTag(I+$0203 {2: 3},  'ObjectType',        64,    rsObjectType,     '', TIptcStringTag);
     AddStringTag(I+$0204 {2: 4},  'ObjectAttr',        68,    rsObjectAttr,     '', TIptcObjectAttrTag);
@@ -474,6 +480,36 @@ begin
 end;
 
 
+//==============================================================================
+//                         TIptcCodedCharacterSetTag
+//==============================================================================
+function TIptcCodedCharacterSetTag.GetAsString: String;
+var
+  s: String;
+  i: Integer;
+begin
+  s := inherited GetAsString;
+  if s = #27#37#71 then
+    Result := 'UTF8'
+  else
+  begin
+    if s[1] = #27 then
+      Result := 'ESC'
+    else
+      Result := s[1];
+    for i := 2 to Length(s) do
+      Result := Result + ' ' + s[i];
+  end;
+end;
+
+procedure TIptcCodedCharacterSetTag.SetAsString(const AValue: String);
+begin
+  if Uppercase(AValue) = 'UTF8' then
+    inherited SetAsString(#27#37#71)
+  else
+    inherited SetAsString(AValue);
+end;
+
 //==============================================================================
 //                          TIptcMultiStringTag
 //==============================================================================

components/fpexif/fpeiptcreadwrite.pas

@@ -72,6 +72,7 @@ type
   TIPTCWriter = class(TBasicMetadataWriter)
   private
     FIPTCSegmentStartPos: Int64;
+    function SplitMultiStringTag(ATag: TTag): TStringArray;
   protected
     procedure WriteEndOfDataResourceBlock(AStream: TStream);
     procedure WriteImageResourceBlockHeader(AStream: TStream; AResourceID: Integer;
@@ -320,6 +321,19 @@ begin
   WriteImageResourceBlockHeader(AStream, $0B04, ''); //, nil, 0);
 end;
 
+//------------------------------------------------------------------------------
+// During reading repeatable string tags were merged into a single string and
+// separated by a IPTC_MULTI_TAG_SEPARATOR. Here the combined string is split
+// into its parts so that they can be written as separate tags again.
+//------------------------------------------------------------------------------
+function TIptcWriter.SplitMultiStringTag(ATag: TTag): TStringArray;
+var
+  s: String;
+begin
+  s := PChar(ATag.RawData);
+  Result := s.Split(IPTC_MULTI_TAG_SEPARATOR);
+end;
+
 //------------------------------------------------------------------------------
 //  Writes the IPTC header needed by JPEG files (Segment APP13 header)
 //  Call WriteToStream immediately afterwards
@@ -405,9 +419,43 @@ end;
 procedure TIptcWriter.WriteTag(AStream: TStream; ATag: TTag);
 const
   TAG_MARKER = $1C;
+
+  procedure WriteString(AIptcTag: TIptcTag; AText: PChar; ALength: Integer);
+  begin
+    if odd(ALength) then begin
+      inc(ALength);
+    end;
+
+    // "Standard" dataset
+    if ALength < 32768 then begin
+      AIptcTag.Size := NtoBE(word(ALength));
+      AStream.WriteBuffer(AIptcTag, SizeOf(AIptcTag));
+      AStream.WriteBuffer(AText^, ALength);
+    end
+    else
+    // "Extended" dataset
+    if ALength < 65536 then begin
+      // Size is 2, but we must set highest bit to mark tag as being extended.
+      AIptcTag.Size := NtoBE($8002);
+      AStream.WriteBuffer(AIptcTag, SizeOf(AIptcTag));
+      WriteWord(AStream, NtoBE(word(ALength)));
+      AStream.WriteBuffer(AText^, ALength);
+    end else begin
+      // Size is 4, but we must set highest bit to mark tag as being extended.
+      AIptcTag.Size := $8004;
+      AStream.WriteBuffer(AIptcTag, SizeOf(AIptcTag));
+      WriteDWord(AStream, NtoBE(ALength));
+      AStream.WriteBuffer(AText^, ALength);
+    end;
+    if odd(ALength) then      // zero-termination of string
+      WriteByte(AStream, 0);
+  end;
+
 var
   iptcTag: TIptcTag;
   len: DWord;
+  i: Integer;
+  sa: TStringArray;
 begin
   iptcTag.TagMarker := byte(TAG_MARKER);
   iptcTag.RecordNumber := byte((ATag.TagID and $FF00) shr 8);
@@ -421,6 +469,14 @@ begin
       end;
     ttString:
       begin
+        if ATag is TIptcMultiStringTag
+        then begin
+          sa := SplitMultiStringTag(ATag);
+          for i := 0 to High(sa) do
+            WriteString(iptcTag, PChar(sa[i]), Length(sa[i]));
+        end else
+          WriteString(iptcTag, PChar(ATag.RawData), Length(ATag.RawData));
+            (*
         len := Length(ATag.RawData);
         if odd(len) then begin
           inc(len);
@@ -447,6 +503,7 @@ begin
         end;
         if odd(Length(ATag.RawData)) then      // zero-termination of string
           WriteByte(AStream, 0);
+          *)
       end;
     else
       // I've never seen other tag types than USHORT and STRING...

components/fpexif/fpetags.pas

@@ -190,7 +190,7 @@ type
     property Count: Integer read FCount write FCount;
     { Raw data of the tag value as read from the file or to be written to the file }
     property RawData: TBytes read FRawData write SetRawData;
-    { Indicates wheter the raw data are in little endian or big endian byte order }
+    { Indicates whether the raw data are in little endian or big endian byte order }
     property BigEndian: Boolean read GetBigEndian;
     { Determines whether the meaning of numberical values will be decoded. }
     property DecodeValue: Boolean read GetDecodeValue write SetDecodeValue;