fpexif: Consider exif Orientation tag when loading image in MetadataViewer.

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

components/fpexif/examples/metadata_viewer/MetadataViewer.lpi

@@ -1,11 +1,13 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="11"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <General>
+      <Flags>
+        <CompatibilityMode Value="True"/>
+      </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="MetadataViewer"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>

components/fpexif/examples/metadata_viewer/mdvmain.lfm

@@ -94,7 +94,7 @@ object MainForm: TMainForm
         Left = 8
         Height = 15
         Top = 4
-        Width = 94
+        Width = 93
         BorderSpacing.Left = 8
         BorderSpacing.Top = 4
         BorderSpacing.Bottom = 4
@@ -329,7 +329,7 @@ object MainForm: TMainForm
         Height = 25
         Hint = 'Replaces the image date.'
         Top = 5
-        Width = 66
+        Width = 67
         AutoSize = True
         BorderSpacing.Left = 8
         BorderSpacing.Bottom = 4

components/fpexif/examples/metadata_viewer/mdvmain.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ShellCtrls,
   ExtCtrls, ComCtrls, StdCtrls,
-  fpeMetadata, fpeMakerNote;
+  fpeGlobal, fpeMetadata, fpeMakerNote;
 
 type
 
@@ -58,6 +58,7 @@ type
   private
     FImgInfo: TImgInfo;
     FImageLoaded: Boolean;
+    FImageOrientation: TExifOrientation;
     procedure LoadFile(const AFileName: String);
     procedure LoadFromIni;
     procedure SaveToIni;
@@ -76,8 +77,8 @@ implementation
 {$R *.lfm}
 
 uses
-  IniFiles, Math, StrUtils, DateUtils,
-  fpeGlobal, fpeTags, fpeExifData, fpeIptcData;
+  LCLType, IniFiles, Math, StrUtils, DateUtils, IntfGraphics,
+  fpeTags, fpeExifData, fpeIptcData;
 
 const
   TAG_ID_CAPTION = 'Tag ID';
@@ -87,6 +88,85 @@ begin
   Result := ChangeFileExt(Application.ExeName, '.ini');
 end;
 
+procedure RotateBitmap(const ABitmap: TBitmap; AOrientation: TExifOrientation);
+Var
+  bmp: TBitmap;
+  srcImg, dstImg: TLazIntfImage;
+  imgHandle, imgMaskHandle: HBitmap;
+  i, j: integer;
+  w1, h1: Integer;  // Input bitmap width and height diminished by 1
+Begin
+  Assert(ABitmap <> nil, 'RotateBitmap: Input bitmap is expected not to be nil.');
+
+  if (AOrientation = eoUnknown) or (AOrientation = eoNormal) then
+    exit;
+
+  w1 := ABitmap.Width - 1;
+  h1 := ABitmap.Height - 1;
+  srcImg := TLazIntfImage.Create(0, 0);
+  try
+    srcImg.LoadFromBitmap(ABitmap.Handle, ABitmap.MaskHandle);
+    bmp := TBitmap.Create;
+    try
+      dstImg := TLazIntfImage.Create(0, 0);
+      try
+        if AOrientation in [eoRotate90, eoRotate270, eoMirrorHorRot90, eoMirrorHorRot270] then
+        begin
+          bmp.SetSize(ABitmap.Height, ABitmap.Width);
+          dstImg.LoadFromBitmap(bmp.Handle, bmp.MaskHandle);
+          case AOrientation of
+            eoRotate90:
+              for i:=0 to w1 do
+                for j:=0 to h1 do
+                  dstImg.Colors[h1-j, i] := srcImg.Colors[i, j];
+            eoRotate270:
+              for i:=0 to w1 do
+                for j:=0 to h1 do
+                  dstImg.Colors[j, w1-i] := srcImg.Colors[i, j];
+            eoMirrorHorRot90:
+              for i:=0 to w1 do
+                for j:=0 to h1 do
+                  dstImg.Colors[h1-j, w1-i] := srcImg.Colors[i, j];
+            eoMirrorHorRot270:
+              for i:=0 to w1 do
+                for j:=0 to h1 do
+                  dstImg.Colors[j, i] := srcImg.Colors[i, j];
+          end;
+        end else
+        if AOrientation in [eoRotate180, eoMirrorHor, eoMirrorVert] then
+        begin
+          bmp.SetSize(ABitmap.Width, ABitmap.Height);
+          dstImg.LoadFromBitmap(bmp.Handle, bmp.MaskHandle);
+          case AOrientation of
+            eoRotate180:
+              for i:=0 to w1 do
+                for j:=0 to h1 do
+                  dstImg.Colors[w1-i, h1-j] := srcImg.Colors[i, j];
+            eoMirrorHor:
+              for j:=0 to h1 do
+                for i:=0 to w1 do
+                  dstImg.Colors[w1-i, j] := srcImg.Colors[i, j];
+            eoMirrorVert:
+              for i:=0 to w1 do
+                for j:=0 to h1 do
+                  dstImg.Colors[i, h1-j] := srcImg.Colors[i, j];
+          end;
+        end;
+        dstImg.CreateBitmaps(imgHandle, imgMaskHandle, false);
+        bmp.Handle := ImgHandle;
+        bmp.MaskHandle := ImgMaskHandle;
+      finally
+        dstImg.Free;
+      end;
+      ABitmap.Assign(bmp);
+    finally
+      bmp.Free;
+    end;
+  finally
+    srcImg.Free;
+  end;
+end;
+
 
 { TMainForm }
 
