{%MainUnit ../graphics.pp} {****************************************************************************** TTiffImage ****************************************************************************** ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.modifiedLGPL.txt, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } { TTiffImage } constructor TTiffImage.Create; begin inherited Create; FSoftware := 'TTiffImage - Lazarus LCL: ' + lcl_version + ' - FPC: ' + {$I %FPCVERSION%}; end; procedure TTiffImage.FinalizeReader(AReader: TFPCustomImageReader); var D, T: TDateTime; S: String; YY, MM, DD, HH, NN, SS: Integer; begin FArtist := TFPReaderTiff(AReader).FirstImg.Artist; FCopyright := TFPReaderTiff(AReader).FirstImg.Copyright; S := TFPReaderTiff(AReader).FirstImg.DateAndTime; // YYYY:MM:DD HH:MM:SS // 0000000001111111111 // 1234567890123456789 if TryStrToInt(Copy(S, 1, 4), YY) and TryStrToInt(Copy(S, 6, 2), MM) and TryStrToInt(Copy(S, 9, 2), DD) and TryStrToInt(Copy(S, 12, 2), HH) and TryStrToInt(Copy(S, 15, 2), NN) and TryStrToInt(Copy(S, 18, 2), SS) and TryEncodeDate(YY, MM, DD, D) and TryEncodeTime(HH, NN, SS, 0, T) then FDateTime := D + T else FDateTime := 0; FDocumentName := TFPReaderTiff(AReader).FirstImg.DocumentName; FHostComputer := TFPReaderTiff(AReader).FirstImg.HostComputer; FImageDescription := TFPReaderTiff(AReader).FirstImg.ImageDescription; FMake := TFPReaderTiff(AReader).FirstImg.Make_ScannerManufacturer; FModel := TFPReaderTiff(AReader).FirstImg.Model_Scanner; case TFPReaderTiff(AReader).FirstImg.ResolutionUnit of 1: FResolutionUnit := tuNone; 2: FResolutionUnit := tuInch; 3: FResolutionUnit := tuCentimeter; else FResolutionUnit := tuUnknown; end; FSoftware := TFPReaderTiff(AReader).FirstImg.Software; FXResolution := TFPReaderTiff(AReader).FirstImg.XResolution; FYResolution := TFPReaderTiff(AReader).FirstImg.YResolution; inherited; end; class function TTiffImage.GetFileExtensions: string; begin Result := 'tif;tiff'; end; class function TTiffImage.GetReaderClass: TFPCustomImageReaderClass; begin Result := TLazReaderTiff; end; class function TTiffImage.GetSharedImageClass: TSharedRasterImageClass; begin Result := TSharedTiffImage; end; class function TTiffImage.GetWriterClass: TFPCustomImageWriterClass; begin Result := TLazWriterTiff; end; procedure TTiffImage.InitializeReader(AImage: TLazIntfImage; AReader: TFPCustomImageReader); begin inherited; end; procedure TTiffImage.InitializeWriter(AImage: TLazIntfImage; AWriter: TFPCustomImageWriter); begin inherited; if FArtist = '' then AImage.RemoveExtra(TiffArtist) else AImage.Extra[TiffArtist] := FArtist; if FCopyright = '' then AImage.RemoveExtra(TiffCopyright) else AImage.Extra[TiffCopyright] := FCopyright; if FDateTime = 0 then AImage.RemoveExtra(TiffDateTime) else AImage.Extra[TiffDateTime] := FormatDateTime('YYYY:MM:DD HH:NN:SS', FDateTime); if FDocumentName = '' then AImage.RemoveExtra(TiffDocumentName) else AImage.Extra[TiffDocumentName] := FDocumentName; if FImageDescription = '' then AImage.RemoveExtra(TiffImageDescription) else AImage.Extra[TiffImageDescription] := FImageDescription; case FResolutionUnit of tuNone: AImage.Extra[TiffResolutionUnit] := '1'; tuInch: AImage.Extra[TiffResolutionUnit] := '2'; tuCentimeter: AImage.Extra[TiffResolutionUnit] := '3'; else AImage.RemoveExtra(TiffResolutionUnit); end; if (FXResolution.Denominator = 0) and (FXResolution.Numerator = 0) then AImage.RemoveExtra(TiffXResolution) else AImage.Extra[TiffXResolution] := TiffRationalToStr(FXResolution); if (FYResolution.Denominator = 0) and (FYResolution.Numerator = 0) then AImage.RemoveExtra(TiffYResolution) else AImage.Extra[TiffYResolution] := TiffRationalToStr(FYResolution); if FHostComputer = '' then AImage.RemoveExtra(LazTiffHostComputer) else AImage.Extra[LazTiffHostComputer] := FHostComputer; if FMake = '' then AImage.RemoveExtra(LazTiffMake) else AImage.Extra[LazTiffMake] := FMake; if FModel = '' then AImage.RemoveExtra(LazTiffModel) else AImage.Extra[LazTiffModel] := FModel; if FSoftware = '' then AImage.RemoveExtra(LazTiffSoftware) else AImage.Extra[LazTiffSoftware] := FSoftware; end;