pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

pyramidtiff: clean up

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2460 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
mgaertner
2012-06-10 15:05:31 +00:00
parent e4c764c699
commit 63c82fe328
1 changed files with 3 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
applications/pyramidtiff/pytigraphics.pas
View File

@@ -36,13 +36,13 @@ unit PyTiGraphics;
interface interface
uses uses
Math, sysutils, Classes, FPimage, FPImgCanv, Math, sysutils, Classes, FPimage,
LazLogger, FPCanvas, FPWriteTiff, FPTiffCmn; LazLogger, FPCanvas, FPWriteTiff, FPTiffCmn;
type type
TPTMemImgDesc = record TPTMemImgDesc = record
Gray: boolean; Gray: boolean; // true = red=green=blue, false: a RGB image
Depth: word; Depth: word; // 8 or 16 bit
HasAlpha: boolean; HasAlpha: boolean;
end; end;
@@ -229,7 +229,6 @@ function GetMinimumPTMemImg(Img: TFPCustomImage; FreeImg: boolean): TFPCustomIma
procedure SetFPImgExtraTiff(const Desc: TPTMemImgDesc; Img: TFPCustomImage; procedure SetFPImgExtraTiff(const Desc: TPTMemImgDesc; Img: TFPCustomImage;
ClearTiffExtras: boolean); ClearTiffExtras: boolean);
procedure SaveAsDebugTiff(Img: TFPCustomImage; Filename: string);
function dbgs(const Desc: TPTMemImgDesc): string; overload; function dbgs(const Desc: TPTMemImgDesc): string; overload;
implementation implementation
@@ -254,26 +253,6 @@ begin
Img.Extra[TiffAlphaBits]:='0'; Img.Extra[TiffAlphaBits]:='0';
end; end;
procedure SaveAsDebugTiff(Img: TFPCustomImage; Filename: string);
var
Writer: TFPWriterTiff;
ms: TMemoryStream;
begin
ms:=nil;
Writer:=nil;
try
ms:=TMemoryStream.Create;
Writer:=TFPWriterTiff.Create;
Writer.ImageWrite(ms,Img);
ms.Position:=0;
ms.SaveToFile(Filename);
DebugLn(['SaveAsDebugTiff ',Img.ClassName,' ',Img.Width,'x',Img.Height,' ',Filename]);
finally
Writer.Free;
ms.Free;
end;
end;
function dbgs(const Desc: TPTMemImgDesc): string; function dbgs(const Desc: TPTMemImgDesc): string;
begin begin
Result:='Depth='+dbgs(Desc.Depth) Result:='Depth='+dbgs(Desc.Depth)