Delphi: Retain IPTC and EXIF when resize

[Nols Smit]

Hi,

Below are the procedures I use to resize large scanned maps before loading into a database and a procedure to extract the IPTC info. The EXIF and IPTC meta data get lost in when saving the resized map. I also want to get hold of the IPTC info, either of the large original map or from the resized map.

Currently I do read the the IPTC info, see my comment in the code: { To get IPTC data, this results to a double read of file }

When I call an external routine to read the IPTC info, after resizing, I get an "Access violation at address 100147A4 in module libgfl311.dll"


Regards,

Nols Smit

Code: Select all

procedure TfrmMain.ConvertImage(var PhotoSize: cardinal; ImageConvertError: boolean);
var
  i,j, OldPhotoSize: integer;

  width, new_width, height, new_height: cardinal;
  lp: TGFL_LOAD_PARAMS;
  sp: TGFL_SAVE_PARAMS;
  gfl_bmp: PGFL_BITMAP;

  e,f: GFL_ERROR;
  format: string;

  Iptc: PGFL_IPTC_DATA;
  NItems : integer;
begin

  gflEnableLZW(GFL_TRUE);
  ImageConvertError := false;

  if ImageFilePathName <> '' then
  begin
    gflGetDefaultLoadParams(lp);
    e := gflLoadBitmap(Pchar(ImageFilePathName), gfl_bmp, lp, finfo);

    if (e <> gfl_no_error) then
      ImageConvertError := true
    else
    begin
      { To get IPTC data, this results to a double read of file }
      if rgrpGetIPTC.ItemIndex = 1 then
      begin
        if gflBitMapHasIPTC(gfl_bmp) = gfl_no_error then
        begin
          IPTC := gflLoadIPTC(Pchar(ImageFilePathName));
          IPTCList.Clear;
          try
            NItems := IPTC.NumberOfItems;
            if NItems > 0 then
            begin
              for i := 0 to NItems-1 do
                IPTCList.Add(Iptc.ItemsList[i].Name + ', ' + Iptc.ItemsList[i].Value);
            end;
          finally
            gflFreeIPTC(IPTC);
          end;
        end;
      end;


      width := finfo.Width;
      height := finfo.Height;

      OldPhotoSize := Max(width, height);   {uses Math}
      if OldPhotoSize < PhotoSize then
        PhotoSize := OldPhotoSize;

      if width > height then
      begin
        new_width := PhotoSize;
        new_height := Round((new_width / width) * height);
      end
      else
      begin
        new_height := PhotoSize;
        new_width := Round((new_height / height) * width);
      end;

      gflResize(gfl_bmp, nil, new_width, new_height, GFL_RESIZE_BILINEAR, 0);

      j := 0; {jpg}

      format := gflGetDefaultFormatSuffixByIndex(j);
      gflGetDefaultSaveParams(sp);
      sp.FormatIndex := j;
      if j = 0 then
      begin
        sp.Quality := 100;
        sp.Flags := GFL_SAVE_ANYWAY;
      end;

      f := gflSaveBitmap(PChar(ImageFilePathNameNew),gfl_bmp, sp);   { metadata not saved }

      if (f <> gfl_no_error) then
      begin
        ImageConvertError := true;
        ShowMessage('File not save-able: ' + string(gflGetErrorString(f)));
      end;

      gflFreeBitmap(gfl_bmp);


      getIPTCInfo(getCurrentDir + '\Temp\2009-0000-0001.jpg');   { call external routine }

      SmallMs.LoadFromFile(ImageFilePathNameNew);
      SmallMs.Seek(soFromBeginning,0);
    end;
  end;
end;

Code: Select all

procedure TfrmMain.getIPTCInfo(Const ImageLocation: String);
var
  Iptc: PGFL_IPTC_DATA;
  gfl_bmp: PGFL_BITMAP;
  i: Cardinal;
  NItems : integer;
begin
  if gflBitMapHasIPTC(gfl_bmp) = gfl_no_error then
  begin
    IPTC := gflLoadIPTC(Pchar(ImageLocation));
    IPTCList.Clear;
    try
      NItems := IPTC.NumberOfItems;
      if NItems > 0 then
      begin
        for i := 0 to NItems-1 do
          IPTCList.Add(Iptc.ItemsList[i].Name + '    ' + Iptc.ItemsList[i].Value);
      end;
    finally
      gflFreeIPTC(IPTC);
    end;
  end;
end;

[madiazg]

Hello,
I, before saving the image, embed IPTC data:

Code: Select all

var
  IptcData : PGFL_IPTC_DATA;
 ....
begin
      if FormGuardar.CheckBoxIPTC.checked then
      begin
        IptcData := gflNewIPTC();
        gflSetIptcValue(IptcData,GFL_IPTC_OBJECTNAME,Pchar(FormIPTC.Edit1.Text)); //Load IPTC Data from Edit1
        gflSetIptcValue(IptcData,GFL_IPTC_KEYWORDS,Pchar(FormIPTC.Edit2.Text));
      ......
        gflBitmapSetIPTC(gfl_bmp,IptcData); //Save IPTC
        gflFreeIPTC(IptcData);
      end;
      .....
      gflSaveBitmap(pchar(NameFile),gfl_bmp,sp); //Save File
      gflFreeBitmapData(gfl_bmp);
    ....
end;

Regards...
Miguel Angel
http://imagen3d.site88.net