uses
ImagingTypes,
Imaging,
ImagingClasses,
LibTiffDelphi;
:
:
:
//---------------------------------------
Function OpenFile(const FileName: string; Var pFImage: TMultiImage) : Boolean;
begin
result := true;
try
pFImage.LoadMultiFromFile(FileName);
except
result := false;
Exit;
end;
pFImage.ActiveImage := pFImage.ActiveImage + 1;
end;
//-------------------------------
Function SaveFile(const FileName: string; Var pFImage: TMultiImage): Boolean;
begin
result := true;
try
pFImage.SaveMultiToFile(FileName);
except
result := false;
end;
end;
//-----------------------------------
procedure Bmp2Tiff(pSource:String; pTarget: string);
{$R-}
{$RANGECHECKS OFF}
var
XMP_Size, XMP_Offset: cardinal;
Texto: string;
FImage: TMultiImage;
F: TFileStream;
OffSetInicioDelDirectorio, NewDirOffset : LongWord;
NumeroDeEntradasEnElDirectorio : Word;
// Entry: TDirEntry;
DirArray : array [0..30] of TDirEntry;
i : Integer;
begin
Texto := GetXMPString(); //This function get the XMP String. In this funciton you can Check if the String is a Valid XMP. But you can insert into the Tiff whatever String text. The string Text can be or not can be a valid XMP. The image viewer program like Gimp, Photoshop, etc, no make a check about it.
//******************************
FImage := TMultiImage.Create;
try
OpenFile(pSource, FImage);
SaveFile(pTarget, FImage);
finally
FImage.Free;
end;
XMP_Size := Length(Texto);
AddStrToFile(Texto, pTarget);
XMP_Offset := cuantosbytes(pTarget) - XMP_Size;
F := TFileStream.Create(pTarget, fmOpenRead);
try
F.Seek(4, soFromBeginning);
F.Read(OffSetInicioDelDirectorio, SizeOf(OffSetInicioDelDirectorio));
F.Seek(OffSetInicioDelDirectorio, soFromBeginning);
F.Read(NumeroDeEntradasEnElDirectorio, SizeOf(NumeroDeEntradasEnElDirectorio));
OffSetInicioDelDirectorio := OffSetInicioDelDirectorio + SizeOf(NumeroDeEntradasEnElDirectorio);
FillChar(DirArray, 30 * SizeOf(TDirEntry), 0);
F.Read(DirArray, NumeroDeEntradasEnElDirectorio * SizeOf(TDirEntry));
DirArray[NumeroDeEntradasEnElDirectorio]._Tag := TIFFTAG_XMLPACKET;
DirArray[NumeroDeEntradasEnElDirectorio]._Type := 1;
DirArray[NumeroDeEntradasEnElDirectorio]._Count := XMP_Size;
DirArray[NumeroDeEntradasEnElDirectorio]._Value := XMP_Offset;
finally
F.Free;
end;
NewDirOffset := cuantosbytes(pTarget);
F := TFileStream.Create(pTarget, fmOpenWrite);
try
F.Seek(4, soFromBeginning);
F.Write(NewDirOffset, SizeOf(NewDirOffset));
F.Seek(NewDirOffset, soFromBeginning);
Inc(NumeroDeEntradasEnElDirectorio);
F.Write(NumeroDeEntradasEnElDirectorio, SizeOf(NumeroDeEntradasEnElDirectorio));
for i := 0 to NumeroDeEntradasEnElDirectorio +1 do
Begin
F.Write(DirArray[i], SizeOf(TDirEntry));
End;
finally
F.Free;
End;
end; //procedure Bmp2TiffJC(pSource:String; pTarget: string);
//*********************************************************** //Fin Funcion
