paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpexif: Allow to write EXIF image orientation.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9280 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2024-03-15 15:29:11 +00:00
parent c0398db0f2
commit 2f5e3d2cc2
1 changed files with 25 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
components/fpexif/fpeexifdata.pas
View File

@ -21,6 +21,7 @@ const
TAG_COMPRESSION = $0103; TAG_COMPRESSION = $0103;
TAG_MAKE = $010F; TAG_MAKE = $010F;
TAG_MODEL = $0110; TAG_MODEL = $0110;
TAG_ORIENTATION = $0112;
TAG_THUMBSTARTOFFSET = $0201; TAG_THUMBSTARTOFFSET = $0201;
TAG_THUMBSIZE = $0202; TAG_THUMBSIZE = $0202;
TAG_EXIFVERSION = $9000; TAG_EXIFVERSION = $9000;
@ -72,6 +73,7 @@ type
function GetTagCount: Integer; function GetTagCount: Integer;
procedure SetExportOptions(const AValue: TExportOptions); procedure SetExportOptions(const AValue: TExportOptions);
procedure SetGPSPosition(AKind: Integer; AValue: Double); procedure SetGPSPosition(AKind: Integer; AValue: Double);
procedure SetOrientation(AValue: TExifOrientation);
procedure SetTagByID(ATagID: TTagID; ATag: TTag); procedure SetTagByID(ATagID: TTagID; ATag: TTag);
procedure SetTagByIndex(AIndex: Integer; ATag: TTag); procedure SetTagByIndex(AIndex: Integer; ATag: TTag);
procedure SetTagByName(AFullTagName: String; ATag: TTag); procedure SetTagByName(AFullTagName: String; ATag: TTag);
@ -145,7 +147,7 @@ type
property ImgWidth: Integer property ImgWidth: Integer
read GetImgWidth; read GetImgWidth;
property ImgOrientation: TExifOrientation property ImgOrientation: TExifOrientation
read GetOrientation; read GetOrientation write SetOrientation;
property GPSAltitude: Double index 2 read GetGPSPosition write SetGPSPosition; property GPSAltitude: Double index 2 read GetGPSPosition write SetGPSPosition;
property GPSLatitude: Double index 1 read GetGPSPosition write SetGPSPosition; property GPSLatitude: Double index 1 read GetGPSPosition write SetGPSPosition;
property GPSLongitude: Double index 0 read GetGPSPosition write SetGPSPosition; property GPSLongitude: Double index 0 read GetGPSPosition write SetGPSPosition;
@ -1210,6 +1212,28 @@ begin
end; end;
end; end;
procedure TExifData.SetOrientation(AValue: TExifOrientation);
var
idx, idx0: Integer;
tag: TTag;
found: Boolean = false;
begin
tag := TagByID[TAGPARENT_EXIF or TAG_ORIENTATION];
if tag <> nil then
begin
tag.AsInteger := ord(AValue);
found := true;
end;
tag := TagByID[TAGPARENT_PRIMARY or TAG_ORIENTATION];
if tag = nil then
begin
if found then exit;
tag := AddTagByID(TAGPARENT_PRIMARY or TAG_ORIENTATION);
end;
tag.AsInteger := ord(AValue);
end;
procedure TExifData.SetTagByID(ATagID: TTagID; ATag: TTag); procedure TExifData.SetTagByID(ATagID: TTagID; ATag: TTag);
var var
idx: Integer; idx: Integer;