@@ -167,6 +247,7 @@ var
   i: Integer;
   ms: TMemoryStream;
   suffix: String;
+  crs: TCursor;
 begin
   FImageLoaded := false;
   Image.Picture.Clear;
@@ -191,6 +272,7 @@ begin
         end;
       end;
       if FImgInfo.HasExif then begin
+        FImageOrientation := FImgInfo.ExifData.ImgOrientation;
         FImgInfo.ExifData.ExportOptions := FImgInfo.ExifData.ExportOptions + [eoTruncateBinary];
         for i := 0 to FImgInfo.ExifData.TagCount-1 do begin
           lTag := FImgInfo.ExifData.TagByIndex[i];
@@ -237,12 +319,14 @@ begin
           item.SubItems.Add(lTag.AsString);
         end;
       end;
-      if FImgInfo.HasThumbnail then begin
+
+      if FImgInfo.HasThumbnail and Assigned(FImgInfo.ExifData) then begin
         ms := TMemoryStream.Create;
         try
           FImgInfo.ExifData.SaveThumbnailToStream(ms);
           ms.Position := 0;
           PreviewImage.Picture.LoadFromStream(ms);
+          RotateBitmap(PreviewImage.Picture.Bitmap, FImageOrientation);
         finally
           ms.Free;
         end;
@@ -255,8 +339,16 @@ begin
       end;
 
       if PageControl1.ActivePage = PgImage then begin
-        Image.Picture.LoadfromFile(AFileName);
-        FImageLoaded := true;
+        crs := Screen.Cursor;
+        try
+          Screen.Cursor := crHourglass;
+          Image.Picture.LoadFromFile(AFileName);
+          if Assigned(FImgInfo.ExifData) then
+            RotateBitmap(Image.Picture.Bitmap, FImageOrientation);
+          FImageLoaded := true;
+        finally
+          Screen.Cursor := crs;
+        end;
       end;
     except
       on E:Exception do begin
@@ -325,13 +417,23 @@ begin
 end;
 
 procedure TMainForm.PageControl1Change(Sender: TObject);
+var
+  crs: TCursor;
 begin
   if FImgInfo = nil then
     exit;
 
   if not FImageLoaded then begin
-    Image.Picture.LoadfromFile(FImgInfo.FileName);
-    FImageLoaded := true;
+    crs := Screen.Cursor;
+    try
+      Screen.Cursor := crHourglass;
+      Image.Picture.LoadFromFile(FImgInfo.FileName);
+      if FImgInfo.ExifData <> nil then
+        RotateBitmap(Image.Picture.Bitmap, FImgInfo.ExifData.ImgOrientation);
+      FImageLoaded := true;
+    finally
+      Screen.Cursor := crs;
+    end;
   end;
 end;
 

components/fpexif/fpeexifdata.pas

@@ -57,6 +57,7 @@ type
     FOnEndReading: TExifEndReadingEvent;
     function GetImgHeight: Integer;
     function GetImgWidth: Integer;
+    function GetOrientation: TExifOrientation;
     function GetTagByID(ATagID: TTagID): TTag;
     function GetTagByIndex(AIndex: Integer): TTag;
     function GetTagByName(AFullTagName: String): TTag;
@@ -131,6 +132,8 @@ type
       read GetImgHeight;
     property ImgWidth: Integer
       read GetImgWidth;
+    property ImgOrientation: TExifOrientation
+      read GetOrientation;
 
     property OnBeginReading: TExifBeginReadingEvent
       read FOnBeginReading write FOnBeginReading;
@@ -869,6 +872,18 @@ begin
     Result := tag.AsInteger;
 end;
 
