paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 07:36:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: updated tiff reader for fpc 2.7.1

Browse Source 
git-svn-id: trunk@37505 -
This commit is contained in:
mattias 2012-06-04 09:41:02 +00:00
parent 6c4d3a2ff9
commit e1d62693c3
1 changed files with 34 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
lcl/intfgraphics.pas
View File

@ -33,7 +33,7 @@ interface
uses uses
Classes, SysUtils, fpImage, FPReadBMP, FPWriteBMP, BMPComn, FPCAdds, Classes, SysUtils, fpImage, FPReadBMP, FPWriteBMP, BMPComn, FPCAdds,
AvgLvlTree, LCLType, LCLversion, Math, AvgLvlTree, LCLType, LCLversion, Math,
LCLProc, GraphType, FPReadPNG, FPWritePNG, FPReadTiff, FPWriteTiff, LCLProc, GraphType, FPReadPNG, FPWritePNG, FPReadTiff, FPWriteTiff, FPTiffCmn,
IcnsTypes; IcnsTypes;
type type
@ -625,10 +625,14 @@ type
TLazReaderTiff = class(TFPReaderTiff, ILazImageReader) TLazReaderTiff = class(TFPReaderTiff, ILazImageReader)
private private
FUpdateDescription: Boolean; FUpdateDescription: Boolean;
{$IF FPC_FULLVERSION<20701}
// the OnCreateImage event is "abused" to update the description after the // the OnCreateImage event is "abused" to update the description after the
// format and before the image is read // format and before the image is read
FOrgEvent: TTiffCreateCompatibleImgEvent; FOrgEvent: TTiffCreateCompatibleImgEvent;
procedure CreateImageHook(Sender: TFPReaderTiff; var NewImage: TFPCustomImage); procedure CreateImageHook(Sender: TFPReaderTiff; var NewImage: TFPCustomImage);
{$ENDIF}
protected
procedure DoCreateImage(ImgFileDir: TTiffIFD); {$IF FPC_FULLVERSION>=20701}override;{$ENDIF}
public public
function GetUpdateDescription: Boolean; function GetUpdateDescription: Boolean;
procedure SetUpdateDescription(AValue: Boolean); procedure SetUpdateDescription(AValue: Boolean);
@ -5944,36 +5948,47 @@ end;
{ TLazReaderTiff } { TLazReaderTiff }
{$IF FPC_FULLVERSION<20701}
procedure TLazReaderTiff.CreateImageHook(Sender: TFPReaderTiff; var NewImage: TFPCustomImage); procedure TLazReaderTiff.CreateImageHook(Sender: TFPReaderTiff; var NewImage: TFPCustomImage);
begin
if Assigned(FOrgEvent) then FOrgEvent(Sender, NewImage);
FirstImg.Img:=NewImage;
DoCreateImage(FirstImg);
end;
{$ENDIF}
procedure TLazReaderTiff.DoCreateImage(ImgFileDir: TTiffIFD);
var var
Desc: TRawImageDescription; Desc: TRawImageDescription;
IsAlpha, IsGray: Boolean; IsAlpha, IsGray: Boolean;
begin begin
if Assigned(FOrgEvent) then FOrgEvent(Sender, NewImage); {$IF FPC_FULLVERSION>=20701}
inherited;
{$ENDIF}
if not FUpdateDescription then Exit; if not FUpdateDescription then Exit;
if not (theImage is TLazIntfImage) then Exit; if not (theImage is TLazIntfImage) then Exit;
// init some default // init some default
IsGray := FirstImg.PhotoMetricInterpretation in [0, 1]; IsGray := ImgFileDir.PhotoMetricInterpretation in [0, 1];
IsAlpha := FirstImg.AlphaBits <> 0; IsAlpha := ImgFileDir.AlphaBits <> 0;
if IsAlpha if IsAlpha
then Desc.Init_BPP32_B8G8R8A8_BIO_TTB(FirstImg.ImageWidth, FirstImg.ImageHeight) then Desc.Init_BPP32_B8G8R8A8_BIO_TTB(ImgFileDir.ImageWidth, ImgFileDir.ImageHeight)
else Desc.Init_BPP24_B8G8R8_BIO_TTB(FirstImg.ImageWidth, FirstImg.ImageHeight); else Desc.Init_BPP24_B8G8R8_BIO_TTB(ImgFileDir.ImageWidth, ImgFileDir.ImageHeight);
if IsGray if IsGray
then Desc.Format := ricfGray; then Desc.Format := ricfGray;
// check mask // check mask
if FirstImg.PhotoMetricInterpretation = 4 if ImgFileDir.PhotoMetricInterpretation = 4
then begin then begin
// todo: mask // todo: mask
end end
else else
// check palette // check palette
if FirstImg.PhotoMetricInterpretation = 3 if ImgFileDir.PhotoMetricInterpretation = 3
then begin then begin
// todo: palette // todo: palette
end end
@ -5981,21 +5996,21 @@ begin
// no palette, adjust description // no palette, adjust description
if IsGray if IsGray
then begin then begin
Desc.RedPrec := FirstImg.GrayBits; Desc.RedPrec := ImgFileDir.GrayBits;
Desc.RedShift := 0; Desc.RedShift := 0;
if IsAlpha if IsAlpha
then begin then begin
Desc.Depth := FirstImg.GrayBits + FirstImg.AlphaBits; Desc.Depth := ImgFileDir.GrayBits + ImgFileDir.AlphaBits;
Desc.AlphaPrec := FirstImg.AlphaBits; Desc.AlphaPrec := ImgFileDir.AlphaBits;
Desc.AlphaShift := FirstImg.GrayBits; Desc.AlphaShift := ImgFileDir.GrayBits;
end end
else begin else begin
Desc.Depth := FirstImg.GrayBits; Desc.Depth := ImgFileDir.GrayBits;
Desc.BitsPerPixel := FirstImg.GrayBits; Desc.BitsPerPixel := ImgFileDir.GrayBits;
end; end;
end end
else begin else begin
Desc.Depth := FirstImg.RedBits + FirstImg.GreenBits + FirstImg.BlueBits + FirstImg.AlphaBits; Desc.Depth := ImgFileDir.RedBits + ImgFileDir.GreenBits + ImgFileDir.BlueBits + ImgFileDir.AlphaBits;
if Desc.Depth > 32 if Desc.Depth > 32
then begin then begin
// switch to 64bit description // switch to 64bit description
@ -6022,11 +6037,15 @@ end;
procedure TLazReaderTiff.InternalRead(Str: TStream; Img: TFPCustomImage); procedure TLazReaderTiff.InternalRead(Str: TStream; Img: TFPCustomImage);
begin begin
{$IF FPC_FULLVERSION<20701}
FOrgEvent := OnCreateImage; FOrgEvent := OnCreateImage;
OnCreateImage := @CreateImageHook; OnCreateImage := @CreateImageHook;
inherited InternalRead(Str, Img); inherited InternalRead(Str, Img);
OnCreateImage := FOrgEvent; OnCreateImage := FOrgEvent;
FOrgEvent := nil; FOrgEvent := nil;
{$ELSE}
inherited InternalRead(Str, Img);
{$ENDIF}
end; end;
{$IFDEF FPC_HAS_CONSTREF} {$IFDEF FPC_HAS_CONSTREF}