Scribd
Upload
56 views

Unit 1

This document defines a class called TForm1 that is used to read and write image metadata tags. It contains methods to start an exiftool process, read tags from an image file into a memo, and write tags from the memo back to the image file. Key variables include the image file path, filename, and a memo that holds the tag text. The form has buttons and labels to interface with reading and writing tags.

Uploaded by

nikolaus
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
56 views

Unit 1

This document defines a class called TForm1 that is used to read and write image metadata tags. It contains methods to start an exiftool process, read tags from an image file into a memo, and write tags from the memo back to the image file. Key variables include the image file path, filename, and a memo that holds the tag text. The form has buttons and labels to interface with reading and writing tags.

Uploaded by

nikolaus
Copyright
© © All Rights Reserved
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 3

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, FileUtil, UTF8Process, Forms, Controls, Graphics, Dialogs,
StdCtrls, Process, StrUtils;

type

{ TForm1 }

TForm1 = class(TForm)
Button1: TButton;
CheckBox1: TCheckBox;
lb: TLabel;
mm: TMemo;
ProcessUTF8_1: TProcessUTF8;
procedure Button1Click(Sender: TObject);
procedure CheckBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
private
function ReadTags(image_file:String): boolean;
procedure WriteTags;
procedure StartProcess;
public

end;

var
Form1: TForm1;
Path: String;
image_file, image_file_name: String;

implementation

{$R *.lfm}

procedure TForm1.FormCreate(Sender: TObject);


begin
Path:=ExtractFilePath(ParamStr(0));
lb.Caption := '';
end;

procedure TForm1.FormDropFiles(Sender: TObject; const FileNames: array of String


);
begin
if (MatchStr(LowerCase(ExtractFileExt(FileNames[0])), ['.jpg', '.jpeg', '.tif',
'.tiff'])) then
begin
image_file:=FileNames[0];
image_file_name := ExtractFileName(image_file);
if ReadTags(image_file) then
lb.Caption := image_file_name;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
WriteTags;
end;

procedure TForm1.CheckBox1Change(Sender: TObject);


begin
if CheckBox1.Checked then
self.FormStyle:=fsSystemStayOnTop
else
self.FormStyle:=fsNormal;
end;

function TForm1.ReadTags(image_file:String): boolean;


var
sl: TStringList;
begin
Result := true;
sl:= TStringList.Create;
mm.Clear;
sl.Add('-charset');
sl.Add('filename=utf8');
sl.Add('-S');
sl.Add('-f');
//sl.Add('-c');
//sl.Add('%+.6f');
sl.Add('-exif:ImageDescription');
sl.Add(image_file);
sl.SaveToFile(Path+'argfile.txt');
try
StartProcess;
finally
sl.Clear;
sl.LoadFromStream(ProcessUTF8_1.Output);
if sl.Count=1 then
begin
sl.NameValueSeparator:=':';
if not (sl.ValueFromIndex[0] = ' -') then
mm.Text := sl.ValueFromIndex[0];
end
else
begin
//fehler bei lesen exif
ShowMessage('exiftool: ' + sl.Text);
Result := false;
end;
sl.Free;
end;
end;

procedure TForm1.WriteTags;
var
sl: TStringList;
begin
sl:= TStringList.Create;
sl.Add('-charset');
sl.Add('filename=utf8');
sl.Add('-overwrite_original');
sl.Add('-S');
mm.Text := StringReplace(mm.Text, #13#10, ' ', [rfReplaceAll]);
sl.Add('-exif:ImageDescription=' + mm.Text);
sl.Add(image_file);
sl.SaveToFile(Path+'argfile.txt');
try
StartProcess;
finally
sl.Clear;
sl.LoadFromStream(ProcessUTF8_1.Output);
lb.Caption:=image_file_name + ' -' + sl.Text;
sl.Free;
end;
end;

procedure TForm1.StartProcess;
begin
with ProcessUTF8_1 do
begin
Options := [poWaitOnExit, poUsePipes, poStderrToOutPut];
ShowWindow := swoHIDE;
Executable := Path + 'exiftool/exiftool.exe';
Parameters.Clear;
Parameters.Add('-@');
Parameters.Add(Path+'argfile.txt');
Execute;
end;
end;

end.

You might also like