+function TExifData.GetOrientation: TExifOrientation;
+var
+  tag: TTag;
+begin
+  tag := TagByName['Orientation'];
+  if tag = nil then
+    Result := eoUnknown
+  else
+    Result := TExifOrientation(tag.AsInteger);
+end;
+
+
 { Finds the tag which defines the sub-IFD to which the specified tag belongs }
 function TExifData.GetParentTag(ATag: TTag): TTag;
 var
@@ -1767,6 +1782,7 @@ begin
 end;
                 *)
 
+
 initialization
 
 finalization

components/fpexif/fpeexifreadwrite.pas

@@ -1157,6 +1157,7 @@ begin
   end;
 end;
 
+
 initialization
 
 finalization

components/fpexif/fpeglobal.pas

@@ -84,11 +84,15 @@ type
 
   TLookupCompareFunc = function(AValue1, AValue2: String): Boolean;
 
+  TExifOrientation = (                   // all angles are clockwise
+    eoUnknown, eoNormal, eoMirrorHor, eoRotate180, eoMirrorVert,
+    eoMirrorHorRot270, eoRotate90, eoMirrorHorRot90, eoRotate270
+  );
+
   EFpExif = class(Exception);
   EFpExifReader = class(EFpExif);
   EFpExifWriter = class(EFpExif);
 
-//  TTagAcceptProc = function(ATag: TTagEntry): Boolean;
 
 const
   TagElementSize: array[1..13] of Integer = (1, 1, 2, 4, 8, 1, 1, 2, 4, 8, 4, 8, 4);

components/fpexif/languages/fpestrconsts.de.po

@@ -246,6 +246,7 @@ msgid "Extensible metadata platform"
 msgstr ""
 
 #: fpestrconsts.rsfilenotfounderror
+#, object-pascal-format
 msgid "File \"%s\" not found."
 msgstr "Datei \"%s\" nicht gefunden."
 
@@ -502,6 +503,7 @@ msgid "Humidity"
 msgstr "Feuchte"
 
 #: fpestrconsts.rsimagedatafilenotexisting
+#, object-pascal-format
 msgid "File \"%s\" providing the image data does not exist."
 msgstr "Datei \"%s\", die die Bilddaten zur Verfügung stellen sollte, existiert nicht."
 
@@ -530,6 +532,7 @@ msgid "Image number"
 msgstr "Bildnummer"
 
 #: fpestrconsts.rsimageresourcenametoolong
+#, object-pascal-format
 msgid "Image resource name \"%s\" too long."
 msgstr ""
 
@@ -570,6 +573,7 @@ msgid "Incorrect file structure"
 msgstr "Falsche Dateistruktur"
 
 #: fpestrconsts.rsincorrecttagtype
+#, object-pascal-format
 msgid "Incorrect tag type %d: Index=%d, TagID=$%.04x, File:\"%s\""
 msgstr "Falscher Tag-Typ %d: Index=%d, TagID=$%.94x, Datei: \"%s\""
 
@@ -598,6 +602,7 @@ msgid "IPTC data expected, but not found."
 msgstr "IPTC-Daten erwartet, aber nicht gefunden."
 
 #: fpestrconsts.rsiptcextendeddatasizenotsupported
+#, object-pascal-format
 msgid "Data size %d not supported for an IPTC extended dataset."
 msgstr "Datengröße %d wird für einen erweiterten IPTC Datensatz nicht unterstützt."
 
@@ -630,6 +635,7 @@ msgid "Writing error of compressed data."
 msgstr "Fehler beim Schreiben der komprimierten Daten."
 
 #: fpestrconsts.rsjpegreadwriteerrorinsegment
+#, object-pascal-format
 msgid "Read/write error in segment $FF%.2x"
 msgstr "Lese-/Schreibfehler in Segment $FF%.2x"
 
@@ -852,6 +858,7 @@ msgid "Range check error."
 msgstr ""
 
 #: fpestrconsts.rsreadincompleteifdrecord
+#, object-pascal-format
 msgid "Read incomplete IFD record at stream position %d."
 msgstr ""
 
@@ -1073,6 +1080,7 @@ msgid "Supplemental category"
 msgstr "Zusatzkategorie"
 
 #: fpestrconsts.rstagtypenotsupported
+#, object-pascal-format
 msgid "Tag \"%s\" has an unsupported type."
 msgstr "Der Typ von Tag \"%s\" wird nicht unterstützt."
 
@@ -1161,6 +1169,7 @@ msgid "White point"
 msgstr "Weißpunkt"
 
 #: fpestrconsts.rswritingnotimplemented
+#, object-pascal-format
 msgid "Writing of %s files not yet implemented."
 msgstr ""