pascal/kolmck
pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity
cb7f421737
kolmck/Addons/KOLGraphicEx.pas

6436 lines
255 KiB
ObjectPascal
Raw Blame History

//{$DEFINE NOCLASSES}
{$IFDEF FPC}
{$DEFINE NOT_USE_KOL_ERR}
{$MODE Delphi}
{$ASMMODE intel}
{$GOTO ON}
{$ENDIF}
unit KOLGraphicEx;
// (c) Copyright 1999, 2000 Dipl. Ing. Mike Lischke (public@lischke-online.de). All rights reserved.
//
// This package is freeware for non-commercial use only.
// Contact author for licenses (shareware@lischke-online.de) and see License.txt which comes with the package.
//
// GraphicEx -
// This unit is an addendum to Graphics.pas, in order to enable your application
// to import many common graphic files.
//
// See help file for a description of supported image types. Additionally, there is a resample routine
// (Stretch) based on code from Anders Melander (http://www.melander.dk/delphi/resampler/index.html)
// which has been optimized quite a lot to work faster and bug fixed.
//
// version - 9.9
//
// 03-SEP-2000 ml:
// EPS with alpha channel, workaround for TIFs with wrong alpha channel indication,
// workaround for bad packbits compressed (TIF) images
// 28-AUG-2000 ml:
// small bugfixes
// 27-AUG-2000 ml:
// changed all FreeMemory(P) calls back to ... if Assigned(P) then FreeMem(P); ...
// 24-AUG-2000 ml:
// small bug in LZ77 decoder removed
// 18-AUG-2000 ml:
// TIF deflate decoding scheme
// 15-AUG-2000 ml:
// workaround for TIF images without compression, but prediction scheme set (which is not really used in this case)
// 12-AUG-2000 ml:
// small changes
//
// For older history please look into the help file.
//
// Note: The library provides usually only load support for the listed image formats but will perhaps be enhanced
// in the future to save those types too. It can be compiled with Delphi 4 or newer versions.
//
//
// (c) Copyright 1999, 2000 Dipl. Ing. Mike Lischke (public@lischke-online.de). All rights reserved.
//
// This package is freeware for non-commercial use only!
// Contact author for licenses (shareware@lischke-online.de) and see License.txt which comes with the package.
//////////////////////////////////////////////////
// Converted to KOL by Dimaxx (dimaxx@atnet.ru) //
//////////////////////////////////////////////////
interface
{$ALIGN OFF}
{$I KOLDEF.INC}
{$O+}
uses Windows, KOL, KOLGraphicCompression, KOLGraphicColor, Errors, {$IFDEF NOT_USE_KOL_ERR}sysutils {$ELSE}Err {$ENDIF} ;
type
TCardinalArray = array of cardinal;
PDWORDArray = ^TDWORDArray;
TDWORDArray = array[0..65535] of cardinal;
TByteArray = array of byte;
TFloatArray = array of single;
TImageOptions = set of (
ioTiled, // image consists of tiles not strips (TIF)
ioBigEndian, // byte order in values >= words is reversed (TIF, RLA, SGI)
ioMinIsWhite, // minimum value in grayscale palette is white not black (TIF)
ioReversed, // bit order in bytes is reveresed (TIF)
ioUseGamma // gamma correction is used
);
// describes the compression used in the image file
TCompressionType = (
ctUnknown, // compression type is unknown
ctNone, // no compression at all
ctRLE, // run length encoding
ctPackedBits, // Macintosh packed bits
ctLZW, // Lempel-Zif-Welch
ctFax3, // CCITT T.4 (1d), also known as fax group 3
ctFaxRLE, // modified Huffman (CCITT T.4 derivative)
ctFax4, // CCITT T.6, also known as fax group 4
ctFaxRLEW, // CCITT T.4 with word alignment
ctLZ77, // Huffman inflate/deflate
ctJPEG, // TIF JPEG compression (new version)
ctOJPEG, // TIF JPEG compression (old version)
ctThunderscan, // TIF thunderscan compression
ctNext,
ctIT8CTPAD,
ctIT8LW,
ctIT8MP,
ctIT8BL,
ctPixarFilm,
ctPixarLog,
ctDCS,
ctJBIG,
ctPCDHuffmann // PhotoCD Hufman compression
);
// properties of a particular image which are set while loading an image or when
// they are explicitly requested via ReadImageProperties
PImageProperties = ^TImageProperties;
TImageProperties = packed record
Version: cardinal; // TIF, PSP, GIF
Options: TImageOptions; // all images
Width, // all images
Height: cardinal; // all images
ColorScheme: TColorScheme; // all images
BitsPerSample, // all Images
SamplesPerPixel, // all images
BitsPerPixel: byte; // all images
Compression: TCompressionType; // all images
FileGamma: single; // RLA, PNG
XResolution,
YResolution: single; // given in dpi (TIF, PCX, PSP)
Interlaced, // GIF, PNG
HasAlpha: boolean; // TIF, PNG
// informational data, used internally and/or by decoders
// TIF
FirstIFD,
PlanarConfig, // most of this data is needed in the JPG decoder
CurrentRow,
TileWidth,
TileLength,
BytesPerLine: cardinal;
RowsPerStrip: TCardinalArray;
YCbCrSubSampling,
JPEGTables: TByteArray;
JPEGColorMode,
JPEGTablesMode: Cardinal;
CurrentStrip,
StripCount,
Predictor: integer;
// PCD
Overview: boolean; // true if image is an overview image
Rotate: byte; // describes how the image is rotated (aka landscape vs. portrait image)
ImageCount: word; // number of subimages if this is an overview image
// GIF
LocalColorTable: boolean; // image uses an own color palette instead of the global one
// RLA
BottomUp: boolean; // images is bottom to top
// PSD
Channels: byte; // up to 24 channels per image
// PNG
FilterMode: byte;
end;
// This is the general base class for all image types implemented in GraphicEx.
// It contains some generally used class/data.
PGraphicExGraphic = ^TGraphicExGraphic;
TGraphicExGraphic = {$IFDEF NOCLASSES} object(TObj) {$ELSE} class {$ENDIF}
private
FColorManager: PColorManager;
FImageProperties: TImageProperties;
FBasePosition: cardinal; // stream start position
FStream: PStream; // used for local references of the stream the class is currently loading from
FBitmap: PBitmap;
FCorrupted: Boolean;
protected
{$IFNDEF USE_GLOBALS}
CurrentLineR: array of integer;
CurrentLineG: array of integer;
CurrentLineB: array of integer;
{$ENDIF}
protected
function GetWidth: Integer;
function GetHeight: Integer;
public
constructor Create;
destructor Destroy; {$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
{$IFNDEF NOCLASSES}
class function CanLoad(const Filename: string): boolean; overload; virtual;
{$ENDIF}
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFNDEF NOCLASSES} overload; {$ENDIF} virtual;
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean; virtual;
property Bitmap: PBitmap read FBitmap;
property ColorManager: PColorManager read FColorManager;
property ImageProperties: TImageProperties read FImageProperties write FImageProperties;
property Width: Integer read GetWidth;
property Height: Integer read GetHeight;
property Corrupted: Boolean read FCorrupted;
end;
{$IFNDEF NOCLASSES}
TGraphicExGraphicClass = class of TGraphicExGraphic;
{$ENDIF}
// *.bw, *.rgb, *.rgba, *.sgi images
TSGIGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
private
FRowStart,
FRowSize: PDWORDArray; // start and length of a line (if compressed)
{$IFDEF NOCLASSES} FDecoder: PSGIRLEDecoder;
{$ELSE} FDecoder: TDecoder; {$ENDIF} // ...same applies here
procedure ReadAndDecode(Red,Green,Blue,Alpha: pointer; Row,BPC: cardinal);
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal):
boolean; {$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
// *.cel, *.pic images
TAutodeskGraphic = {$IFDEF NOCLASSES} object( TGraphicExGraphic )
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
// *.tif, *.tiff images
// one entry in a an IFD (image file directory)
TIFDEntry = packed record
ATag: word;
DataType: word;
DataLength: cardinal;
Offset: cardinal;
end;
TTIFFPalette = array[0..787] of word;
PTIFFGraphic = ^TTIFFGraphic;
TTIFFGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
private
FIFD: array of TIFDEntry; // the tags of one image file directory
FPalette: TTIFFPalette;
FYCbCrPositioning: cardinal;
FYCbCrCoefficients: TFloatArray;
function FindTag(ATag: cardinal; var Index: cardinal): boolean;
procedure GetValueList(Stream: PStream; ATag: cardinal; var Values: TByteArray); overload;
procedure GetValueList(Stream: PStream; ATag: cardinal; var Values: TCardinalArray); overload;
procedure GetValueList(Stream: PStream; ATag: cardinal; var Values: TFloatArray); overload;
function GetValue(Stream: PStream; ATag: cardinal; Default: single = 0): single; overload;
function GetValue(ATag: cardinal; Default: cardinal = 0): Cardinal; overload;
function GetValue(ATag: cardinal; var Size: cardinal; Default: cardinal = 0): cardinal; overload;
procedure SortIFD;
procedure SwapIFD;
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
TEPSGraphic = {$IFDEF NOCLASSES} object(TTIFFGraphic)
{$ELSE} class(TTIFFGraphic) {$ENDIF}
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
// *.tga; *.vst; *.icb; *.vda; *.win images
TTGAGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
// *.pcx; *.pcc; *.scr images
// Note: Due to the badly designed format a PCX/SCR file cannot be part in a larger stream because the position of the
// color palette as well as the decoding size can only be determined by the size of the image.
// Hence the image must be the only one in the stream or the last one.
PPCXGraphic = ^TPCXGraphic;
TPCXGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
// *.pcd images
// Note: By default the BASE resolution of a PCD image is loaded with LoadFromStream.
TPCDGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
// *.ppm, *.pgm, *.pbm images
PPPMGraphic = ^TPPMGraphic;
TPPMGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
private
FBuffer: array[0..4095] of Char;
FIndex: integer;
function CurrentChar: Char;
function GetChar: Char;
function GetNumber: cardinal;
function ReadLine: string;
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
// *.cut (+ *.pal) images
// Note: Also this format should not be used in a stream unless it is the only image or the last one!
TCUTGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
private
FPaletteFile: string;
protected
procedure LoadPalette;
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
property PaletteFile: string read FPaletteFile write FPaletteFile;
end;
// *.gif images
{$IFDEF NOCLASSES} PGifGraphic = ^TGIFGraphic; {$ENDIF}
TGIFGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
private
function SkipExtensions: byte;
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
function Transparent: Boolean;
function Count: Integer;
end;
// *.rla, *.rpf images
// implementation based on code from Dipl. Ing. Ingo Neumann (ingo@upstart.de, ingo_n@dialup.nacamar.de)
TRLAGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
private
procedure SwapHeader(var Header); // start position of the image header in the stream
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
// *.psd, *.pdd images
PPSDGraphic = ^TPSDGraphic;
TPSDGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
PPSPGraphic = ^TPSPGraphic;
// *.psp images (file version 3 and 4)
TPSPGraphic = {$IFDEF NOCLASSES} object( TGraphicExGraphic )
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
end;
// *.png images
TChunkType = array[0..3] of Char;
// This header is followed by a variable number of data bytes, which are followed by the CRC for this data.
// The actual size of this data is given by field length in the chunk header.
// CRC is Cardinal (4 byte unsigned integer).
TPNGChunkHeader = packed record
Length: cardinal; // size of data (entire chunk excluding itself, CRC and type)
ChunkType: TChunkType;
end;
TPNGGraphic = {$IFDEF NOCLASSES} object(TGraphicExGraphic)
{$ELSE} class(TGraphicExGraphic) {$ENDIF}
private
{$IFDEF NOCLASSES}
FDecoder: PLZ77Decoder;
{$ELSE} FDecoder: TLZ77Decoder; {$ENDIF}
FIDATSize: integer; // remaining bytes in the current IDAT chunk
FRawBuffer, // buffer to load raw chunk data and to check CRC
FCurrentSource: pointer; // points into FRawBuffer for current position of decoding
FHeader: TPNGChunkHeader; // header of the current chunk
FCurrentCRC: cardinal; // running CRC for the current chunk
FSourceBPP: integer; // bits per pixel used in the file
// FPalette: HPALETTE; // used to hold the palette handle until we can set it finally after the pixel format
// has been set too (as this destroys the current palette)
FTransparency: TByteArray; // If the image is indexed then this array might contain alpha values (depends on file)
// each entry corresponding to the same palette index as the index in this array.
// For grayscale and RGB images FTransparentColor contains the (only) transparent
// color.
FTransparentColor: TColor; // transparent color for gray and RGB
FBackgroundColor: TColor; // index or color ref
procedure ApplyFilter(Filter: byte; Line,PrevLine,Target: PByte; BPP,BytesPerRow: integer);
function IsChunk(ChunkType: TChunkType): boolean;
function LoadAndSwapHeader: cardinal;
procedure LoadBackgroundColor(const Description);
procedure LoadIDAT(const Description);
procedure LoadTransparency(const Description);
procedure ReadDataAndCheckCRC;
procedure ReadRow(RowBuffer: pointer; BytesPerRow: integer);
function SetupColorDepth(ColorType,BitDepth: integer): integer;
public
{$IFNDEF NOCLASSES} class {$ENDIF}
function CanLoad(Stream: PStream): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
procedure LoadFromStream(Stream: PStream);
function ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
{$IFDEF NOCLASSES} virtual; {$ELSE} override; {$ENDIF}
property BackgroundColor: TColor read FBackgroundColor;
property Transparency: TByteArray read FTransparency;
end;
// ---------- file format management stuff
TFormatType = (
ftAnimation, // format contains an animation (like GIF or AVI)
ftLayered, // format supports multiple layers (like PSP, PSD)
ftMultiImage, // format can contain more than one image (like TIF or GIF)
ftRaster, // format is contains raster data (this is mainly used)
ftVector // format contains vector data (like DXF or PSP file version 4)
);
TFormatTypes = set of TFormatType;
TFilterSortType = (
fstNone, // do not sort entries, list them as they are registered
fstBoth, // sort entries first by description then by extension
fstDescription, // sort entries by description only
fstExtension // sort entries by extension only
);
TFilterOption = (
foCompact, // use the compact form in filter strings instead listing each extension on a separate line
foIncludeAll, // include the 'All image files' filter string
foIncludeExtension // add the extension to the description
);
TFilterOptions = set of TFilterOption;
// resampling support types
TResamplingFilter = (sfBox, sfTriangle, sfHermite, sfBell, sfSpline, sfLanczos3, sfMitchell);
// Resampling support routines
procedure Stretch(NewWidth,NewHeight: cardinal; Filter: TResamplingFilter; Radius: single; Source,Target: PBitmap;G: PGraphicExGraphic); overload;
procedure Stretch(NewWidth,NewHeight: cardinal; Filter: TResamplingFilter; Radius: single; Source: PBitmap; G: PGraphicExGraphic); overload;
var
Comp2Str: array[TCompressionType] of string = (
'Unknown','None','RLE','PackedBits','LZW','CCITT Fax3',
'Huffman RLE','CCITT Fax4','Huffman RLE word align',
'LZ77','JPEG','Old JPEG','Thunderscan','Next',
'IT8CTPAD','IT8LW','IT8MP','IT8BL','PixarFilm','PixarLog','DCS','JBIG',
'PCDHuffmann');
//----------------------------------------------------------------------------------------------------------------------
implementation
uses {$IFDEF NOT_USE_KOL_ERR}Math, {$ELSE}KOLMath, {$ENDIF} KolZLibBzip;
const
PNG = 'PNG';
TIF = 'TIF/TIFF';
type
// resampling support types
TRGBInt = packed record
R,G,B: integer;
end;
PRGBWord = ^TRGBWord;
TRGBWord = packed record
R,G,B: word;
end;
PRGBAWord = ^TRGBAWord;
TRGBAWord = packed record
R,G,B,A: word;
end;
PBGR = ^TBGR;
TBGR = packed record
B,G,R: byte;
end;
PBGRA = ^TBGRA;
TBGRA = packed record
B,G,R,A: byte;
end;
PRGB = ^TRGB;
TRGB = packed record
R,G,B: byte;
end;
PRGBA = ^TRGBA;
TRGBA = packed record
R,G,B,A: byte;
end;
PPixelArray = ^TPixelArray;
TPixelArray = array[0..0] of TBGR;
TFilterFunction = function(Value: single): single;
// contributor for a Pixel
PContributor = ^TContributor;
TContributor = packed record
Weight: integer; // Pixel Weight
Pixel: integer; // Source Pixel
end;
TContributors = array of TContributor;
// list of source pixels contributing to a destination pixel
TContributorEntry = packed record
N: integer;
Contributors: TContributors;
end;
TContributorList = array of TContributorEntry;
const
DefaultFilterRadius: array[TResamplingFilter] of single = (0.5,1,1,1.5,2,3,2);
{$IFDEF USE_GLOBALS}
threadvar // globally used cache for current image (speeds up resampling about 10%)
CurrentLineR: array of integer;
CurrentLineG: array of integer;
CurrentLineB: array of integer;
{$ENDIF}
function Rect(ALeft,ATop,ARight,ABottom: integer): TRect;
begin
with Result do
begin
Left:=ALeft;
Top:=ATop;
Right:=ARight;
Bottom:=ABottom;
end;
end;
function StrLIComp(const Str1,Str2: PChar; MaxLen: cardinal): integer; assembler;
asm
PUSH EDI
PUSH ESI
PUSH EBX
MOV EDI,EDX
MOV ESI,EAX
MOV EBX,ECX
XOR EAX,EAX
OR ECX,ECX
JE @@4
REPNE SCASB
SUB EBX,ECX
MOV ECX,EBX
MOV EDI,EDX
XOR EDX,EDX
@@1: REPE CMPSB
JE @@4
MOV AL,[ESI-1]
CMP AL,'a'
JB @@2
CMP AL,'z'
JA @@2
SUB AL,20H
@@2: MOV DL,[EDI-1]
CMP DL,'a'
JB @@3
CMP DL,'z'
JA @@3
SUB DL,20H
@@3: SUB EAX,EDX
JE @@1
@@4: POP EBX
POP ESI
POP EDI
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFDEF NOT_USE_KOL_ERR}
procedure GraphicExError(Code: integer); overload;
var E: Exception;
begin
E:=Exception.Create(int2str(Code));
//E.ErrorCode:=Code;
raise E;
end;
{$ELSE}
procedure GraphicExError(Code: integer); overload;
var E: Exception;
begin
E:=Exception.Create(e_Custom,ErrorMsg[Code]);
E.ErrorCode:=Code;
raise E;
end;
{$ENDIF}
//----------------------------------------------------------------------------------------------------------------------
{$IFDEF NOT_USE_KOL_ERR}
procedure GraphicExError(Code: integer; Args: array of const); overload;
var E: Exception;
begin
E:=Exception.CreateFmt(int2str(Code),Args);
//E.ErrorCode:=Code;
raise E;
end;
{$ELSE}
procedure GraphicExError(Code: integer; Args: array of const); overload;
var E: Exception;
begin
E:=Exception.CreateFmt(e_Custom,ErrorMsg[Code],Args);
E.ErrorCode:=Code;
raise E;
end;
{$ENDIF}
//----------------------------------------------------------------------------------------------------------------------
procedure Upsample(Width,Height,ScaledWidth: cardinal; Pixels: PChar);
// Creates a new image that is a integral size greater than an existing one.
var X,Y: cardinal;
P,Q,R: PChar;
begin
for Y:=0 to pred(Height) do
begin
P:=Pixels+(Height-1-Y)*ScaledWidth+(Width-1);
Q:=Pixels+((Height-1-Y) shl 1)*ScaledWidth+((Width-1) shl 1);
Q^:=P^;
(Q+1)^:=P^;
for X:=1 to pred(Width) do
begin
Dec(P);
Dec(Q,2);
Q^:=P^;
(Q+1)^:=Char((Word(P^)+Word((P+1)^)+1) shr 1);
end;
end;
for Y:=0 to Height-2 do
begin
P:=Pixels+(Y shl 1)*ScaledWidth;
Q:=P+ScaledWidth;
R:=Q+ScaledWidth;
for X:=0 to Width-2 do
begin
Q^:=Char((Word(P^)+Word(R^)+1) shr 1);
(Q+1)^:=Char((Word(P^)+Word((P+2)^)+Word(R^)+Word((R+2)^)+2) shr 2);
Inc(Q,2);
Inc(P,2);
Inc(R,2);
end;
Q^:=Char((Word(P^)+Word(R^)+1) shr 1);
Inc(P);
Inc(Q);
Q^:=Char((Word(P^)+Word(R^)+1) shr 1);
end;
P:=Pixels+(2*Height-2)*ScaledWidth;
Q:=Pixels+(2*Height-1)*ScaledWidth;
Move(P^,Q^,2*Width);
end;
//----------------- filter functions for stretching --------------------------------------------------------------------
function HermiteFilter(Value: single): single;
// f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1
begin
if Value<0 then Value:=-Value;
if Value<1 then Result:=(2*Value-3)*Sqr(Value)+1 else Result:=0;
end;
//----------------------------------------------------------------------------------------------------------------------
function BoxFilter(Value: Single): Single;
// This filter is also known as 'nearest neighbour' Filter.
begin
if (Value>-0.5) and (Value<=0.5) then Result:=1 else Result:=0;
end;
//----------------------------------------------------------------------------------------------------------------------
function TriangleFilter(Value: single): single;
// aka 'linear' or 'bilinear' filter
begin
if Value<0 then Value:=-Value;
if Value<1 then Result:=1-Value else Result:=0;
end;
//----------------------------------------------------------------------------------------------------------------------
function BellFilter(Value: single): single;
begin
if Value<0 then Value:=-Value;
if Value<0.5 then Result:=0.75-Sqr(Value) else
if Value<1.5 then
begin
Value:=Value-1.5;
Result:=0.5*Sqr(Value);
end
else Result:=0;
end;
//----------------------------------------------------------------------------------------------------------------------
function SplineFilter(Value: single): single;
// B-spline filter
var Temp: single;
begin
if Value<0 then Value:=-Value;
if Value<1 then
begin
Temp:=Sqr(Value);
Result:=0.5*Temp*Value-Temp+2/3;
end
else
if Value<2 then
begin
Value:=2-Value;
Result:=Sqr(Value)*Value/6;
end
else Result:=0;
end;
//----------------------------------------------------------------------------------------------------------------------
function Lanczos3Filter(Value: single): single;
//--------------- local function --------------------------------------------
function SinC(Value: single): single;
begin
if Value<>0 then
begin
Value:=Value*PI;
Result:=Sin(Value)/Value;
end
else Result:=1;
end;
//---------------------------------------------------------------------------
begin
if Value<0 then Value:=-Value;
if Value<3 then Result:=SinC(Value)*SinC(Value/3) else Result:=0;
end;
//----------------------------------------------------------------------------------------------------------------------
function MitchellFilter(Value: single): single;
var Temp,B,C: single;
begin
B:=1/3;
C:=1/3;
if Value<0 then Value:=-Value;
Temp:=Sqr(Value);
if Value<1 then
begin
Value:=(((12-9*B-6*C)*(Value*Temp))+((-18+12*B+6*C)*Temp)+(6-2*B));
Result:=Value/6;
end
else
if Value<2 then
begin
Value:=(((-B-6*C)*(Value*Temp))+((6*B+30*C)*Temp)+((-12*B-48*C)*Value)+(8*B+24*C));
Result:=Value/6;
end
else Result:=0;
end;
//----------------------------------------------------------------------------------------------------------------------
const
FilterList: array[TResamplingFilter] of TFilterFunction = (
BoxFilter,TriangleFilter,HermiteFilter,BellFilter,
SplineFilter,Lanczos3Filter,MitchellFilter);
//----------------------------------------------------------------------------------------------------------------------
procedure FillLineChache(N,Delta: integer; Line: pointer; G: PGraphicExGraphic);
var I: integer;
Run: PBGR;
begin
Run:=Line;
for I:=0 to pred(N) do
begin
G.CurrentLineR[I]:=Run.R;
G.CurrentLineG[I]:=Run.G;
G.CurrentLineB[I]:=Run.B;
Inc(PByte(Run),Delta);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function ApplyContributors(N: integer; Contributors: TContributors; G: PGraphicExGraphic): TBGR;
var RGB: TRGBInt;
J,Total,Weight: integer;
Pixel: cardinal;
Contr: ^TContributor;
begin
RGB.R:=0;
RGB.G:=0;
RGB.B:=0;
Total:=0;
Contr:=@Contributors[0];
for J:=0 to pred(N) do
begin
Weight:=Contr.Weight;
Inc(Total,Weight);
Pixel:=Contr.Pixel;
Inc(RGB.R,G.CurrentLineR[Pixel]*Weight);
Inc(RGB.G,G.CurrentLineG[Pixel]*Weight);
Inc(RGB.B,G.CurrentLineB[Pixel]*Weight);
Inc(Contr);
end;
if Total=0 then
begin
Result.R:=ClampByte(RGB.R shr 8);
Result.G:=ClampByte(RGB.G shr 8);
Result.B:=ClampByte(RGB.B shr 8);
end
else
begin
Result.R:=ClampByte(RGB.R div Total);
Result.G:=ClampByte(RGB.G div Total);
Result.B:=ClampByte(RGB.B div Total);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure DoStretch(Filter: TFilterFunction; Radius: single; Source,Target: PBitmap;
G: PGraphicExGraphic);
// This is the actual scaling routine. Target must be allocated already with sufficient size. Source must
// contain valid data, Radius must not be 0 and Filter must not be nil.
var ScaleX,ScaleY: single; // Zoom scale factors
I,J,K,N: integer; // Loop variables
Center: single; // Filter calculation variables
Width: single;
Weight: integer; // Filter calculation variables
Left,
Right: integer; // Filter calculation variables
Work: PBitmap;
ContributorList: TContributorList;
SourceLine,DestLine: PPixelArray;
DestPixel: PBGR;
Delta,DestDelta: integer;
SourceHeight,SourceWidth,TargetHeight,TargetWidth: integer;
begin
// shortcut variables
SourceHeight:=Source.Height;
SourceWidth:=Source.Width;
TargetHeight:=Target.Height;
TargetWidth:=Target.Width;
if (SourceHeight=0) or (SourceWidth=0) or (TargetHeight=0) or (TargetWidth=0) then Exit;
// create intermediate image to hold horizontal zoom
Work:=NewBitmap(0,0);
try
Work.PixelFormat:=pf24Bit;
Work.Height:=SourceHeight;
Work.Width:=TargetWidth;
if SourceWidth=1 then ScaleX:=TargetWidth/SourceWidth else ScaleX:=(TargetWidth-1)/(SourceWidth-1);
if (SourceHeight=1) or (TargetHeight=1) then ScaleY:=TargetHeight/SourceHeight else ScaleY:=(TargetHeight-1)/(SourceHeight-1);
// pre-calculate filter contributions for a row
SetLength(ContributorList,TargetWidth);
// horizontal sub-sampling
if ScaleX<1 then
begin
// scales from bigger to smaller Width
Width:=Radius/ScaleX;
for I:=0 to pred(TargetWidth) do
begin
ContributorList[I].N:=0;
SetLength(ContributorList[I].Contributors,Trunc(2*Width+1));
Center:=I/ScaleX;
Left:=Floor(Center-Width);
Right:=Ceil(Center+Width);
for J:=Left to Right do
begin
Weight:=Round(Filter((Center-J)*ScaleX)*ScaleX*256);
if Weight<>0 then
begin
if J<0 then N:=-J else
if J>=SourceWidth then N:=SourceWidth-J+SourceWidth-1 else N:=J;
K:=ContributorList[I].N;
Inc(ContributorList[I].N);
ContributorList[I].Contributors[K].Pixel:=N;
ContributorList[I].Contributors[K].Weight:=Weight;
end;
end;
end;
end
else
begin
// horizontal super-sampling
// scales from smaller to bigger Width
for I:=0 to pred(TargetWidth) do
begin
ContributorList[I].N:=0;
SetLength(ContributorList[I].Contributors,Trunc(2*Radius+1));
Center:=I/ScaleX;
Left:=Floor(Center-Radius);
Right:=Ceil(Center+Radius);
for J:=Left to Right do
begin
Weight:=Round(Filter(Center-J)*256);
if Weight<>0 then
begin
if J<0 then N:=-J else
if J>=SourceWidth then N:=SourceWidth-J+SourceWidth-1 else N:=J;
K:=ContributorList[I].N;
Inc(ContributorList[I].N);
ContributorList[I].Contributors[K].Pixel:=N;
ContributorList[I].Contributors[K].Weight:=Weight;
end;
end;
end;
end;
// now apply filter to sample horizontally from Src to Work
SetLength(G.CurrentLineR,SourceWidth);
SetLength(G.CurrentLineG,SourceWidth);
SetLength(G.CurrentLineB,SourceWidth);
for K:=0 to pred(SourceHeight) do
begin
SourceLine:=Source.ScanLine[K];
FillLineChache(SourceWidth,3,SourceLine,G);
DestPixel:=Work.ScanLine[K];
for I:=0 to pred(TargetWidth) do
with ContributorList[I] do
begin
DestPixel^:=ApplyContributors(N,ContributorList[I].Contributors,G);
// move on to next column
Inc(DestPixel);
end;
end;
// free the memory allocated for horizontal filter weights, since we need the stucture again
for I:=0 to pred(TargetWidth) do ContributorList[I].Contributors:=nil;
ContributorList:=nil;
// pre-calculate filter contributions for a column
SetLength(ContributorList,TargetHeight);
// vertical sub-sampling
if ScaleY<1 then
begin
// scales from bigger to smaller height
Width:=Radius/ScaleY;
for I:=0 to pred(TargetHeight) do
begin
ContributorList[I].N:=0;
SetLength(ContributorList[I].Contributors,Trunc(2*Width+1));
Center:=I/ScaleY;
Left:=Floor(Center-Width);
Right:=Ceil(Center+Width);
for J:=Left to Right do
begin
Weight:=Round(Filter((Center-J)*ScaleY)*ScaleY*256);
if Weight<>0 then
begin
if J<0 then N:=-J else
if J>=SourceHeight then N:=SourceHeight-J+SourceHeight-1 else N:=J;
K:=ContributorList[I].N;
Inc(ContributorList[I].N);
ContributorList[I].Contributors[K].Pixel:=N;
ContributorList[I].Contributors[K].Weight:=Weight;
end;
end;
end
end
else
begin
// vertical super-sampling
// scales from smaller to bigger height
for I:=0 to pred(TargetHeight) do
begin
ContributorList[I].N:=0;
SetLength(ContributorList[I].Contributors,Trunc(2*Radius+1));
Center:=I/ScaleY;
Left:=Floor(Center-Radius);
Right:=Ceil(Center+Radius);
for J:=Left to Right do
begin
Weight:=Round(Filter(Center-J)*256);
if Weight<>0 then
begin
if J<0 then N:=-J else
if J>=SourceHeight then N:=SourceHeight-J+SourceHeight-1 else N:=J;
K:=ContributorList[I].N;
Inc(ContributorList[I].N);
ContributorList[I].Contributors[K].Pixel:=N;
ContributorList[I].Contributors[K].Weight:=Weight;
end;
end;
end;
end;
// apply filter to sample vertically from Work to Target
SetLength(G.CurrentLineR,SourceHeight);
SetLength(G.CurrentLineG,SourceHeight);
SetLength(G.CurrentLineB,SourceHeight);
SourceLine:=Work.ScanLine[0];
Delta:=Integer(Work.ScanLine[1])-Integer(SourceLine);
DestLine:=Target.ScanLine[0];
DestDelta:=Integer(Target.ScanLine[1])-Integer(DestLine);
for K:=0 to pred(TargetWidth) do
begin
DestPixel:=Pointer(DestLine);
FillLineChache(SourceHeight,Delta,SourceLine,G);
for I:=0 to pred(TargetHeight) do
with ContributorList[I] do
begin
DestPixel^:=ApplyContributors(N,ContributorList[I].Contributors,G);
Inc(Integer(DestPixel),DestDelta);
end;
Inc(SourceLine);
Inc(DestLine);
end;
// free the memory allocated for vertical filter weights
for I:=0 to pred(TargetHeight) do ContributorList[I].Contributors:=nil;
// this one is done automatically on exit, but is here for completeness
ContributorList:=nil;
finally
Work.Free;
G.CurrentLineR:=nil;
G.CurrentLineG:=nil;
G.CurrentLineB:=nil;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure Stretch(NewWidth,NewHeight: cardinal; Filter: TResamplingFilter; Radius: single; Source,Target: PBitmap;
G: PGraphicExGraphic);
// Scales the source bitmap to the given size (NewWidth, NewHeight) and stores the Result in Target.
// Filter describes the filter function to be applied and Radius the size of the filter area.
// Is Radius = 0 then the recommended filter area will be used (see DefaultFilterRadius).
begin
if Radius=0 then Radius:=DefaultFilterRadius[Filter];
Target.Handle:=0;
Target.PixelFormat:=pf24Bit;
Target.Width:=NewWidth;
Target.Height:=NewHeight;
Source.PixelFormat:=pf24Bit;
DoStretch(FilterList[Filter],Radius,Source,Target,G);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure Stretch(NewWidth,NewHeight: cardinal; Filter: TResamplingFilter;
Radius: single; Source: PBitmap; G: PGraphicExGraphic);
var Target: PBitmap;
begin
if Radius=0 then Radius:=DefaultFilterRadius[Filter];
Target:=NewBitmap(0,0);
try
Target.PixelFormat:=pf24Bit;
Target.Width:=NewWidth;
Target.Height:=NewHeight;
Source.PixelFormat:=pf24Bit;
DoStretch(FilterList[Filter],Radius,Source,Target,G);
Source.Assign(Target);
finally
Target.Free;
end;
end;
//----------------- support functions for image loading ----------------------------------------------------------------
procedure SwapShort(P: PWord; Count: cardinal);
// swaps high and low byte of 16 bit values
// EAX contains P, EDX contains Count
asm
@@Loop:
MOV CX,[EAX]
XCHG CH,CL
MOV [EAX],CX
ADD EAX,2
DEC EDX
JNZ @@Loop
end;
//----------------------------------------------------------------------------------------------------------------------
procedure SwapLong(P: PInteger; Count: cardinal); overload;
// swaps high and low bytes of 32 bit values
// EAX contains P, EDX contains Count
asm
@@Loop:
MOV ECX,[EAX]
BSWAP ECX
MOV [EAX],ECX
ADD EAX,4
DEC EDX
JNZ @@Loop
end;
//----------------------------------------------------------------------------------------------------------------------
function SwapLong(Value: cardinal): cardinal; overload;
// swaps high and low bytes of the given 32 bit value
asm
BSWAP EAX
end;
//----------------- various conversion routines ------------------------------------------------------------------------
procedure Depredict1(P: pointer; Count: cardinal);
// EAX contains P and EDX Count
asm
@@1:
MOV CL,[EAX]
ADD [EAX+1],CL
INC EAX
DEC EDX
JNZ @@1
end;
//----------------------------------------------------------------------------------------------------------------------
procedure Depredict3(P: pointer; Count: cardinal);
// EAX contains P and EDX Count
asm
MOV ECX,EDX
SHL ECX,1
ADD ECX,EDX // 3*Count
@@1:
MOV DL,[EAX]
ADD [EAX+3],DL
INC EAX
DEC ECX
JNZ @@1
end;
//----------------------------------------------------------------------------------------------------------------------
procedure Depredict4(P: pointer; Count: cardinal);
// EAX contains P and EDX Count
asm
SHL EDX,2 // 4*Count
@@1:
MOV CL,[EAX]
ADD [EAX+4],CL
INC EAX
DEC EDX
JNZ @@1
end;
//----------------- TGraphicExGraphic ----------------------------------------------------------------------------------
constructor TGraphicExGraphic.Create;
begin
inherited;
FColorManager:=NewColorManager;
end;
function TGraphicExGraphic.GetWidth: Integer;
begin
Result := ImageProperties.Width;
end;
function TGraphicExGraphic.GetHeight: Integer;
begin
Result := ImageProperties.Height;
end;
//----------------------------------------------------------------------------------------------------------------------
destructor TGraphicExGraphic.Destroy;
begin
FColorManager.Free;
if Assigned(FBitmap) then FBitmap.Free;
inherited;
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class
function TGraphicExGraphic.CanLoad(const Filename: string): boolean;
var Stream: PStream;
begin
Stream:=NewReadFileStream(Filename);
try
Result:=CanLoad(Stream);
finally
Stream.Free;
end;
end;
{$ENDIF}
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TGraphicExGraphic.CanLoad(Stream: PStream): boolean;
// Descentants have to override this method and return True if they consider the data in Stream
// as loadable by the particular class.
// Note: Make sure the stream position is the same on exit as it was on enter!
begin
Result:=False;
end;
//----------------------------------------------------------------------------------------------------------------------
function TGraphicExGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
// Initializes the internal image properties structure.
// Descentants must override this method to fill in the actual values.
// Result is always False to show there is no image to load.
begin
Finalize(FImageProperties);
ZeroMemory(@FImageProperties,sizeof(FImageProperties));
FImageProperties.FileGamma:=1;
Result:=False;
end;
//----------------- TAutodeskGraphic -----------------------------------------------------------------------------------
type
TAutodeskHeader = packed record
Width,Height,XCoord,YCoord: word;
Depth,Compression: byte;
DataSize: cardinal;
Reserved: array[0..15] of byte;
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TAutodeskGraphic.CanLoad(Stream: PStream): boolean;
var FileID: word;
Header: TAutodeskHeader;
LastPosition: cardinal;
begin
Result:=(Stream.Size-Stream.Position)>(sizeof(FileID)+sizeof(Header));
if Result then
begin
LastPosition:=Stream.Position;
Stream.Read(FileID,sizeof(FileID));
Result:=FileID=$9119;
if Result then
begin
// read image dimensions
Stream.Read(Header,sizeof(Header));
Result:=(Header.Depth=8) and (Header.Compression=0);
end;
Stream.Position:=LastPosition;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TAutodeskGraphic.LoadFromStream(Stream: PStream);
var FileID: word;
FileHeader: TAutodeskHeader;
I: integer;
Pal: array[0..767] of byte;
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
if ReadImageProperties(Stream,0) then
begin
Stream.Position:=FBasePosition;
Stream.Read(FileID,2);
// read image dimensions
Stream.Read(FileHeader,sizeof(FileHeader));
// read palette data
Stream.Read(Pal,sizeof(Pal));
// setup bitmap properties
FBitmap:=NewBitmap(FileHeader.Width,FileHeader.Height);
FBitmap.PixelFormat:=pf8Bit;
// assign palette data
for I:=0 to 255 do
FBitmap.DIBPalEntries[I]:=RGB(Pal[I*3+2] shl 2,Pal[I*3+1] shl 2,Pal[I*3] shl 2);
// finally read image data
for I:=0 to pred(FBitmap.Height) do Stream.Read(FBitmap.ScanLine[I]^,FileHeader.Width);
end
else GraphicExError(1{gesInvalidImage},['Autodesk']);
end;
//----------------------------------------------------------------------------------------------------------------------
function TAutodeskGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var FileID: word;
Header: TAutodeskHeader;
begin
Result:=inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
Stream.Read(FileID,2);
if FileID=$9119 then
begin
// read image dimensions
Stream.Read(Header,sizeof(Header));
ColorScheme:=csIndexed;
Width:=Header.Width;
Height:=Header.Height;
BitsPerSample:=8;
SamplesPerPixel:=1;
BitsPerPixel:=8;
Compression:=ctNone;
Result:=True;
end;
end;
end;
//----------------- TSGIGraphic ----------------------------------------------------------------------------------------
const
SGIMagic = 474;
SGI_COMPRESSION_VERBATIM = 0;
SGI_COMPRESSION_RLE = 1;
type
TSGIHeader = packed record
Magic: smallint; // IRIS image file magic number
Storage, // Storage format
BPC: byte; // Number of bytes per pixel channel (1 or 2)
Dimension: word; // Number of dimensions
// 1 - one single scanline (and one channel) of length XSize
// 2 - two dimensional (one channel) of size XSize x YSize
// 3 - three dimensional (ZSize channels) of size XSize x YSize
XSize, // width of image
YSize, // height of image
ZSize: word; // number of channels/planes in image (3 for RGB, 4 for RGBA etc.)
PixMin, // Minimum pixel value
PixMax: cardinal; // Maximum pixel value
Dummy: cardinal; // ignored
ImageName: array[0..79] of Char;
ColorMap: integer; // Colormap ID
// 0 - default, almost all images are stored with this flag
// 1 - dithered, only one channel of data (pixels are packed), obsolete
// 2 - screen (palette) image, obsolete
// 3 - no image data, palette only, not displayable
Dummy2: array[0..403] of byte; // ignored
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TSGIGraphic.CanLoad(Stream: PStream): boolean;
// returns True if the data in Stream represents a graphic which can be loaded by this class
var Header: TSGIHeader;
LastPosition: cardinal;
begin
Result:=(Stream.Size-Stream.Position)>sizeof(TSGIHeader);
if Result then
begin
LastPosition:=Stream.Position;
Stream.Read(Header,sizeof(Header));
// one number as check is too unreliable, hence we take some more fields into the check
Result:=(System.Swap(Header.Magic)=SGIMagic) and (Header.BPC in [1,2]) and (System.Swap(Header.Dimension) in [1..3]);
Stream.Position:=LastPosition;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSGIGraphic.ReadAndDecode(Red,Green,Blue,Alpha: pointer; Row,BPC: cardinal);
var Count: cardinal;
RawBuffer: pointer;
begin
with FImageProperties do
// compressed image?
if Assigned(FDecoder) then
begin
if Assigned(Red) then
begin
FStream.Position:=FBasePosition+FRowStart[Row+0*Height];
Count:=BPC*FRowSize[Row+0*Height];
GetMem(RawBuffer,Count);
try
FStream.Read(RawBuffer^,Count);
FDecoder.Decode(RawBuffer,Red,Count,Width);
finally
if Assigned(RawBuffer) then FreeMem(RawBuffer);
end;
end;
if Assigned(Green) then
begin
FStream.Position:=FBasePosition+FRowStart[Row+1*Height];
Count:=BPC*FRowSize[Row+1*Height];
GetMem(RawBuffer,Count);
try
FStream.Read(RawBuffer^,Count);
FDecoder.Decode(RawBuffer,Green,Count,Width);
finally
if Assigned(RawBuffer) then FreeMem(RawBuffer);
end;
end;
if Assigned(Blue) then
begin
FStream.Position:=FBasePosition+FRowStart[Row+2*Height];
Count:=BPC*FRowSize[Row+2*Height];
GetMem(RawBuffer,Count);
try
FStream.Read(RawBuffer^,Count);
FDecoder.Decode(RawBuffer,Blue,Count,Width);
finally
if Assigned(RawBuffer) then FreeMem(RawBuffer);
end;
end;
if Assigned(Alpha) then
begin
FStream.Position:=FBasePosition+FRowStart[Row+3*Height];
Count:=BPC*FRowSize[Row+3*Height];
GetMem(RawBuffer,Count);
try
FStream.Read(RawBuffer^,Count);
FDecoder.Decode(RawBuffer,Alpha,Count,Width);
finally
if Assigned(RawBuffer) then FreeMem(RawBuffer);
end;
end;
end
else
begin
if Assigned(Red) then
begin
FStream.Position:=FBasePosition+512+(Row*Width);
FStream.Read(Red^,BPC*Width);
end;
if Assigned(Green) then
begin
FStream.Position:=FBasePosition+512+(Row*Width)+(Width*Height);
FStream.Read(Green^,BPC*Width);
end;
if Assigned(Blue) then
begin
FStream.Position:=FBasePosition+512+(Row*Width)+(2*Width*Height);
FStream.Read(Blue^,BPC*Width);
end;
if Assigned(Alpha) then
begin
FStream.Position:=FBasePosition+512+(Row*Width)+(3*Width*Height);
FStream.Read(Alpha^,BPC*Width);
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TSGIGraphic.LoadFromStream(Stream: PStream);
var Y,Count: cardinal;
RedBuffer,GreenBuffer,BlueBuffer,AlphaBuffer: pointer;
Header: TSGIHeader;
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
// keep stream reference and start position for seek operations
FStream:=Stream;
FBasePosition:=Stream.Position;
if ReadImageProperties(Stream,0) then
begin
with FImageProperties do
begin
Stream.Position:=FBasePosition;
// read header again, we need some additional information
Stream.Read(Header,sizeof(Header));
// SGI images are always stored in big endian style
ColorManager.SourceOptions:=[coNeedByteSwap];
with Header do ColorMap:=SwapLong(ColorMap);
if Compression=ctRLE then
begin
Count:=Height*SamplesPerPixel;
GetMem(FRowStart,Count*4);
GetMem(FRowSize,Count*4);
// read line starts and sizes from stream
Stream.Read(FRowStart^,Count*sizeof(Cardinal));
SwapLong(Pointer(FRowStart),Count);
Stream.Read(FRowSize^,Count*sizeof(Cardinal));
SwapLong(Pointer(FRowSize),Count);
{$IFDEF NOCLASSES} new( FDecoder, Create(BitsPerSample) );
{$ELSE} FDecoder:=TSGIRLEDecoder.Create(BitsPerSample); {$ENDIF}
end
else
begin
FDecoder:=nil;
end;
// set pixel format before size to avoid possibly large conversion operation
ColorManager.SourceBitsPerSample:=BitsPerSample;
ColorManager.TargetBitsPerSample:=8;
ColorManager.SourceSamplesPerPixel:=SamplesPerPixel;
ColorManager.TargetSamplesPerPixel:=SamplesPerPixel;
ColorManager.SourceColorScheme:=ColorScheme;
case ColorScheme of
csRGBA: ColorManager.TargetColorScheme:=csBGRA;
csRGB: ColorManager.TargetColorScheme:=csBGR;
else ColorManager.TargetColorScheme:=csIndexed;
end;
FBitmap:=NewBitmap(Width,Height);
FBitmap.PixelFormat:=ColorManager.TargetPixelFormat;
RedBuffer:=nil;
GreenBuffer:=nil;
BlueBuffer:=nil;
AlphaBuffer:=nil;
try
Count:=(BitsPerPixel div 8)*Width;
// read lines and put them into the bitmap
case ColorScheme of
csRGBA:
begin
GetMem(RedBuffer,Count);
GetMem(GreenBuffer,Count);
GetMem(BlueBuffer,Count);
GetMem(AlphaBuffer,Count);
for Y:=0 to pred(Height) do
begin
ReadAndDecode(RedBuffer,GreenBuffer,BlueBuffer,AlphaBuffer,Y,Header.BPC);
ColorManager.ConvertRow([RedBuffer,GreenBuffer,BlueBuffer,AlphaBuffer],FBitmap.ScanLine[Height-Y-1],Width,$FF);
end;
end;
csRGB:
begin
GetMem(RedBuffer,Count);
GetMem(GreenBuffer,Count);
GetMem(BlueBuffer,Count);
for Y:=0 to pred(Height) do
begin
ReadAndDecode(RedBuffer,GreenBuffer,BlueBuffer,nil,Y,Header.BPC);
ColorManager.ConvertRow([RedBuffer,GreenBuffer,BlueBuffer],FBitmap.ScanLine[Height-Y-1],Width,$FF);
end;
end;
else
// any other format is interpreted as being 256 gray scales
ColorManager.CreateGrayscalePalette(FBitmap,False);
for Y:=0 to pred(Height) do
begin
ReadAndDecode(FBitmap.ScanLine[Height-Y-1],nil,nil,nil,Y,Header.BPC);
end;
end;
finally
if Assigned(RedBuffer) then FreeMem(RedBuffer);
if Assigned(GreenBuffer) then FreeMem(GreenBuffer);
if Assigned(BlueBuffer) then FreeMem(BlueBuffer);
if Assigned(AlphaBuffer) then FreeMem(AlphaBuffer);
FDecoder.Free;
end;
end;
end
else GraphicExError(1{gesInvalidImage},['SGI, BW or RGB(A)']);
FreeMem(FRowStart {,Count*4} );
FreeMem(FRowSize {,Count*4} );
end;
//----------------------------------------------------------------------------------------------------------------------
function TSGIGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Header: TSGIHeader;
begin
Result:=inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
Stream.Read(Header,sizeof(Header));
if System.Swap(Header.Magic)=SGIMagic then
begin
Options:=[ioBigEndian];
BitsPerSample:=Header.BPC*8;
Width:=System.Swap(Header.XSize);
Height:=System.Swap(Header.YSize);
SamplesPerPixel:=System.Swap(Header.ZSize);
case SamplesPerPixel of
4: ColorScheme:=csRGBA;
3: ColorScheme:=csRGB;
else
// all other is considered as being 8 bit gray scale
ColorScheme:=csIndexed;
end;
BitsPerPixel:=BitsPerSample*SamplesPerPixel;
if Header.Storage=SGI_COMPRESSION_RLE then Compression:=ctRLE else Compression:=ctNone;
Result:=True;
end;
end;
end;
//----------------- TTIFFGraphic ---------------------------------------------------------------------------------------
const // TIFF tags
TIFFTAG_SUBFILETYPE = 254; // subfile data descriptor
FILETYPE_REDUCEDIMAGE = $1; // reduced resolution version
FILETYPE_PAGE = $2; // one page of many
FILETYPE_MASK = $4; // transparency mask
TIFFTAG_OSUBFILETYPE = 255; // kind of data in subfile (obsolete by revision 5.0)
OFILETYPE_IMAGE = 1; // full resolution image data
OFILETYPE_REDUCEDIMAGE = 2; // reduced size image data
OFILETYPE_PAGE = 3; // one page of many
TIFFTAG_IMAGEWIDTH = 256; // image width in pixels
TIFFTAG_IMAGELENGTH = 257; // image height in pixels
TIFFTAG_BITSPERSAMPLE = 258; // bits per channel (sample)
TIFFTAG_COMPRESSION = 259; // data compression technique
COMPRESSION_NONE = 1; // dump mode
COMPRESSION_CCITTRLE = 2; // CCITT modified Huffman RLE
COMPRESSION_CCITTFAX3 = 3; // CCITT Group 3 fax encoding
COMPRESSION_CCITTFAX4 = 4; // CCITT Group 4 fax encoding
COMPRESSION_LZW = 5; // Lempel-Ziv & Welch
COMPRESSION_OJPEG = 6; // 6.0 JPEG (old version)
COMPRESSION_JPEG = 7; // JPEG DCT compression (new version)
COMPRESSION_ADOBE_DEFLATE = 8; // new id but same as COMPRESSION_DEFLATE
COMPRESSION_NEXT = 32766; // next 2-bit RLE
COMPRESSION_CCITTRLEW = 32771; // modified Huffman with word alignment
COMPRESSION_PACKBITS = 32773; // Macintosh RLE
COMPRESSION_THUNDERSCAN = 32809; // ThunderScan RLE
// codes 32895-32898 are reserved for ANSI IT8 TIFF/IT <dkelly@etsinc.com)
COMPRESSION_IT8CTPAD = 32895; // IT8 CT w/padding
COMPRESSION_IT8LW = 32896; // IT8 Linework RLE
COMPRESSION_IT8MP = 32897; // IT8 Monochrome picture
COMPRESSION_IT8BL = 32898; // IT8 Binary line art
// compression codes 32908-32911 are reserved for Pixar
COMPRESSION_PIXARFILM = 32908; // Pixar companded 10bit LZW
COMPRESSION_PIXARLOG = 32909; // Pixar companded 11bit ZIP
COMPRESSION_DEFLATE = 32946; // Deflate compression (LZ77)
// compression code 32947 is reserved for Oceana Matrix <dev@oceana.com>
COMPRESSION_DCS = 32947; // Kodak DCS encoding
COMPRESSION_JBIG = 34661; // ISO JBIG
TIFFTAG_PHOTOMETRIC = 262; // photometric interpretation
PHOTOMETRIC_MINISWHITE = 0; // min value is white
PHOTOMETRIC_MINISBLACK = 1; // min value is black
PHOTOMETRIC_RGB = 2; // RGB color model
PHOTOMETRIC_PALETTE = 3; // color map indexed
PHOTOMETRIC_MASK = 4; // holdout mask
PHOTOMETRIC_SEPARATED = 5; // color separations
PHOTOMETRIC_YCBCR = 6; // CCIR 601
PHOTOMETRIC_CIELAB = 8; // 1976 CIE L*a*b*
TIFFTAG_THRESHHOLDING = 263; // thresholding used on data (obsolete by revision 5.0)
THRESHHOLD_BILEVEL = 1; // b&w art scan
THRESHHOLD_HALFTONE = 2; // or dithered scan
THRESHHOLD_ERRORDIFFUSE = 3; // usually floyd-steinberg
TIFFTAG_CELLWIDTH = 264; // dithering matrix width (obsolete by revision 5.0)
TIFFTAG_CELLLENGTH = 265; // dithering matrix height (obsolete by revision 5.0)
TIFFTAG_FILLORDER = 266; // data order within a Byte
FILLORDER_MSB2LSB = 1; // most significant -> least
FILLORDER_LSB2MSB = 2; // least significant -> most
TIFFTAG_DOCUMENTNAME = 269; // name of doc. image is from
TIFFTAG_IMAGEDESCRIPTION = 270; // info about image
TIFFTAG_MAKE = 271; // scanner manufacturer name
TIFFTAG_MODEL = 272; // scanner model name/number
TIFFTAG_STRIPOFFSETS = 273; // Offsets to data strips
TIFFTAG_ORIENTATION = 274; // image FOrientation (obsolete by revision 5.0)
ORIENTATION_TOPLEFT = 1; // row 0 top, col 0 lhs
ORIENTATION_TOPRIGHT = 2; // row 0 top, col 0 rhs
ORIENTATION_BOTRIGHT = 3; // row 0 bottom, col 0 rhs
ORIENTATION_BOTLEFT = 4; // row 0 bottom, col 0 lhs
ORIENTATION_LEFTTOP = 5; // row 0 lhs, col 0 top
ORIENTATION_RIGHTTOP = 6; // row 0 rhs, col 0 top
ORIENTATION_RIGHTBOT = 7; // row 0 rhs, col 0 bottom
ORIENTATION_LEFTBOT = 8; // row 0 lhs, col 0 bottom
TIFFTAG_SAMPLESPERPIXEL = 277; // samples per pixel
TIFFTAG_ROWSPERSTRIP = 278; // rows per strip of data
TIFFTAG_STRIPBYTECOUNTS = 279; // bytes counts for strips
TIFFTAG_MINSAMPLEVALUE = 280; // minimum sample value (obsolete by revision 5.0)
TIFFTAG_MAXSAMPLEVALUE = 281; // maximum sample value (obsolete by revision 5.0)
TIFFTAG_XRESOLUTION = 282; // pixels/resolution in x
TIFFTAG_YRESOLUTION = 283; // pixels/resolution in y
TIFFTAG_PLANARCONFIG = 284; // storage organization
PLANARCONFIG_CONTIG = 1; // single image plane
PLANARCONFIG_SEPARATE = 2; // separate planes of data
TIFFTAG_PAGENAME = 285; // page name image is from
TIFFTAG_XPOSITION = 286; // x page offset of image lhs
TIFFTAG_YPOSITION = 287; // y page offset of image lhs
TIFFTAG_FREEOFFSETS = 288; // byte offset to free block (obsolete by revision 5.0)
TIFFTAG_FREEBYTECOUNTS = 289; // sizes of free blocks (obsolete by revision 5.0)
TIFFTAG_GRAYRESPONSEUNIT = 290; // gray scale curve accuracy
GRAYRESPONSEUNIT_10S = 1; // tenths of a unit
GRAYRESPONSEUNIT_100S = 2; // hundredths of a unit
GRAYRESPONSEUNIT_1000S = 3; // thousandths of a unit
GRAYRESPONSEUNIT_10000S = 4; // ten-thousandths of a unit
GRAYRESPONSEUNIT_100000S = 5; // hundred-thousandths
TIFFTAG_GRAYRESPONSECURVE = 291; // gray scale response curve
TIFFTAG_GROUP3OPTIONS = 292; // 32 flag bits
GROUP3OPT_2DENCODING = $1; // 2-dimensional coding
GROUP3OPT_UNCOMPRESSED = $2; // data not compressed
GROUP3OPT_FILLBITS = $4; // fill to byte boundary
TIFFTAG_GROUP4OPTIONS = 293; // 32 flag bits
GROUP4OPT_UNCOMPRESSED = $2; // data not compressed
TIFFTAG_RESOLUTIONUNIT = 296; // units of resolutions
RESUNIT_NONE = 1; // no meaningful units
RESUNIT_INCH = 2; // english
RESUNIT_CENTIMETER = 3; // metric
TIFFTAG_PAGENUMBER = 297; // page numbers of multi-page
TIFFTAG_COLORRESPONSEUNIT = 300; // color curve accuracy
COLORRESPONSEUNIT_10S = 1; // tenths of a unit
COLORRESPONSEUNIT_100S = 2; // hundredths of a unit
COLORRESPONSEUNIT_1000S = 3; // thousandths of a unit
COLORRESPONSEUNIT_10000S = 4; // ten-thousandths of a unit
COLORRESPONSEUNIT_100000S = 5; // hundred-thousandths
TIFFTAG_TRANSFERFUNCTION = 301; // colorimetry info
TIFFTAG_SOFTWARE = 305; // name & release
TIFFTAG_DATETIME = 306; // creation date and time
TIFFTAG_ARTIST = 315; // creator of image
TIFFTAG_HOSTCOMPUTER = 316; // machine where created
TIFFTAG_PREDICTOR = 317; // prediction scheme w/ LZW
PREDICTION_NONE = 1; // no prediction scheme used before coding
PREDICTION_HORZ_DIFFERENCING = 2; // horizontal differencing prediction scheme used
TIFFTAG_WHITEPOINT = 318; // image white point
TIFFTAG_PRIMARYCHROMATICITIES = 319; // primary chromaticities
TIFFTAG_COLORMAP = 320; // RGB map for pallette image
TIFFTAG_HALFTONEHINTS = 321; // highlight+shadow info
TIFFTAG_TILEWIDTH = 322; // rows/data tile
TIFFTAG_TILELENGTH = 323; // cols/data tile
TIFFTAG_TILEOFFSETS = 324; // offsets to data tiles
TIFFTAG_TILEBYTECOUNTS = 325; // Byte counts for tiles
TIFFTAG_BADFAXLINES = 326; // lines w/ wrong pixel count
TIFFTAG_CLEANFAXDATA = 327; // regenerated line info
CLEANFAXDATA_CLEAN = 0; // no errors detected
CLEANFAXDATA_REGENERATED = 1; // receiver regenerated lines
CLEANFAXDATA_UNCLEAN = 2; // uncorrected errors exist
TIFFTAG_CONSECUTIVEBADFAXLINES = 328; // max consecutive bad lines
TIFFTAG_SUBIFD = 330; // subimage descriptors
TIFFTAG_INKSET = 332; // inks in separated image
INKSET_CMYK = 1; // cyan-magenta-yellow-black
TIFFTAG_INKNAMES = 333; // ascii names of inks
TIFFTAG_DOTRANGE = 336; // 0% and 100% dot codes
TIFFTAG_TARGETPRINTER = 337; // separation target
TIFFTAG_EXTRASAMPLES = 338; // info about extra samples
EXTRASAMPLE_UNSPECIFIED = 0; // unspecified data
EXTRASAMPLE_ASSOCALPHA = 1; // associated alpha data
EXTRASAMPLE_UNASSALPHA = 2; // unassociated alpha data
TIFFTAG_SAMPLEFORMAT = 339; // data sample format
SAMPLEFORMAT_UINT = 1; // unsigned integer data
SAMPLEFORMAT_INT = 2; // signed integer data
SAMPLEFORMAT_IEEEFP = 3; // IEEE floating point data
SAMPLEFORMAT_VOID = 4; // untyped data
TIFFTAG_SMINSAMPLEVALUE = 340; // variable MinSampleValue
TIFFTAG_SMAXSAMPLEVALUE = 341; // variable MaxSampleValue
TIFFTAG_JPEGTABLES = 347; // JPEG table stream
// Tags 512-521 are obsoleted by Technical Note #2 which specifies a revised JPEG-in-TIFF scheme.
TIFFTAG_JPEGPROC = 512; // JPEG processing algorithm
JPEGPROC_BASELINE = 1; // baseline sequential
JPEGPROC_LOSSLESS = 14; // Huffman coded lossless
TIFFTAG_JPEGIFOFFSET = 513; // Pointer to SOI marker
TIFFTAG_JPEGIFBYTECOUNT = 514; // JFIF stream length
TIFFTAG_JPEGRESTARTINTERVAL = 515; // restart interval length
TIFFTAG_JPEGLOSSLESSPREDICTORS = 517; // lossless proc predictor
TIFFTAG_JPEGPOINTTRANSFORM = 518; // lossless point transform
TIFFTAG_JPEGQTABLES = 519; // Q matrice offsets
TIFFTAG_JPEGDCTABLES = 520; // DCT table offsets
TIFFTAG_JPEGACTABLES = 521; // AC coefficient offsets
TIFFTAG_YCBCRCOEFFICIENTS = 529; // RGB -> YCbCr transform
TIFFTAG_YCBCRSUBSAMPLING = 530; // YCbCr subsampling factors
TIFFTAG_YCBCRPOSITIONING = 531; // subsample positioning
YCBCRPOSITION_CENTERED = 1; // as in PostScript Level 2
YCBCRPOSITION_COSITED = 2; // as in CCIR 601-1
TIFFTAG_REFERENCEBLACKWHITE = 532; // colorimetry info
// tags 32952-32956 are private tags registered to Island Graphics
TIFFTAG_REFPTS = 32953; // image reference points
TIFFTAG_REGIONTACKPOINT = 32954; // region-xform tack point
TIFFTAG_REGIONWARPCORNERS = 32955; // warp quadrilateral
TIFFTAG_REGIONAFFINE = 32956; // affine transformation mat
// tags 32995-32999 are private tags registered to SGI
TIFFTAG_MATTEING = 32995; // use ExtraSamples
TIFFTAG_DATATYPE = 32996; // use SampleFormat
TIFFTAG_IMAGEDEPTH = 32997; // z depth of image
TIFFTAG_TILEDEPTH = 32998; // z depth/data tile
// tags 33300-33309 are private tags registered to Pixar
//
// TIFFTAG_PIXAR_IMAGEFULLWIDTH and TIFFTAG_PIXAR_IMAGEFULLLENGTH
// are set when an image has been cropped out of a larger image.
// They reflect the size of the original uncropped image.
// The TIFFTAG_XPOSITION and TIFFTAG_YPOSITION can be used
// to determine the position of the smaller image in the larger one.
TIFFTAG_PIXAR_IMAGEFULLWIDTH = 33300; // full image size in x
TIFFTAG_PIXAR_IMAGEFULLLENGTH = 33301; // full image size in y
// tag 33405 is a private tag registered to Eastman Kodak
TIFFTAG_WRITERSERIALNUMBER = 33405; // device serial number
// tag 33432 is listed in the 6.0 spec w/ unknown ownership
TIFFTAG_COPYRIGHT = 33432; // copyright string
// 34016-34029 are reserved for ANSI IT8 TIFF/IT <dkelly@etsinc.com)
TIFFTAG_IT8SITE = 34016; // site name
TIFFTAG_IT8COLORSEQUENCE = 34017; // color seq. [RGB,CMYK,etc]
TIFFTAG_IT8HEADER = 34018; // DDES Header
TIFFTAG_IT8RASTERPADDING = 34019; // raster scanline padding
TIFFTAG_IT8BITSPERRUNLENGTH = 34020; // # of bits in short run
TIFFTAG_IT8BITSPEREXTENDEDRUNLENGTH = 34021; // # of bits in long run
TIFFTAG_IT8COLORTABLE = 34022; // LW colortable
TIFFTAG_IT8IMAGECOLORINDICATOR = 34023; // BP/BL image color switch
TIFFTAG_IT8BKGCOLORINDICATOR = 34024; // BP/BL bg color switch
TIFFTAG_IT8IMAGECOLORVALUE = 34025; // BP/BL image color value
TIFFTAG_IT8BKGCOLORVALUE = 34026; // BP/BL bg color value
TIFFTAG_IT8PIXELINTENSITYRANGE = 34027; // MP pixel intensity value
TIFFTAG_IT8TRANSPARENCYINDICATOR = 34028; // HC transparency switch
TIFFTAG_IT8COLORCHARACTERIZATION = 34029; // color character. table
// tags 34232-34236 are private tags registered to Texas Instruments
TIFFTAG_FRAMECOUNT = 34232; // Sequence Frame Count
// tag 34750 is a private tag registered to Pixel Magic
TIFFTAG_JBIGOPTIONS = 34750; // JBIG options
// tags 34908-34914 are private tags registered to SGI
TIFFTAG_FAXRECVPARAMS = 34908; // encoded class 2 ses. parms
TIFFTAG_FAXSUBADDRESS = 34909; // received SubAddr string
TIFFTAG_FAXRECVTIME = 34910; // receive time (secs)
// tag 65535 is an undefined tag used by Eastman Kodak
TIFFTAG_DCSHUESHIFTVALUES = 65535; // hue shift correction data
// The following are 'pseudo tags' that can be used to control codec-specific functionality.
// These tags are not written to file. Note that these values start at $FFFF + 1 so that they'll
// never collide with Aldus-assigned tags.
TIFFTAG_FAXMODE = 65536; // Group 3/4 format control
FAXMODE_CLASSIC = $0000; // default, include RTC
FAXMODE_NORTC = $0001; // no RTC at end of data
FAXMODE_NOEOL = $0002; // no EOL code at end of row
FAXMODE_BYTEALIGN = $0004; // Byte align row
FAXMODE_WORDALIGN = $0008; // Word align row
FAXMODE_CLASSF = FAXMODE_NORTC; // TIFF class F
TIFFTAG_JPEGQUALITY = 65537; // compression quality level
// Note: quality level is on the IJG 0-100 scale. Default value is 75
TIFFTAG_JPEGCOLORMODE = 65538; // Auto RGB<=>YCbCr convert?
JPEGCOLORMODE_RAW = $0000; // no conversion (default)
JPEGCOLORMODE_RGB = $0001; // do auto conversion
TIFFTAG_JPEGTABLESMODE = 65539; // What to put in JPEGTables
JPEGTABLESMODE_QUANT = $0001; // include quantization tbls
JPEGTABLESMODE_HUFF = $0002; // include Huffman tbls
// Note: default is JPEGTABLESMODE_QUANT or JPEGTABLESMODE_HUFF
TIFFTAG_FAXFILLFUNC = 65540; // G3/G4 fill function
TIFFTAG_PIXARLOGDATAFMT = 65549; // PixarLogCodec I/O data sz
PIXARLOGDATAFMT_8BIT = 0; // regular u_char samples
PIXARLOGDATAFMT_8BITABGR = 1; // ABGR-order u_chars
PIXARLOGDATAFMT_11BITLOG = 2; // 11-bit log-encoded (raw)
PIXARLOGDATAFMT_12BITPICIO = 3; // as per PICIO (1.0==2048)
PIXARLOGDATAFMT_16BIT = 4; // signed short samples
PIXARLOGDATAFMT_FLOAT = 5; // IEEE float samples
// 65550-65556 are allocated to Oceana Matrix <dev@oceana.com>
TIFFTAG_DCSIMAGERTYPE = 65550; // imager model & filter
DCSIMAGERMODEL_M3 = 0; // M3 chip (1280 x 1024)
DCSIMAGERMODEL_M5 = 1; // M5 chip (1536 x 1024)
DCSIMAGERMODEL_M6 = 2; // M6 chip (3072 x 2048)
DCSIMAGERFILTER_IR = 0; // infrared filter
DCSIMAGERFILTER_MONO = 1; // monochrome filter
DCSIMAGERFILTER_CFA = 2; // color filter array
DCSIMAGERFILTER_OTHER = 3; // other filter
TIFFTAG_DCSINTERPMODE = 65551; // interpolation mode
DCSINTERPMODE_NORMAL = $0; // whole image, default
DCSINTERPMODE_PREVIEW = $1; // preview of image (384x256)
TIFFTAG_DCSBALANCEARRAY = 65552; // color balance values
TIFFTAG_DCSCORRECTMATRIX = 65553; // color correction values
TIFFTAG_DCSGAMMA = 65554; // gamma value
TIFFTAG_DCSTOESHOULDERPTS = 65555; // toe & shoulder points
TIFFTAG_DCSCALIBRATIONFD = 65556; // calibration file desc
// Note: quality level is on the ZLIB 1-9 scale. Default value is -1
TIFFTAG_ZIPQUALITY = 65557; // compression quality level
TIFFTAG_PIXARLOGQUALITY = 65558; // PixarLog uses same scale
// TIFF data types
TIFF_NOTYPE = 0; // placeholder
TIFF_BYTE = 1; // 8-bit unsigned integer
TIFF_ASCII = 2; // 8-bit bytes w/ last byte null
TIFF_SHORT = 3; // 16-bit unsigned integer
TIFF_LONG = 4; // 32-bit unsigned integer
TIFF_RATIONAL = 5; // 64-bit unsigned fraction
TIFF_SBYTE = 6; // 8-bit signed integer
TIFF_UNDEFINED = 7; // 8-bit untyped data
TIFF_SSHORT = 8; // 16-bit signed integer
TIFF_SLONG = 9; // 32-bit signed integer
TIFF_SRATIONAL = 10; // 64-bit signed fraction
TIFF_FLOAT = 11; // 32-bit IEEE floating point
TIFF_DOUBLE = 12; // 64-bit IEEE floating point
TIFF_BIGENDIAN = $4D4D;
TIFF_LITTLEENDIAN = $4949;
TIFF_VERSION = 42;
type
TTIFFHeader = packed record
ByteOrder: word;
Version: word;
FirstIFD: cardinal;
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TTIFFGraphic.CanLoad(Stream: PStream): boolean;
var Header: TTIFFHeader;
LastPosition: Cardinal;
begin
Result:=(Stream.Size-Stream.Position)>sizeof(Header);
if Result then
begin
LastPosition:=Stream.Position;
Stream.Read(Header,sizeof(Header));
Result:=(Header.ByteOrder=TIFF_BIGENDIAN) or (Header.ByteOrder=TIFF_LITTLEENDIAN);
if Result then
begin
if Header.ByteOrder=TIFF_BIGENDIAN then
begin
Header.Version:=System.Swap(Header.Version);
Header.FirstIFD:=SwapLong(Header.FirstIFD);
end;
Result:=(Header.Version=TIFF_VERSION) and
(Integer(Header.FirstIFD)<Integer(Stream.Size-LastPosition));
end;
Stream.Position:=LastPosition;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TTIFFGraphic.FindTag(ATag: cardinal; var Index: cardinal): boolean;
// looks through the currently loaded IFD for the entry indicated by Tag;
// returns True and the index of the entry in Index if the entry is there
// otherwise the result is False and Index undefined
// Note: The IFD is sorted so we can use a binary search here.
var L,H,I,C: integer;
begin
Result:=False;
L:=0;
H:=High(FIFD);
while L<=H do
begin
I:=(L+H) shr 1;
C:=Integer(FIFD[I].ATag)-Integer(ATag);
if C<0 then L:=I+1 else
begin
H:=I-1;
if C=0 then
begin
Result:=True;
L:=I;
end;
end;
end;
Index:=L;
end;
//----------------------------------------------------------------------------------------------------------------------
const
DataTypeToSize: array[TIFF_NOTYPE..TIFF_SLONG] of byte = (0,1,1,2,4,8,1,1,2,4);
procedure TTIFFGraphic.GetValueList(Stream: PStream; ATag: cardinal; var Values: TByteArray);
// returns the values of the IFD entry indicated by Tag
var Index,Value,Shift: cardinal;
I: Integer;
begin
if FindTag(ATag,Index) and (FIFD[Index].DataLength>0) then
begin
// prepare value list
SetLength(Values,FIFD[Index].DataLength);
// determine whether the data fits into 4 bytes
Value:=DataTypeToSize[FIFD[Index].DataType]*FIFD[Index].DataLength;
// data fits into one cardinal -> extract it
if Value<=4 then
begin
Shift:=DataTypeToSize[FIFD[Index].DataType]*8;
Value:=FIFD[Index].Offset;
for I:=0 to pred(FIFD[Index].DataLength) do
begin
case FIFD[Index].DataType of
TIFF_BYTE:
Values[I]:=Byte(Value);
TIFF_SHORT,
TIFF_SSHORT:
// no byte swap needed here because values in the IFD are already swapped
// (if necessary at all)
Values[I]:=Word(Value);
TIFF_LONG,
TIFF_SLONG:
Values[I]:=Value;
end;
Value:=Value shr Shift;
end;
end
else
begin
// data of this tag does not fit into one 32 bits value
Stream.Position:=FBasePosition+FIFD[Index].Offset;
// bytes sized data can be read directly instead of looping through the array
if FIFD[Index].DataType in [TIFF_BYTE,TIFF_ASCII,TIFF_SBYTE,TIFF_UNDEFINED] then Stream.Read(Values[0],Value) else
begin
for I:=0 to High(Values) do
begin
Stream.Read(Value,DataTypeToSize[FIFD[Index].DataType]);
case FIFD[Index].DataType of
TIFF_BYTE:
Value:=Byte(Value);
TIFF_SHORT,
TIFF_SSHORT:
begin
if ioBigEndian in FImageProperties.Options then Value:=System.Swap(Word(Value)) else Value:=Word(Value);
end;
TIFF_LONG,
TIFF_SLONG:
if ioBigEndian in FImageProperties.Options then Value:=SwapLong(Value);
end;
Values[I]:=Value;
end;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TTIFFGraphic.GetValueList(Stream: PStream; ATag: cardinal; var Values: TCardinalArray);
// returns the values of the IFD entry indicated by Tag
var Index,Value,Shift: cardinal;
I: integer;
begin
// Values:=nil;
if FindTag(ATag,Index) and (FIFD[Index].DataLength>0) then
begin
// prepare value list
SetLength(Values,FIFD[Index].DataLength);
// determine whether the data fits into 4 bytes
Value:=DataTypeToSize[FIFD[Index].DataType]*FIFD[Index].DataLength;
// data fits into one cardinal -> extract it
if Value<=4 then
begin
Shift:=DataTypeToSize[FIFD[Index].DataType]*8;
Value:=FIFD[Index].Offset;
for I:=0 to pred(FIFD[Index].DataLength) do
begin
case FIFD[Index].DataType of
TIFF_BYTE,
TIFF_ASCII,
TIFF_SBYTE,
TIFF_UNDEFINED: Values[I]:=Byte(Value);
TIFF_SHORT,
TIFF_SSHORT:
// no byte swap needed here because values in the IFD are already swapped
// (if necessary at all)
Values[I]:=Word(Value);
TIFF_LONG,
TIFF_SLONG:
Values[I]:=Value;
end;
Value:=Value shr Shift;
end;
end
else
begin
// data of this tag does not fit into one 32 bits value
Stream.Position:=FBasePosition+FIFD[Index].Offset;
// even bytes sized data must be read by the loop as it is expanded to cardinals
for I:=0 to High(Values) do
begin
Stream.Read(Value,DataTypeToSize[FIFD[Index].DataType]);
case FIFD[Index].DataType of
TIFF_BYTE:
Value:=Byte(Value);
TIFF_SHORT,
TIFF_SSHORT:
begin
if ioBigEndian in FImageProperties.Options then Value:=System.Swap(Word(Value)) else Value:=Word(Value);
end;
TIFF_LONG,
TIFF_SLONG:
if ioBigEndian in FImageProperties.Options then Value:=SwapLong(Value);
end;
Values[I]:=Value;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TTIFFGraphic.GetValueList(Stream: PStream; ATag: Cardinal; var Values: TFloatArray);
// returns the values of the IFD entry indicated by Tag
var Index,Shift,IntValue: cardinal;
Value: single;
I: integer;
IntNominator,IntDenominator,FloatNominator,FloatDenominator: cardinal;
begin
// Values:=nil;
if FindTag(ATag,Index) and (FIFD[Index].DataLength>0) then
begin
// prepare value list
SetLength(Values,FIFD[Index].DataLength);
// determine whether the data fits into 4 bytes
Value:=DataTypeToSize[FIFD[Index].DataType]*FIFD[Index].DataLength;
// data fits into one cardinal -> extract it
if Value<=4 then
begin
Shift:=DataTypeToSize[FIFD[Index].DataType]*8;
IntValue:=FIFD[Index].Offset;
for I:=0 to pred(FIFD[Index].DataLength) do
begin
case FIFD[Index].DataType of
TIFF_BYTE,
TIFF_ASCII,
TIFF_SBYTE,
TIFF_UNDEFINED:
Values[I]:=Byte(IntValue);
TIFF_SHORT,
TIFF_SSHORT:
// no byte swap needed here because values in the IFD are already swapped
// (if necessary at all)
Values[I]:=Word(IntValue);
TIFF_LONG,
TIFF_SLONG:
Values[I]:=IntValue;
end;
IntValue:=IntValue shr Shift;
end;
end
else
begin
// data of this tag does not fit into one 32 bits value
Stream.Position:=FBasePosition+FIFD[Index].Offset;
// even bytes sized data must be read by the loop as it is expanded to Single
for I:=0 to High(Values) do
begin
case FIFD[Index].DataType of
TIFF_BYTE:
begin
Stream.Read(IntValue,DataTypeToSize[FIFD[Index].DataType]);
Value:=Byte(IntValue);
end;
TIFF_SHORT,
TIFF_SSHORT:
begin
Stream.Read(IntValue,DataTypeToSize[FIFD[Index].DataType]);
if ioBigEndian in FImageProperties.Options then Value:=System.Swap(Word(IntValue)) else Value:=Word(IntValue);
end;
TIFF_LONG,
TIFF_SLONG:
begin
Stream.Read(IntValue,DataTypeToSize[FIFD[Index].DataType]);
if ioBigEndian in FImageProperties.Options then Value:=SwapLong(IntValue);
end;
TIFF_RATIONAL,
TIFF_SRATIONAL:
begin
Stream.Read(FloatNominator,sizeof(FloatNominator));
Stream.Read(FloatDenominator,sizeof(FloatDenominator));
if ioBigEndian in FImageProperties.Options then
begin
FloatNominator:=SwapLong(Cardinal(FloatNominator));
FloatDenominator:=SwapLong(Cardinal(FloatDenominator));
end;
Value:=FloatNominator/FloatDenominator;
end;
TIFF_FLOAT:
begin
Stream.Read(IntNominator,sizeof(IntNominator));
Stream.Read(IntDenominator,sizeof(IntDenominator));
if ioBigEndian in FImageProperties.Options then
begin
IntNominator:=SwapLong(IntNominator);
IntDenominator:=SwapLong(IntDenominator);
end;
Value:=IntNominator/IntDenominator;
end;
end;
Values[I]:=Value;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TTIFFGraphic.GetValue(Stream: PStream; ATag: cardinal; Default: single = 0): single;
// returns the value of the IFD entry indicated by Tag or the default value if the entry is not there
var Index: cardinal;
IntNominator,IntDenominator: cardinal;
FloatNominator,FloatDenominator: cardinal;
begin
Result:=Default;
if FindTag(ATag,Index) then
begin
// if the data length is>1 then Offset is a real offset into the stream,
// otherwise it is the value itself and must be shortend depending on the data type
if FIFD[Index].DataLength=1 then
begin
case FIFD[Index].DataType of
TIFF_BYTE:
Result:=Byte(FIFD[Index].Offset);
TIFF_SHORT,
TIFF_SSHORT:
Result:=Word(FIFD[Index].Offset);
TIFF_LONG,
TIFF_SLONG: // nothing to do
Result:=FIFD[Index].Offset;
TIFF_RATIONAL,
TIFF_SRATIONAL:
begin
Stream.Position:=FBasePosition+FIFD[Index].Offset;
Stream.Read(FloatNominator,sizeof(FloatNominator));
Stream.Read(FloatDenominator,sizeof(FloatDenominator));
if ioBigEndian in FImageProperties.Options then
begin
FloatNominator:=SwapLong(Cardinal(FloatNominator));
FloatDenominator:=SwapLong(Cardinal(FloatDenominator));
end;
Result:=FloatNominator/FloatDenominator;
end;
TIFF_FLOAT:
begin
Stream.Position:=FBasePosition+FIFD[Index].Offset;
Stream.Read(IntNominator,sizeof(IntNominator));
Stream.Read(IntDenominator,sizeof(IntDenominator));
if ioBigEndian in FImageProperties.Options then
begin
IntNominator:=SwapLong(IntNominator);
IntDenominator:=SwapLong(IntDenominator);
end;
Result:=IntNominator/IntDenominator;
end;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TTIFFGraphic.GetValue(ATag: cardinal; Default: cardinal=0): cardinal;
// returns the value of the IFD entry indicated by Tag or the default value if the entry is not there
var Index: cardinal;
begin
if not FindTag(ATag, Index) then Result:=Default else
begin
Result:=FIFD[Index].Offset;
// if the data length is>1 then Offset is a real offset into the stream,
// otherwise it is the value itself and must be shortend depending on the data type
if FIFD[Index].DataLength=1 then
begin
case FIFD[Index].DataType of
TIFF_BYTE:
Result:=Byte(Result);
TIFF_SHORT,
TIFF_SSHORT:
Result:=Word(Result);
TIFF_LONG,
TIFF_SLONG: // nothing to do
;
else
Result:=Default;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TTIFFGraphic.GetValue(ATag: cardinal; var Size: cardinal; Default: cardinal): cardinal;
// Returns the value of the IFD entry indicated by Tag or the default value if the entry is not there.
// If the tag exists then also the data size is returned.
var Index: cardinal;
begin
if not FindTag(ATag,Index) then
begin
Result:=Default;
Size:=0;
end
else
begin
Result:=FIFD[Index].Offset;
Size:=FIFD[Index].DataLength;
// if the data length is>1 then Offset is a real offset into the stream,
// otherwise it is the value itself and must be shortend depending on the data type
if FIFD[Index].DataLength=1 then
begin
case FIFD[Index].DataType of
TIFF_BYTE:
Result:=Byte(Result);
TIFF_SHORT,
TIFF_SSHORT:
Result:=Word(Result);
TIFF_LONG,
TIFF_SLONG: // nothing to do
;
else
Result:=Default;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TTIFFGraphic.SortIFD;
// Although all entries in the IFD should be sorted there are still files where this is not the case.
// Because the lookup for certain tags in the IFD uses binary search it must be made sure the IFD is
// sorted (what we do here).
//--------------- local function --------------------------------------------
procedure QuickSort(L, R: Integer);
var I,J,M: integer;
T: TIFDEntry;
begin
repeat
I:=L;
J:=R;
M:=(L+R) shr 1;
repeat
while FIFD[I].ATag<FIFD[M].ATag do Inc(I);
while FIFD[J].ATag>FIFD[M].ATag do Dec(J);
if I<=J then
begin
T:=FIFD[I];
FIFD[I]:=FIFD[J];
FIFD[J]:=T;
Inc(I);
Dec(J);
end;
until I>J;
if L<J then QuickSort(L,J);
L:=I;
until I>=R;
end;
//--------------- end local functions ---------------------------------------
begin
QuickSort(0,High(FIFD));
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TTIFFGraphic.SwapIFD;
// swap the member fields of all entries of the currently loaded IFD from big endian to little endian
var I: integer;
Size: cardinal;
begin
for I:=0 to High(FIFD) do
with FIFD[I] do
begin
ATag:=System.Swap(ATag);
DataType:=System.Swap(DataType);
DataLength:=SwapLong(DataLength);
// determine whether the data fits into 4 bytes
Size:=DataTypeToSize[FIFD[I].DataType]*FIFD[I].DataLength;
if Size>=4 then Offset:=SwapLong(Offset) else
case DataType of
TIFF_SHORT,TIFF_SSHORT: if DataLength>1 then Offset:=SwapLong(Offset) else Offset:=System.Swap(Word(Offset));
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TTIFFGraphic.LoadFromStream(Stream: PStream);
var IFDCount: word;
Buffer: pointer;
Run: PChar;
Pixels,EncodedData,DataPointerCopy: pointer;
Offsets,ByteCounts: TCardinalArray;
ColorMap: cardinal;
StripSize: cardinal;
{$IFDEF NOCLASSES} Decoder: PDecoder; {$ELSE} Decoder: TDecoder; {$ENDIF}
{$IFDEF NOCLASSES}
TIFFLZWDecoder: PTiffLzwDecoder;
PackBitsRLEDecoder: PPackBitsRLEDecoder;
CCITTMHDecoder: PCCITTMHDecoder;
CCITTFax3Decoder: PCCITTFax3Decoder;
CCITTFax4Decoder: PCCITTFax4Decoder;
LZ77Decoder: PLZ77Decoder;
{$ENDIF}
// dynamically assigned handler
Deprediction: procedure(P: pointer; Count: cardinal);
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
Deprediction:=nil;
Decoder:=nil;
// we need to keep the current stream position because all position information
// are relative to this one
FBasePosition:=Stream.Position;
if ReadImageProperties(Stream,0) then
begin
with FImageProperties do
try
// tiled images aren't supported
if ioTiled in FImageProperties.Options then Exit;
// read data of the first image file directory (IFD)
Stream.Position:=FBasePosition+FirstIFD;
Stream.Read(IFDCount,sizeof(IFDCount));
if ioBigEndian in Options then IFDCount:=System.Swap(IFDCount);
SetLength(FIFD,IFDCount);
Stream.Read(FIFD[0],IFDCount*sizeof(TIFDEntry));
if ioBigEndian in Options then SwapIFD;
SortIFD;
// --- read the data of the directory which are needed to actually load the image:
// data organization
GetValueList(Stream,TIFFTAG_STRIPOFFSETS,Offsets);
GetValueList(Stream,TIFFTAG_STRIPBYTECOUNTS,ByteCounts);
// retrive additional tile data if necessary
if ioTiled in Options then
begin
GetValueList(Stream,TIFFTAG_TILEOFFSETS,Offsets);
GetValueList(Stream,TIFFTAG_TILEBYTECOUNTS,ByteCounts);
end;
// determine pixelformat and setup color conversion
if ioBigEndian in Options then
ColorManager.SourceOptions:=[coNeedByteSwap]
else
ColorManager.SourceOptions:=[];
ColorManager.SourceBitsPerSample:=FImageProperties.BitsPerSample;
if ColorManager.SourceBitsPerSample=16 then
ColorManager.TargetBitsPerSample:=8
else
ColorManager.TargetBitsPerSample:=ColorManager.SourceBitsPerSample;
// the JPEG lib does internally a conversion to RGB
if FImageProperties.Compression in [ctOJPEG,ctJPEG] then
ColorManager.SourceColorScheme:=csBGR
else
ColorManager.SourceColorScheme:=FImageProperties.ColorScheme;
case ColorManager.SourceColorScheme of
csRGBA: ColorManager.TargetColorScheme:=csBGRA;
csRGB: ColorManager.TargetColorScheme:=csBGR;
csCMY,csCMYK,csCIELab,csYCbCr: ColorManager.TargetColorScheme:=csBGR;
csIndexed:
begin
if HasAlpha then
ColorManager.SourceColorScheme:=csGA; // fake indexed images with alpha (used in EPS)
// as being grayscale with alpha
ColorManager.TargetColorScheme:=csIndexed;
end;
else
ColorManager.TargetColorScheme:=ColorManager.SourceColorScheme;
end;
ColorManager.SourceSamplesPerPixel:=FImageProperties.SamplesPerPixel;
// now that the pixel format is set we can also set the (possibly large) image dimensions
FBitmap:=NewBitmap(FImageProperties.Width,FImageProperties.Height);
if ColorManager.SourceColorScheme=csCMYK then
ColorManager.TargetSamplesPerPixel:=3
else
ColorManager.TargetSamplesPerPixel:=FImageProperties.SamplesPerPixel;
if ColorManager.SourceColorScheme=csCIELab then
ColorManager.SourceOptions:=ColorManager.SourceOptions+[coLabByteRange];
if ColorManager.SourceColorScheme=csGA then
FBitmap.PixelFormat:=pf8Bit
else
FBitmap.PixelFormat:=ColorManager.TargetPixelFormat;
if (FImageProperties.Width=0) or (FImageProperties.Height=0) then
GraphicExError(1{gesInvalidImage},[TIF]);
if ColorManager.TargetColorScheme in [csIndexed,csG,csGA] then
begin
// load palette data and build palette
if ColorManager.TargetColorScheme=csIndexed then
begin
ColorMap:=GetValue(TIFFTAG_COLORMAP,StripSize,0);
if StripSize>0 then
begin
Stream.Position:=FBasePosition+ColorMap;
// number of palette entries is also given by the color map tag
// (3 components each (r,g,b) and two bytes per component)
Stream.Read(FPalette[0],2*StripSize);
ColorManager.CreateColorPalette(FBitmap,[@FPalette[0],
@FPalette[StripSize div 3],
@FPalette[2*StripSize div 3]],
pfPlane16Triple,StripSize div 3,False);
end;
end
else ColorManager.CreateGrayScalePalette(FBitmap,ioMinIsWhite in Options);
end
else
if ColorManager.SourceColorScheme=csYCbCr then
ColorManager.SetYCbCrParameters(
FYCbCrCoefficients,YCbCrSubSampling[0],YCbCrSubSampling[1]);
// intermediate buffer for data
FImageProperties.BytesPerLine:=(FImageProperties.BitsPerPixel*FImageProperties.Width+7) div 8;
// determine prediction scheme
if Compression<>ctNone then
begin
// Prediction without compression makes no sense at all (as it is to improve
// compression ratios). Appearently there are image which are uncompressed but still
// have a prediction scheme set. Hence we must check for it.
case Predictor of
PREDICTION_HORZ_DIFFERENCING: // currently only one prediction scheme is defined
case FImageProperties.SamplesPerPixel of
4: Deprediction:=Depredict4;
3: Deprediction:=Depredict3;
else Deprediction:=Depredict1;
end;
end;
end;
// create decompressor for the image
CASE FImageProperties.Compression of
ctNone: ;
ctLZW: begin
{$IFDEF NOCLASSES} new( TIFFLZWDecoder, Create );
Decoder := TIFFLZWDecoder;
{$ELSE} Decoder:=TTIFFLZWDecoder.Create; {$ENDIF}
end;
ctPackedBits: begin
{$IFDEF NOCLASSES} new( PackBitsRLEDecoder, Create );
Decoder := PackBitsRLEDecoder;
{$ELSE} Decoder:=TPackbitsRLEDecoder.Create; {$ENDIF}
end;
ctFaxRLE,
ctFaxRLEW: begin
{$IFDEF NOCLASSES}
new( CCITTMHDecoder, Create(GetValue(TIFFTAG_GROUP3OPTIONS),
ioReversed in Options,Compression=ctFaxRLEW,Width) );
Decoder := CCITTMHDecoder;
{$ELSE} Decoder:=
TCCITTMHDecoder.Create(GetValue(TIFFTAG_GROUP3OPTIONS),
ioReversed in Options,Compression=ctFaxRLEW,Width);
{$ENDIF}
end;
ctFax3: begin
{$IFDEF NOCLASSES}
new( CCITTFax3Decoder, Create(GetValue(TIFFTAG_GROUP3OPTIONS),ioReversed in Options,False,
Width) ); Decoder := CCITTFax3Decoder;
{$ELSE}
Decoder:=TCCITTFax3Decoder.Create(
GetValue(TIFFTAG_GROUP3OPTIONS),ioReversed in Options,False,
Width);
{$ENDIF}
end;
ctFax4: begin
{$IFDEF NOCLASSES}
new( CCITTFax4Decoder, Create(GetValue(TIFFTAG_GROUP4OPTIONS),ioReversed in Options,False,
Width) ); Decoder := CCITTFax4Decoder;
{$ELSE}
Decoder:=TCCITTFax4Decoder.Create(
GetValue(TIFFTAG_GROUP4OPTIONS),ioReversed in Options,False,
Width);
{$ENDIF}
end;
ctThunderscan: begin
{$IFDEF NOCLASSES}
new( LZ77Decoder, Create(Z_PARTIAL_FLUSH,True) );
Decoder := LZ77Decoder;
{$ELSE}
Decoder:=TThunderDecoder.Create(Width);
{$ENDIF}
end;
ctLZ77: begin
{$IFDEF NOCLASSES}
new( LZ77Decoder, Create(Z_PARTIAL_FLUSH,True) );
Decoder := LZ77Decoder;
{$ELSE}
Decoder:=TLZ77Decoder.Create(Z_PARTIAL_FLUSH,True);
{$ENDIF}
end;
else
{
COMPRESSION_OJPEG,
COMPRESSION_CCITTFAX4
COMPRESSION_NEXT
COMPRESSION_IT8CTPAD
COMPRESSION_IT8LW
COMPRESSION_IT8MP
COMPRESSION_IT8BL
COMPRESSION_PIXARFILM
COMPRESSION_PIXARLOG
COMPRESSION_DCS
COMPRESSION_JBIG}
GraphicExError(5{gesUnsupportedFeature},[ErrorMsg[11]{gesCompressionScheme},'compression',TIF]);
end;
if Assigned(Decoder) then Decoder.DecodeInit;
// go for each strip in the image (which might contain more than one line)
FImageProperties.CurrentRow:=0;
FImageProperties.CurrentStrip:=0;
StripCount:=Length(Offsets);
while FImageProperties.CurrentStrip<FImageProperties.StripCount do
begin
Stream.Position:=FBasePosition+Offsets[CurrentStrip];
if CurrentStrip<Length(RowsPerStrip) then
StripSize:=FImageProperties.BytesPerLine*RowsPerStrip[FImageProperties.CurrentStrip]
else
StripSize:=FImageProperties.BytesPerLine*RowsPerStrip[High(RowsPerStrip)];
GetMem(Buffer,StripSize+{!reserve}100);
Run:=Buffer;
try
// decompress strip if necessary
if Assigned(Decoder) then
begin
GetMem(EncodedData,ByteCounts[FImageProperties.CurrentStrip]{reserve!}+100);
try
DataPointerCopy:=EncodedData;
Stream.Read(EncodedData^,ByteCounts[CurrentStrip]);
// need pointer copies here because they could get modified
// while decoding
Decoder.Decode(DataPointerCopy,Pointer(Run),ByteCounts[CurrentStrip],StripSize);
finally
if Assigned(EncodedData) then FreeMem(EncodedData);
end;
end
else
begin
Stream.Read(Buffer^,StripSize);
end;
Run:=Buffer;
// go for each line (row) in the strip
while (FImageProperties.CurrentRow<FImageProperties.Height) and
(Run-Buffer<Integer(StripSize)) do
begin
Pixels:=FBitmap.ScanLine[FImageProperties.CurrentRow];
// depredict strip if necessary
if Assigned(Deprediction) then Deprediction(Run,Width-1);
// any color conversion comes last
ColorManager.ConvertRow([Run],Pixels,FImageProperties.Width,$FF);
Inc(PChar(Run),BytesPerLine);
Inc(CurrentRow);
end;
finally
if Assigned(Buffer) then FreeMem(Buffer);
end;
Inc(CurrentStrip);
end;
finally
if Assigned(Decoder) then Decoder.DecodeEnd;
Decoder.Free;
end;
end
else GraphicExError(1{gesInvalidImage},[TIF]);
end;
//----------------------------------------------------------------------------------------------------------------------
const
PhotometricToColorScheme: array[PHOTOMETRIC_MINISWHITE..PHOTOMETRIC_CIELAB] of TColorScheme = (
csG,csG,csRGBA,csIndexed,csUnknown,csCMYK,csYCbCr,csUnknown,csCIELab);
function TTIFFGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
// Reads all relevant TIF properties of the image of index ImageIndex (zero based).
// Returns True if the image ImageIndex could be read, otherwise False.
var IFDCount: word;
ExtraSamples,LocalBitsPerSample: TCardinalArray;
PhotometricInterpretation: byte;
TIFCompression: word;
Index,IFDOffset: cardinal;
Header: TTIFFHeader;
begin
// clear image properties
Result:=inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
// rewind stream to header position
Stream.Position:=FBasePosition;
Stream.Read(Header,sizeof(Header));
if Header.ByteOrder=TIFF_BIGENDIAN then
begin
Options:=Options+[ioBigEndian];
Header.Version:=System.Swap(Header.Version);
Header.FirstIFD:=SwapLong(Header.FirstIFD);
end;
FImageProperties.Version:=Header.Version;
FirstIFD:=Header.FirstIFD;
if FImageProperties.Version=TIFF_VERSION then
begin
IFDOffset:=Header.FirstIFD;
// advance to next IFD until we have the desired one
repeat
Stream.Position:=FBasePosition+IFDOffset;
// number of entries in this directory
Stream.Read(IFDCount,sizeof(IFDCount));
if Header.ByteOrder=TIFF_BIGENDIAN then IFDCount:=System.Swap(IFDCount);
// if we already have the desired image then get out of here
if ImageIndex=0 then Break;
Dec(ImageIndex);
// advance to offset for next IFD
Stream.Seek(IFDCount*sizeof(TIFDEntry),spCurrent);
Stream.Read(IFDOffset,sizeof(IFDOffset));
// no further image available, but the required index is still not found
if IFDOffset=0 then Exit;
until False;
SetLength(FIFD,IFDCount);
Stream.Read(FIFD[0],IFDCount*sizeof(TIFDEntry));
if Header.ByteOrder=TIFF_BIGENDIAN then
SwapIFD;
SortIFD;
Width:=GetValue(TIFFTAG_IMAGEWIDTH);
Height:=GetValue(TIFFTAG_IMAGELENGTH);
if (Width=0) or (Height=0) then Exit;
// data organization
GetValueList(Stream,TIFFTAG_ROWSPERSTRIP,RowsPerStrip);
// some images rely on the default size ($FFFFFFFF) if only one stripe is in the image,
// make sure there's a valid value also in this case
if (Length(RowsPerStrip)=0) or (RowsPerStrip[0]=$FFFFFFFF) then
begin
SetLength(RowsPerStrip,1);
RowsPerStrip[0]:=Height;
end;
// number of color components per pixel (1 for b&w, 16 and 256 colors, 3 for RGB, 4 for CMYK etc.)
SamplesPerPixel:=GetValue(TIFFTAG_SAMPLESPERPIXEL,1);
// number of bits per color component
GetValueList(Stream,TIFFTAG_BITSPERSAMPLE,LocalBitsPerSample);
if Length(LocalBitsPerSample)=0 then BitsPerSample:=1 else BitsPerSample:=LocalBitsPerSample[0];
// determine whether image is tiled and retrive tile data if necessary
TileWidth:=GetValue(TIFFTAG_TILEWIDTH,0);
TileLength:=GetValue(TIFFTAG_TILELENGTH,0);
if (TileWidth>0) and (TileLength>0) then Include(Options,ioTiled);
// photometric interpretation determines the color space
PhotometricInterpretation:=GetValue(TIFFTAG_PHOTOMETRIC);
// type of extra information for additional samples per pixel
GetValueList(Stream,TIFFTAG_EXTRASAMPLES,ExtraSamples);
// determine whether extra samples must be considered
HasAlpha:=Length(ExtraSamples)>0;
// if any of the extra sample contains an invalid value then consider
// it as being not existant to avoid wrong interpretation for badly
// written images
if HasAlpha then
begin
for Index:=0 to High(ExtraSamples) do
if ExtraSamples[Index]>EXTRASAMPLE_UNASSALPHA then
begin
HasAlpha:=False;
Break;
end;
end;
// currently all bits per sample values are equal
BitsPerPixel:=BitsPerSample*SamplesPerPixel;
// create decompressor for the image
TIFCompression:=GetValue(TIFFTAG_COMPRESSION);
case TIFCompression of
COMPRESSION_NONE: Compression:=ctNone;
COMPRESSION_LZW: Compression:=ctLZW;
COMPRESSION_PACKBITS: Compression:=ctPackedBits;
COMPRESSION_CCITTRLE: Compression:=ctFaxRLE;
COMPRESSION_CCITTRLEW: Compression:=ctFaxRLEW;
COMPRESSION_CCITTFAX3: Compression:=ctFax3;
COMPRESSION_OJPEG: Compression:=ctOJPEG;
COMPRESSION_JPEG: Compression:=ctJPEG;
COMPRESSION_CCITTFAX4: Compression:=ctFax4;
COMPRESSION_NEXT: Compression:=ctNext;
COMPRESSION_THUNDERSCAN: Compression:=ctThunderscan;
COMPRESSION_IT8CTPAD: Compression:=ctIT8CTPAD;
COMPRESSION_IT8LW: Compression:=ctIT8LW;
COMPRESSION_IT8MP: Compression:=ctIT8MP;
COMPRESSION_IT8BL: Compression:=ctIT8BL;
COMPRESSION_PIXARFILM: Compression:=ctPixarFilm;
COMPRESSION_PIXARLOG: Compression:=ctPixarLog; // also a LZ77 clone
COMPRESSION_ADOBE_DEFLATE,
COMPRESSION_DEFLATE: Compression:=ctLZ77;
COMPRESSION_DCS: Compression:=ctDCS;
COMPRESSION_JBIG: Compression:=ctJBIG;
else Compression:=ctUnknown;
end;
if PhotometricInterpretation in [PHOTOMETRIC_MINISWHITE..PHOTOMETRIC_CIELAB] then
begin
ColorScheme:=PhotometricToColorScheme[PhotometricInterpretation];
if (PhotometricInterpretation=PHOTOMETRIC_RGB) and (SamplesPerPixel<4) then ColorScheme:=csRGB;
if PhotometricInterpretation=PHOTOMETRIC_MINISWHITE then Include(Options,ioMinIsWhite);
// extra work necessary for YCbCr
if PhotometricInterpretation=PHOTOMETRIC_YCBCR then
begin
if FindTag(TIFFTAG_YCBCRSUBSAMPLING,Index) then GetValueList(Stream,TIFFTAG_YCBCRSUBSAMPLING,YCbCrSubSampling) else
begin
// initialize default values if nothing is given in the file
SetLength(YCbCrSubSampling,2);
YCbCrSubSampling[0]:=2;
YCbCrSubSampling[1]:=2;
end;
if FindTag(TIFFTAG_YCBCRPOSITIONING,Index) then FYCbCrPositioning:=GetValue(TIFFTAG_YCBCRPOSITIONING) else FYCbCrPositioning:=YCBCRPOSITION_CENTERED;
if FindTag(TIFFTAG_YCBCRCOEFFICIENTS,Index) then GetValueList(Stream,TIFFTAG_YCBCRCOEFFICIENTS,FYCbCrCoefficients) else
begin
// defaults are from CCIR recommendation 601-1
SetLength(FYCbCrCoefficients,3);
FYCbCrCoefficients[0]:=0.299;
FYCbCrCoefficients[1]:=0.587;
FYCbCrCoefficients[2]:=0.114;
end;
end;
end
else ColorScheme:=csUnknown;
JPEGColorMode:=GetValue(TIFFTAG_JPEGCOLORMODE,JPEGCOLORMODE_RAW);
JPEGTablesMode:=GetValue(TIFFTAG_JPEGTABLESMODE,JPEGTABLESMODE_QUANT or JPEGTABLESMODE_HUFF);
PlanarConfig:=GetValue(TIFFTAG_PLANARCONFIG);
// other image properties
XResolution:=GetValue(Stream,TIFFTAG_XRESOLUTION);
YResolution:=GetValue(Stream,TIFFTAG_YRESOLUTION);
if GetValue(TIFFTAG_RESOLUTIONUNIT,RESUNIT_INCH)=RESUNIT_CENTIMETER then
begin
// Resolution is given in centimeters.
// Although I personally prefer the metric system over the old english one :-)
// I still convert to inches because it is an unwritten rule to give image resolutions in dpi.
XResolution:=XResolution*2.54;
YResolution:=YResolution*2.54;
end;
// determine prediction scheme
Predictor:=GetValue(TIFFTAG_PREDICTOR);
// determine fill order in bytes
if GetValue(TIFFTAG_FILLORDER,FILLORDER_MSB2LSB)=FILLORDER_LSB2MSB then Include(Options,ioReversed);
// finally show that we found and read an image
Result:=True;
end;
end;
end;
//----------------- TEPSGraphic ----------------------------------------------------------------------------------------
// Note: This EPS implementation does only read embedded pixel graphics in TIF format (preview).
// Credits to:
// Olaf Stieleke
// Torsten Pohlmeyer
// CPS Krohn GmbH
// for providing the base information about how to read the preview image.
type
TEPSHeader = packed record
Code: cardinal; // alway $C6D3D0C5, if not there then this is not an EPS or it is not a binary EPS
PSStart, // Offset PostScript-Code
PSLen, // length of PostScript-Code
MetaPos, // position of a WMF
MetaLen, // length of a WMF
TiffPos, // position of TIFF (preview images should be either WMF or TIF but not both)
TiffLen: integer; // length of the TIFF
Checksum: smallint;
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TEPSGraphic.CanLoad(Stream: PStream): boolean;
var Header: TEPSHeader;
LastPosition: cardinal;
begin
Result:=(Stream.Size-Stream.Position)>sizeof(Header);
if Result then
begin
LastPosition:=Stream.Position;
Stream.Read(Header,sizeof(Header));
Result:=(Header.Code=$C6D3D0C5) and (Header.TiffPos>Integer(LastPosition)+sizeof(Header)) and (Header.TiffLen>0);
Stream.Position:=LastPosition;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TEPSGraphic.LoadFromStream(Stream: PStream);
var Header: TEPSHeader;
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
Stream.Read(Header,sizeof(Header));
if Header.Code<>$C6D3D0C5 then GraphicExError(1{gesInvalidImage},['EPS']);
Stream.Seek(Header.TIFFPos-sizeof(Header),spCurrent);
inherited;
end;
//----------------------------------------------------------------------------------------------------------------------
function TEPSGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
begin
Result:=inherited ReadImageProperties(Stream,ImageIndex);
end;
//----------------- TTGAGraphic --------------------------------------------------------------------------------------
// FILE STRUCTURE FOR THE ORIGINAL TRUEVISION TGA FILE
// FIELD 1: NUMBER OF CHARACTERS IN ID FIELD (1 BYTES)
// FIELD 2: COLOR MAP TYPE (1 BYTES)
// FIELD 3: IMAGE TYPE CODE (1 BYTES)
// = 0 NO IMAGE DATA INCLUDED
// = 1 UNCOMPRESSED, COLOR-MAPPED IMAGE
// = 2 UNCOMPRESSED, TRUE-COLOR IMAGE
// = 3 UNCOMPRESSED, BLACK AND WHITE IMAGE (black and white is actually grayscale)
// = 9 RUN-LENGTH ENCODED COLOR-MAPPED IMAGE
// = 10 RUN-LENGTH ENCODED TRUE-COLOR IMAGE
// = 11 RUN-LENGTH ENCODED BLACK AND WHITE IMAGE
// FIELD 4: COLOR MAP SPECIFICATION (5 BYTES)
// 4.1: COLOR MAP ORIGIN (2 BYTES)
// 4.2: COLOR MAP LENGTH (2 BYTES)
// 4.3: COLOR MAP ENTRY SIZE (1 BYTES)
// FIELD 5:IMAGE SPECIFICATION (10 BYTES)
// 5.1: X-ORIGIN OF IMAGE (2 BYTES)
// 5.2: Y-ORIGIN OF IMAGE (2 BYTES)
// 5.3: WIDTH OF IMAGE (2 BYTES)
// 5.4: HEIGHT OF IMAGE (2 BYTES)
// 5.5: IMAGE PIXEL SIZE (1 BYTE)
// 5.6: IMAGE DESCRIPTOR BYTE (1 BYTE)
// bit 0..3: attribute bits per pixel
// bit 4..5: image orientation:
// 0: bottom left
// 1: bottom right
// 2: top left
// 3: top right
// bit 6..7: interleaved flag
// 0: two way (even-odd) interleave (e.g. IBM Graphics Card Adapter), obsolete
// 1: four way interleave (e.g. AT&T 6300 High Resolution), obsolete
// FIELD 6: IMAGE ID FIELD (LENGTH SPECIFIED BY FIELD 1)
// FIELD 7: COLOR MAP DATA (BIT WIDTH SPECIFIED BY FIELD 4.3 AND
// NUMBER OF COLOR MAP ENTRIES SPECIFIED IN FIELD 4.2)
// FIELD 8: IMAGE DATA FIELD (WIDTH AND HEIGHT SPECIFIED IN FIELD 5.3 AND 5.4)
const
TARGA_NO_COLORMAP = 0;
TARGA_COLORMAP = 1;
TARGA_EMPTY_IMAGE = 0;
TARGA_INDEXED_IMAGE = 1;
TARGA_TRUECOLOR_IMAGE = 2;
TARGA_BW_IMAGE = 3;
TARGA_INDEXED_RLE_IMAGE = 9;
TARGA_TRUECOLOR_RLE_IMAGE = 10;
TARGA_BW_RLE_IMAGE = 11;
type
TTargaHeader = packed record
IDLength,
ColorMapType,
ImageType: Byte;
ColorMapOrigin,
ColorMapSize: Word;
ColorMapEntrySize: Byte;
XOrigin,
YOrigin,
Width,
Height: Word;
PixelSize: Byte;
ImageDescriptor: Byte;
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TTGAGraphic.CanLoad(Stream: PStream): boolean;
var Header: TTargaHeader;
LastPosition: cardinal;
begin
LastPosition:=Stream.Position;
Result:=(Stream.Size-Stream.Position)>sizeof(Header);
if Result then
begin
Stream.Read(Header,sizeof(Header));
// Targa images are hard to determine because there is no magic id or something like that.
// Hence all we can do is to check if all values from the header are within correct limits.
Result:=(Header.ImageType in [TARGA_EMPTY_IMAGE,TARGA_INDEXED_IMAGE,TARGA_TRUECOLOR_IMAGE,TARGA_BW_IMAGE,
TARGA_INDEXED_RLE_IMAGE,TARGA_TRUECOLOR_RLE_IMAGE,TARGA_BW_RLE_IMAGE]) and
(Header.ColorMapType in [TARGA_NO_COLORMAP,TARGA_COLORMAP]) and
(Header.ColorMapEntrySize in [15,16,24,32]) and
(Header.PixelSize in [8,15,16,24,32]);
end;
Stream.Position:=LastPosition;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TTGAGraphic.LoadFromStream(Stream: PStream);
var Run,RLEBuffer: PChar;
I,LineSize: Integer;
LineBuffer: Pointer;
ReadLength: Integer;
Color16: Word;
Header: TTargaHeader;
FlipV: Boolean;
{$IFDEF NOCLASSES} Decoder: PTargaRLEDecoder;
//{$ELSE} Decoder: PTargaRLEDecoder;
{$ELSE} Decoder: TTargaRLEDecoder;
{$ENDIF}
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
if ReadImageProperties(Stream,0) then
with FImageProperties do
begin
Stream.Position:=FBasePosition;
Stream.Read(Header,sizeof(Header));
FlipV:=(Header.ImageDescriptor and $20)<>0;
Header.ImageDescriptor:=Header.ImageDescriptor and $F;
// skip image ID
Stream.Seek(Header.IDLength,spCurrent);
ColorManager.SourceSamplesPerPixel:=SamplesPerPixel;
ColorManager.TargetSamplesPerPixel:=SamplesPerPixel;
ColorManager.SourceColorScheme:=ColorScheme;
ColorManager.SourceOptions:=[];
ColorManager.TargetColorScheme:=csBGR;
ColorManager.SourceBitsPerSample:=BitsPerSample;
ColorManager.TargetBitsPerSample:=BitsPerSample;
FBitmap:=NewBitmap(Header.Width,Header.Height);
FBitmap.PixelFormat:=ColorManager.TargetPixelFormat;
if (Header.ColorMapType=TARGA_COLORMAP) or (Header.ImageType in [TARGA_BW_IMAGE,TARGA_BW_RLE_IMAGE]) then
begin
if Header.ImageType in [TARGA_BW_IMAGE,TARGA_BW_RLE_IMAGE] then ColorManager.CreateGrayscalePalette(FBitmap,False) else
begin
LineSize:=(Header.ColorMapEntrySize div 8)*Header.ColorMapSize;
GetMem(LineBuffer,LineSize);
try
Stream.Read(LineBuffer^,LineSize);
case Header.ColorMapEntrySize of
32: ColorManager.CreateColorPalette(FBitmap,[LineBuffer],pfInterlaced8Quad,Header.ColorMapSize,False);
24: ColorManager.CreateColorPalette(FBitmap,[LineBuffer],pfInterlaced8Triple,Header.ColorMapSize,False);
else
begin
// 15 and 16 bits per color map entry (handle both like 555 color format
// but make 8 bit from 5 bit per color component)
for I:=0 to pred(Header.ColorMapSize) do
begin
Stream.Read(Color16,2);
FBitmap.DIBPalEntries[I]:=Windows.RGB((Color16 and $7C00) shr 7,(Color16 and $3E0) shr 2,(Color16 and $1F) shl 3);
end;
end;
end;
finally
if Assigned(LineBuffer) then FreeMem(LineBuffer);
end;
end;
end;
LineSize:=Width*(Header.PixelSize div 8);
case Header.ImageType of
TARGA_EMPTY_IMAGE: ; // nothing to do here
TARGA_BW_IMAGE,
TARGA_INDEXED_IMAGE,
TARGA_TRUECOLOR_IMAGE:
begin
for I:=0 to pred(FBitmap.Height) do
begin
if FlipV then LineBuffer:=FBitmap.ScanLine[I] else LineBuffer:=FBitmap.ScanLine[Header.Height-(I+1)];
Stream.Read(LineBuffer^,LineSize);
end;
end;
TARGA_BW_RLE_IMAGE,
TARGA_INDEXED_RLE_IMAGE,
TARGA_TRUECOLOR_RLE_IMAGE:
begin
RLEBuffer:=nil;
{$IFDEF NOCLASSES}
new( Decoder, Create(Header.PixelSize) );
{$ELSE} Decoder:=TTargaRLEDecoder.Create(Header.PixelSize); {$ENDIF}
try
GetMem(RLEBuffer,2*LineSize);
for I:=0 to pred(FBitmap.Height) do
begin
if FlipV then LineBuffer:=FBitmap.ScanLine[I] else LineBuffer:=FBitmap.ScanLine[Header.Height-(I+1)];
ReadLength:=Stream.Read(RLEBuffer^,2*LineSize);
Run:=RLEBuffer;
Decoder.Decode(Pointer(Run),LineBuffer,2*LineSize,FBitmap.Width);
Stream.Position:=Stream.Position-DWORD(ReadLength)+DWORD(Run-RLEBuffer);
end;
finally
if Assigned(RLEBuffer) then FreeMem(RLEBuffer);
Decoder.Free;
end;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TTGAGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Header: TTargaHeader;
begin
inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
Stream.Read(Header,sizeof(Header));
Header.ImageDescriptor:=Header.ImageDescriptor and $F;
Width:=Header.Width;
Height:=Header.Height;
BitsPerSample:=8;
case Header.PixelSize of
8: begin
if Header.ImageType in [TARGA_BW_IMAGE,TARGA_BW_RLE_IMAGE] then ColorScheme:=csG else ColorScheme:=csIndexed;
SamplesPerPixel:=1;
end;
15,
16: // actually, 16 bit are meant being 15 bit
begin
ColorScheme:=csRGB;
BitsPerSample:=5;
SamplesPerPixel:=3;
end;
24: begin
ColorScheme:=csRGB;
SamplesPerPixel:=3;
end;
32: begin
ColorScheme:=csRGBA;
SamplesPerPixel:=4;
end;
end;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
if Header.ImageType in [TARGA_BW_RLE_IMAGE,TARGA_INDEXED_RLE_IMAGE,TARGA_TRUECOLOR_RLE_IMAGE] then Compression:=ctRLE else Compression:=ctNone;
Width:=Header.Width;
Height:=Header.Height;
Result:=True;
end;
end;
//----------------- TPCXGraphic ----------------------------------------------------------------------------------------
type
TPCXHeader = packed record
FileID: Byte; // $0A for PCX files, $CD for SCR files
Version: Byte; // 0: version 2.5; 2: 2.8 with palette; 3: 2.8 w/o palette; 5: version 3
Encoding: Byte; // 0: uncompressed; 1: RLE encoded
BitsPerPixel: Byte;
XMin,
YMin,
XMax,
YMax, // coordinates of the corners of the image
HRes, // horizontal resolution in dpi
VRes: Word; // vertical resolution in dpi
ColorMap: array[0..15] of TRGB; // color table
Reserved,
ColorPlanes: Byte; // color planes (at most 4)
BytesPerLine, // number of bytes of one line of one plane
PaletteType: Word; // 1: color or b&w; 2: gray scale
Fill: array[0..57] of Byte;
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TPCXGraphic.CanLoad(Stream: PStream): boolean;
var Header: TPCXHeader;
LastPosition: cardinal;
begin
LastPosition:=Stream.Position;
Result:=(Stream.Size-Stream.Position)>sizeof(Header);
if Result then
begin
Stream.Read(Header,sizeof(Header));
Result:=(Header.FileID in [$0A,$0C]) and (Header.Version in [0,2,3,5])
and (Header.Encoding in [0,1]);
end;
Stream.Position:=LastPosition;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPCXGraphic.LoadFromStream(Stream: PStream);
var Header: TPCXHeader;
//--------------- local functions -------------------------------------------
procedure MakePalette;
const
Pal16: array[0..15] of TColor =
(clBlack,clMaroon,clGreen,clOlive,clNavy,clPurple,clTeal,clDkGray,
clLtGray,clRed,clLime,clYellow,clBlue,clFuchsia,clAqua,clWhite);
var PCXPalette: array[0..255] of TRGB;
I,OldPos: integer;
Marker: byte;
begin
if (Header.Version<>3) or (FBitmap.PixelFormat=pf1Bit) then
begin
case FBitmap.PixelFormat of
pf1Bit: ColorManager.CreateGrayScalePalette(FBitmap,False);
pf4Bit:
with Header do
begin
if PaletteType=2 then ColorManager.CreateGrayScalePalette(FBitmap,False) else ColorManager.CreateColorPalette(FBitmap,[@ColorMap],pfInterlaced8Triple,16,False);
end;
pf8Bit:
begin
OldPos:=Stream.Position;
// 256 colors with 3 components plus one marker byte
Stream.Position:=Stream.Size-769;
for I := 1 to 768 do // ���� ������� � ���� ����� ���, ������ �������
begin // ����� ��� ���� ������...
Stream.Position := Stream.Position - 2;
Stream.Read(Marker,1);
if Marker = $0C then break;
end;
if Marker <> $0C then
begin // ��� ��� ��������� ������� ������� �� ������� ����� - �������
// ����� �����������
Stream.Position := OldPos + Integer( FImageProperties.BytesPerLine ) * Height;
Stream.Read(Marker, 1);
end;
if Marker<>$0C then
begin
// palette ID is wrong, perhaps gray scale?
if Header.PaletteType=2 then ColorManager.CreateGrayScalePalette(FBitmap,False) else ; // ignore palette
end
else
begin
Stream.Read(PCXPalette[0],768);
ColorManager.CreateColorPalette(FBitmap,[@PCXPalette],pfInterlaced8Triple,256,True);
end;
Stream.Position:=OldPos;
end;
end;
end
else
begin
// version 2.8 without palette information, just use the system palette
// 256 colors will not be correct with this assignment...
for I:=0 to 15 do FBitmap.DIBPalEntries[I]:=Pal16[I];
end;
end;
//--------------- end local functions ---------------------------------------
var PCXSize,Size: cardinal;
RawBuffer,DecodeBuffer: pointer;
Run,Plane1,Plane2,Plane3,Plane4: PByte;
Value,Mask: byte;
I,J: integer;
Line: PByte;
Increment: cardinal;
NewPixelFormat: TPixelFormat;
{$IFDEF NOCLASSES} Decoder: PPcxRLEDecoder; {$ELSE} Decoder: TPCXRLEDecoder; {$ENDIF}
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
if ReadImageProperties(Stream,0) then
begin
Stream.Position:=FBasePosition;
Stream.Read(Header,sizeof(Header));
PCXSize:=Stream.Size-Stream.Position;
with Header,FImageProperties do
begin
if not (FileID in [$0A,$CD]) then GraphicExError(1{gesInvalidImage},['PCX or SCR']);
ColorManager.SourceColorScheme:=ColorScheme;
ColorManager.SourceBitsPerSample:=BitsPerSample;
ColorManager.SourceSamplesPerPixel:=SamplesPerPixel;
if ColorScheme=csIndexed then ColorManager.TargetColorScheme:=csIndexed else ColorManager.TargetColorScheme:=csBGR;
if BitsPerPixel=2 then ColorManager.TargetBitsPerSample:=4 else ColorManager.TargetBitsPerSample:=BitsPerSample;
// Note: pixel depths of 2 and 4 bits may not be used with more than one plane
// otherwise the image will not show up correctly
ColorManager.TargetSamplesPerPixel:=SamplesPerPixel;
NewPixelFormat:=ColorManager.TargetPixelFormat;
if NewPixelFormat=pfCustom then
begin
// there can be a special case comprising 4 planes each with 1 bit
if (SamplesPerPixel=4) and (BitsPerPixel=4) then NewPixelFormat:=pf4Bit else GraphicExError(2{gesInvalidColorFormat},['PCX']);
end;
FBitmap:=NewBitmap(Width,Height);
FBitmap.PixelFormat:=NewPixelFormat;
// 256 colors palette is appended to the actual PCX data
if FBitmap.PixelFormat=pf8Bit then Dec(PCXSize,769);
if FBitmap.PixelFormat<>pf24Bit then MakePalette;
// adjust alignment of line
Increment:=SamplesPerPixel*Header.BytesPerLine;
// allocate pixel data buffer and decode data if necessary
if Compression=ctRLE then
begin
Size:=Increment*Height;
GetMem(DecodeBuffer,Size);
GetMem(RawBuffer,PCXSize);
try
Stream.Read(RawBuffer^,PCXSize);
{$IFDEF NOCLASSES} new( Decoder, Create );
{$ELSE} Decoder := TPCXRLEDecoder.Create; {$ENDIF}
with Decoder {$IFDEF NOCLASSES}^{$ENDIF} do
try
Decode(RawBuffer,DecodeBuffer,PCXSize,Size);
finally
Free;
end;
finally
if Assigned(RawBuffer) then FreeMem(RawBuffer);
end;
end
else
begin
GetMem(DecodeBuffer,PCXSize);
Stream.Read(DecodeBuffer^,PCXSize);
end;
try
Run:=DecodeBuffer;
if (SamplesPerPixel=4) and (BitsPerPixel=4) then
begin
// 4 planes with one bit
for I:=0 to pred(Height) do
begin
Plane1:=Run;
PChar(Plane2):=PChar(Run)+Increment div 4;
PChar(Plane3):=PChar(Run)+2*(Increment div 4);
PChar(Plane4):=PChar(Run)+3*(Increment div 4);
Line:=FBitmap.ScanLine[I];
// number of bytes to write
Size:=(FBitmap.Width*BitsPerPixel+7) div 8;
Mask:=0;
while Size>0 do
begin
Value:=0;
for J:=0 to 1 do
asm
MOV AL,[Value]
MOV EDX,[Plane4] // take the 4 MSBs from the 4 runs and build a nibble
SHL BYTE PTR [EDX],1 // read MSB and prepare next run at the same time
RCL AL,1 // MSB from previous shift is in CF -> move it to AL
MOV EDX,[Plane3] // now do the same with the other three runs
SHL BYTE PTR [EDX],1
RCL AL,1
MOV EDX,[Plane2]
SHL BYTE PTR [EDX],1
RCL AL,1
MOV EDX,[Plane1]
SHL BYTE PTR [EDX],1
RCL AL,1
MOV [Value],AL
end;
Line^:=Value;
Inc(Line);
Dec(Size);
// two runs above (to construct two nibbles -> one byte), now update marker
// to know when to switch to next byte in the planes
Mask:=(Mask+2) mod 8;
if Mask=0 then
begin
Inc(Plane1);
Inc(Plane2);
Inc(Plane3);
Inc(Plane4);
end;
end;
Inc(Run,Increment);
end;
end
else
if FBitmap.PixelFormat=pf24Bit then
begin
// true color
for I:=0 to pred(FBitmap.Height) do
begin
Line:=FBitmap.ScanLine[I];
Plane1:=Run;
PChar(Plane2):=PChar(Run)+Increment div 3;
PChar(Plane3):=PChar(Run)+2*(Increment div 3);
ColorManager.ConvertRow([Plane1,Plane2,Plane3],Line,FBitmap.Width,$FF);
Inc(Run,Increment);
end
end
else
begin
// other indexed formats
for I:=0 to pred(FBitmap.Height) do
begin
Line:=FBitmap.ScanLine[I];
ColorManager.ConvertRow([Run],Line,FBitmap.Width,$FF);
Inc(Run,Increment);
end;
end;
finally
if Assigned(DecodeBuffer) then FreeMem(DecodeBuffer);
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPCXGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Header: TPCXHeader;
begin
Result:=inherited ReadImageProperties(Stream,0);
Stream.Read(Header,sizeof(Header));
with FImageProperties do
begin
if Header.FileID in [$0A,$CD] then
begin
Width:=Header.XMax-Header.XMin+1;
Height:=Header.YMax-Header.YMin+1;
SamplesPerPixel:=Header.ColorPlanes;
BitsPerSample:=Header.BitsPerPixel;
BitsPerPixel:=BitsPerSample*SamplesPerPixel;
BytesPerLine := Header.BytesPerLine;
if BitsPerPixel<=8 then ColorScheme:=csIndexed else ColorScheme:=csRGB;
if Header.Encoding=1 then Compression:=ctRLE else Compression:=ctNone;
XResolution:=Header.HRes;
YResolution:=Header.VRes;
Result:=True;
end;
end;
end;
//----------------- TPCDGraphic ----------------------------------------------------------------------------------------
const
PCD_BEGIN_BASE16 = 8192;
PCD_BEGIN_BASE4 = 47104;
PCD_BEGIN_BASE = 196608;
PCD_BEGIN_ORIENTATION = 194635;
PCD_BEGIN = 2048;
PCD_MAGIC = 'PCD_IPI';
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TPCDGraphic.CanLoad(Stream: PStream): boolean;
var Header: array[0..$802] of byte;
LastPosition: cardinal;
begin
LastPosition:=Stream.Position;
Result:=(Stream.Size-Stream.Position)>3*$800;
if Result then
begin
Stream.Read(Header,Length(Header));
Result:=(StrLComp(@Header[0],'PCD_OPA',7)=0) or (StrLComp(@Header[$800],'PCD',3)=0);
end;
Stream.Position:=LastPosition;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPCDGraphic.LoadFromStream(Stream: PStream);
var C1,C2,YY: PChar;
YCbCrData: array[0..2] of PChar;
SourceDummy,DestDummy: pointer;
Offset,I,X,IX,Y,IY,ImageIndex,Rows,Columns: cardinal;
ScanLines: array of pointer;
LineBuffer: pointer;
Line,Run: PBGR;
{$IFDEF NOCLASSES} Decoder: PPCDDecoder; {$ELSE} Decoder: TPCDDecoder; {$ENDIF}
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
ImageIndex:=2; // third image is Base resolution
if ReadImageProperties(Stream,ImageIndex) then
begin
with FImageProperties do
begin
ScanLines:=nil;
LineBuffer:=nil;
Stream.Position:=FBasePosition;
Columns:=192 shl KOL.Min(ImageIndex,2);
Rows:=128 shl KOL.Min(ImageIndex,2);
Width:=192 shl ImageIndex;
Height:=128 shl ImageIndex;
// For the rotated mode where we need to turn the image by 90�. We can speed up loading
// the image by factor 2 by using a local copy of the Scanline pointers.
if Rotate in [1,3] then
begin
IX:=Height;
IY:=Width;
end
else
begin
IX:=Width;
IY:=Height;
end;
// since row and columns might be swapped because of rotated images
// we determine the final dimensions once more
FBitmap:=NewBitmap(IX,IY);
if Rotate in [1,3] then
begin
SetLength(ScanLines,IX);
for Y:=0 to pred(IY) do ScanLines[Y]:=FBitmap.ScanLine[Y];
GetMem(LineBuffer,3*IY);
end;
ZeroMemory(@YCbCrData,sizeof(YCbCrData));
try
GetMem(YCbCrData[0],FBitmap.Width*FBitmap.Height);
GetMem(YCbCrData[1],FBitmap.Width*FBitmap.Height);
GetMem(YCbCrData[2],FBitmap.Width*FBitmap.Height);
// advance to image data
Offset:=96;
if Overview then Offset:=5 else
if ImageIndex=1 then Offset:=23 else
if ImageIndex=0 then Offset:=4;
Stream.Seek(Offset*$800,spCurrent);
// color conversion setup
ColorManager.SourceColorScheme:=csPhotoYCC;
ColorManager.SourceBitsPerSample:=8;
ColorManager.SourceSamplesPerPixel:=3;
ColorManager.TargetColorScheme:=csBGR;
ColorManager.TargetBitsPerSample:=8;
ColorManager.TargetSamplesPerPixel:=3;
FBitmap.PixelFormat:=pf24Bit;
// PhotoYCC format uses CCIR Recommendation 709 coefficients and is subsampled
// by factor 2 vertically and horizontally
ColorManager.SetYCbCrParameters([0.2125,0.7154,0.0721],2,2);
if False then
begin
// if Overview then ... no info yet about overview image structure
end
else
begin
YY:=YCbCrData[0];
C1:=YCbCrData[1];
C2:=YCbCrData[2];
I:=0;
while I<Rows do
begin
Stream.Read(YY^,Columns);
Inc(YY,Width);
Stream.Read(YY^,Columns);
Inc(YY,Width);
Stream.Read(C1^,Columns shr 1);
Inc(C1,Width);
Stream.Read(C2^,Columns shr 1);
Inc(C2,Width);
Inc(I,2);
end;
// Y stands here for maximum number of upsample calls
// Y:=5;
if ImageIndex>=3 then
begin
// Inc(Y,3*(ImageIndex-3));
{$IFDEF NOCLASSES} new( Decoder, Create( Stream ) );
{$ELSE} Decoder:=TPCDDecoder.Create(Stream); {$ENDIF}
SourceDummy:=@YCbCrData;
DestDummy:=nil;
try
// recover luminance deltas for 1536 x 1024 image
Upsample(768,512,Width,YCbCrData[0]);
Upsample(384,256,Width,YCbCrData[1]);
Upsample(384,256,Width,YCbCrData[2]);
Stream.Seek(4*$800,spCurrent);
Decoder.Decode(SourceDummy,DestDummy,Width,1024);
if ImageIndex>=4 then
begin
// recover luminance deltas for 3072 x 2048 image
Upsample(1536,1024,FBitmap.Width,YCbCrData[0]);
Upsample(768,512,FBitmap.Width,YCbCrData[1]);
Upsample(768,512,FBitmap.Width,YCbCrData[2]);
Offset:=(Stream.Position-FBasePosition) div $800+12;
Stream.Seek(FBasePosition+Offset*$800,spBegin);
Decoder.Decode(SourceDummy,DestDummy,Width,2048);
if ImageIndex=5 then
begin
// recover luminance deltas for 6144 x 4096 image (vaporware)
Upsample(3072,2048,FBitmap.Width,YCbCrData[1]);
Upsample(1536,1024,FBitmap.Width,YCbCrData[1]);
Upsample(1536,1024,FBitmap.Width,YCbCrData[2]);
end;
end;
finally
Decoder.Free;
end;
end;
Upsample(FBitmap.Width shr 1,FBitmap.Height shr 1,FBitmap.Width,YCbCrData[1]);
Upsample(FBitmap.Width shr 1,FBitmap.Height shr 1,FBitmap.Width,YCbCrData[2]);
// transfer luminance and chrominance channels
YY:=YCbCrData[0];
C1:=YCbCrData[1];
C2:=YCbCrData[2];
try
case Rotate of
1: // rotate -90�
begin
for Y:=0 to pred(FBitmap.Height) do
begin
ColorManager.ConvertRow([YY,C1,C2],LineBuffer,FBitmap.Width,$FF);
Inc(YY,FBitmap.Width);
Inc(C1,FBitmap.Width);
Inc(C2,FBitmap.Width);
Run:=LineBuffer;
for X:=0 to pred(FBitmap.Width) do
begin
PChar(Line):=PChar(ScanLines[FBitmap.Width-Integer(X)-1])+Y*3;
Line^:=Run^;
Inc(Run);
end;
end;
end;
3: // rotate 90�
begin
for Y:=0 to pred(Height) do
begin
ColorManager.ConvertRow([YY,C1,C2],LineBuffer,FBitmap.Width,$FF);
Inc(YY,FBitmap.Width);
Inc(C1,FBitmap.Width);
Inc(C2,FBitmap.Width);
Run:=LineBuffer;
for X:=0 to pred(FBitmap.Width) do
begin
PChar(Line):=PChar(ScanLines[X])+(FBitmap.Height-Integer(Y)-1)*3;
Line^:=Run^;
Inc(Run);
end;
end;
end;
else
for Y:=0 to pred(Height) do
begin
ColorManager.ConvertRow([YY,C1,C2],FBitmap.ScanLine[Y],FBitmap.Width,$FF);
Inc(YY,FBitmap.Width);
Inc(C1,FBitmap.Width);
Inc(C2,FBitmap.Width);
end;
end;
finally
ScanLines:=nil;
if Assigned(LineBuffer) then FreeMem(LineBuffer);
end;
end;
finally
if Assigned(YCbCrData[2]) then FreeMem(YCbCrData[2]);
if Assigned(YCbCrData[1]) then FreeMem(YCbCrData[1]);
if Assigned(YCbCrData[0]) then FreeMem(YCbCrData[0]);
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPCDGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Header: array[0..$17FF] of byte;
Temp: cardinal;
begin
if ImageIndex>5 then ImageIndex:=5;
Result:=inherited ReadImageProperties(Stream,ImageIndex) and ((Stream.Size-FBasePosition)>3*$800);
with FImageProperties do
begin
Stream.Read(Header,Length(Header));
try
Overview:=StrLComp(@Header[0],'PCD_OPA',7)=0;
// determine if image is a PhotoCD image
if Overview or (StrLComp(@Header[$800],'PCD',3)=0) then
begin
Rotate:=Header[$0E02] and 3;
// image sizes are fixed, depending on the given image index
if Overview then ImageIndex:=0;
Width:=192 shl ImageIndex;
Height:=128 shl ImageIndex;
if (Rotate=1) or (Rotate=3) then
begin
Temp:=Width;
Width:=Height;
Height:=Temp;
end;
ColorScheme:=csPhotoYCC;
BitsPerSample:=8;
SamplesPerPixel:=3;
BitsPerPixel:=BitsPerSample*SamplesPerPixel;
if ImageIndex>2 then Compression:=ctPCDHuffmann else Compression:=ctNone;
ImageCount:=(Header[10] shl 8) or Header[11];
Result:=True;
end;
finally
end;
end;
end;
//----------------- TPPMGraphic ----------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TPPMGraphic.CanLoad(Stream: PStream): boolean;
var Buffer: array[0..9] of Char;
LastPosition: cardinal;
begin
LastPosition:=Stream.Position;
Result:=(Stream.Size-Stream.Position)>10;
if Result then
begin
Stream.Read(Buffer,sizeof(Buffer));
Result:=(Buffer[0]='P') and (Buffer[1] in ['1'..'6']);
end;
Stream.Position:=LastPosition;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPPMGraphic.CurrentChar: Char;
begin
if FIndex=sizeof(FBuffer) then Result:=#0 else Result:=FBuffer[FIndex];
end;
//----------------------------------------------------------------------------------------------------------------------
function TPPMGraphic.GetChar: Char;
// buffered I/O
begin
if FIndex=sizeof(FBuffer) then
begin
if FStream.Position=FStream.Size then GraphicExError(3{gesStreamReadError},['PPM']);
FIndex:=0;
FStream.Read(FBuffer,sizeof(FBuffer));
end;
Result:=FBuffer[FIndex];
Inc(FIndex);
end;
//----------------------------------------------------------------------------------------------------------------------
function TPPMGraphic.GetNumber: Cardinal;
// reads the next number from the stream (and skips all characters which are not in 0..9)
var Ch: Char;
begin
// skip all non-numbers
repeat
Ch:=GetChar;
// skip comments
if Ch='#' then
begin
ReadLine;
Ch:=GetChar;
end;
until Ch in ['0'..'9'];
// read the number characters and convert meanwhile
Result:=0;
repeat
Result:=10*Result+Ord(Ch)-$30;
Ch:=GetChar;
until not (Ch in ['0'..'9']);
end;
//----------------------------------------------------------------------------------------------------------------------
function TPPMGraphic.ReadLine: string;
// reads one text line from stream and skips comments
var Ch: Char;
I: integer;
begin
Result:='';
repeat
Ch:=GetChar;
if Ch in [#13,#10] then Break else Result:=Result+Ch;
until False;
// eat #13#10 combination
if (Ch=#13) and (CurrentChar=#10) then GetChar;
// delete comments
I:=Pos('#',Result);
if I>0 then Delete(Result,I,MaxInt);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPPMGraphic.LoadFromStream(Stream: PStream);
var Buffer: string;
Line24: PBGR;
Line8: PByte;
X,Y,W,H: integer;
Pixel: byte;
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
// copy reference for buffered access
FStream:=Stream;
if ReadImageProperties(Stream,0) then
begin
with FImageProperties do
begin
Stream.Position:=FBasePosition;
// set index pointer to end of buffer to cause reload
FIndex:=sizeof(FBuffer);
Buffer:=ReadLine;
case Str2Int(Buffer[2]) of
1: // PBM ASCII format (black & white)
begin
W:=GetNumber;
H:=GetNumber;
FBitmap:=NewBitmap(W,H);
FBitmap.PixelFormat:=pf1Bit;
ColorManager.TargetSamplesPerPixel:=1;
ColorManager.TargetBitsPerSample:=1;
ColorManager.CreateGrayScalePalette(FBitmap,True);
// read image data
for Y:=0 to pred(FBitmap.Height) do
begin
Line8:=FBitmap.ScanLine[Y];
Pixel:=0;
for X:=1 to FBitmap.Width do
begin
Pixel:=(Pixel shl 1) or (GetNumber and 1);
if (X mod 8)=0 then
begin
Line8^:=Pixel;
Inc(Line8);
Pixel:=0;
end;
end;
if (FBitmap.Width mod 8)<>0 then Line8^:=Pixel shl (8-(FBitmap.Width mod 8));
end;
end;
2: // PGM ASCII form (gray scale)
begin
W:=GetNumber;
H:=GetNumber;
FBitmap:=NewBitmap(W,H);
FBitmap.PixelFormat:=pf8Bit;
// skip maximum color value
GetNumber;
ColorManager.TargetSamplesPerPixel:=1;
ColorManager.TargetBitsPerSample:=8;
ColorManager.CreateGrayScalePalette(FBitmap,False);
// read image data
for Y:=0 to pred(FBitmap.Height) do
begin
Line8:=FBitmap.ScanLine[Y];
for X:=0 to pred(FBitmap.Width) do
begin
Line8^:=GetNumber;
Inc(Line8);
end;
end;
end;
3: // PPM ASCII form (true color)
begin
W:=GetNumber;
H:=GetNumber;
FBitmap:=NewBitmap(W,H);
FBitmap.PixelFormat:=pf24Bit;
// skip maximum color value
GetNumber;
for Y:=0 to pred(FBitmap.Height) do
begin
Line24:=FBitmap.ScanLine[Y];
for X:=0 to pred(FBitmap.Width) do
begin
Line24.R:=GetNumber;
Line24.G:=GetNumber;
Line24.B:=GetNumber;
Inc(Line24);
end;
end;
end;
4: // PBM binary format (black & white)
begin
W:=GetNumber;
H:=GetNumber;
FBitmap:=NewBitmap(W,H);
FBitmap.PixelFormat:=pf1Bit;
ColorManager.TargetSamplesPerPixel:=1;
ColorManager.TargetBitsPerSample:=1;
ColorManager.CreateGrayScalePalette(FBitmap,True);
// read image data
for Y:=0 to pred(FBitmap.Height) do
begin
Line8:=FBitmap.ScanLine[Y];
for X:=0 to pred(FBitmap.Width div 8) do
begin
Line8^:=Byte(GetChar);
Inc(Line8);
end;
if (FBitmap.Width mod 8)<>0 then Line8^:=Byte(GetChar);
end;
end;
5: // PGM binary form (gray scale)
begin
W:=GetNumber;
H:=GetNumber;
FBitmap:=NewBitmap(W,H);
FBitmap.PixelFormat:=pf8Bit;
// skip maximum color value
GetNumber;
ColorManager.TargetSamplesPerPixel:=1;
ColorManager.TargetBitsPerSample:=8;
ColorManager.CreateGrayScalePalette(FBitmap,False);
// read image data
for Y:=0 to pred(FBitmap.Height) do
begin
Line8:=FBitmap.ScanLine[Y];
for X:=0 to pred(FBitmap.Width) do
begin
Line8^:=Byte(GetChar);
Inc(Line8);
end;
end;
end;
6: // PPM binary form (true color)
begin
W:=GetNumber;
H:=GetNumber;
FBitmap:=NewBitmap(W,H);
FBitmap.PixelFormat:=pf24Bit;
// skip maximum color value
GetNumber;
// Pixel values are store linearly (but RGB instead BGR).
// There's one allowed white space which will automatically be skipped by the first
// GetChar call below
// now read the pixels
for Y:=0 to pred(FBitmap.Height) do
begin
Line24:=FBitmap.ScanLine[Y];
for X:=0 to pred(FBitmap.Width) do
begin
Line24.R:=Byte(GetChar);
Line24.G:=Byte(GetChar);
Line24.B:=Byte(GetChar);
Inc(Line24);
end;
end;
end;
end;
end;
end
else GraphicExError(1{gesInvalidImage},['PBM, PGM or PPM']);
end;
//----------------------------------------------------------------------------------------------------------------------
function TPPMGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Buffer: string;
begin
FStream := Stream;
Result:=inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
// set index pointer to end of buffer to cause reload
FIndex:=sizeof(FBuffer);
Buffer:=ReadLine;
Compression:=ctNone;
if Buffer[1]='P' then
begin
case Str2Int(Buffer[2]) of
1: // PBM ASCII format (black & white)
begin
Width:=GetNumber;
Height:=GetNumber;
SamplesPerPixel:=1;
BitsPerSample:=1;
ColorScheme:=csIndexed;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
end;
2: // PGM ASCII form (gray scale)
begin
Width:=GetNumber;
Height:=GetNumber;
// skip maximum color value
GetNumber;
SamplesPerPixel:=1;
BitsPerSample:=8;
ColorScheme:=csIndexed;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
end;
3: // PPM ASCII form (true color)
begin
Width:=GetNumber;
Height:=GetNumber;
// skip maximum color value
GetNumber;
SamplesPerPixel:=3;
BitsPerSample:=8;
ColorScheme:=csRGB;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
end;
4: // PBM binary format (black & white)
begin
Width:=GetNumber;
Height:=GetNumber;
SamplesPerPixel:=1;
BitsPerSample:=1;
ColorScheme:=csIndexed;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
end;
5: // PGM binary form (gray scale)
begin
Width:=GetNumber;
Height:=GetNumber;
// skip maximum color value
GetNumber;
SamplesPerPixel:=1;
BitsPerSample:=8;
ColorScheme:=csIndexed;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
end;
6: // PPM binary form (true color)
begin
Width:=GetNumber;
Height:=GetNumber;
// skip maximum color value
GetNumber;
SamplesPerPixel:=3;
BitsPerSample:=8;
ColorScheme:=csRGB;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
end;
end;
Result:=True;
end;
end;
end;
//----------------- TCUTGraphic ----------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TCUTGraphic.CanLoad(Stream: PStream): boolean;
// Note: cut files cannot be determined from stream because the only information
// is width and height of the image at stream/image start which is by no means
// enough to identify a cut (or any other) image.
begin
Result:=False;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TCUTGraphic.LoadFromStream(Stream: PStream);
var Buffer: PByte;
Run,Line: pointer;
{$IFDEF NOCLASSES} Decoder: PCUTRLEDECODER; {$ELSE} Decoder: TCUTRLEDecoder; {$ENDIF}
CUTSize: cardinal;
Y: integer;
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
if ReadImageProperties(Stream,0) then
begin
with FImageProperties do
begin
Stream.Position:=FBasePosition+6;
FBitmap:=NewBitmap(Width,Height);
FBitmap.PixelFormat:=pf8Bit;
LoadPalette;
CutSize:=Stream.Size-Stream.Position;
{$IFDEF NOCLASSES} new( Decoder, Create );
{$ELSE} Decoder:=TCUTRLEDecoder.Create; {$ENDIF}
Buffer:=nil;
try
GetMem(Buffer,CutSize);
Stream.Read(Buffer^,CUTSize);
Run:=Buffer;
for Y:=0 to pred(FBitmap.Height) do
begin
Line:=FBitmap.ScanLine[Y];
Decoder.Decode(Run,Line,0,FBitmap.Width);
end;
finally
Decoder.Free;
if Assigned(Buffer) then FreeMem(Buffer);
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TCUTGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Dummy: word;
begin
inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
Stream.Read(Dummy,sizeof(Dummy));
Width:=Dummy;
Stream.Read(Dummy,sizeof(Dummy));
Height:=Dummy;
ColorScheme:=csIndexed;
BitsPerSample:=8;
SamplesPerPixel:=1;
BitsPerPixel:=BitsPerSample*SamplesPerPixel;
Compression:=ctRLE;
Result:=True;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
type
// the palette file header is actually more complex than the
// image file's header, funny...
PHaloPaletteHeader = ^THaloPaletteHeader;
THaloPaletteHeader = packed record
ID: array[0..1] of Char; // should be 'AH'
Version,Size: word;
FileType,SubType: byte;
BrdID,GrMode: word;
MaxIndex,MaxRed,MaxGreen,MaxBlue: word; // colors = MaxIndex + 1
Signature: array[0..7] of Char; // 'Dr. Halo'
Filler: array[0..11] of byte;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TCUTGraphic.LoadPalette;
var Header: PHaloPaletteHeader;
I: integer;
Buffer: array[0..511] of byte;
Run: PWord;
R,G,B: byte;
Temp: PStream;
begin
if FileExists(FPaletteFile) then
begin
Temp:=NewReadFileStream(FPaletteFile);
try
// quite strange file organization here, we need always to load 512 bytes blocks
// and skip occasionally some bytes
Temp.Read(Buffer,sizeof(Buffer));
Header:=@Buffer;
Run:=@Buffer;
Inc(PByte(Run),sizeof(Header^));
for I:=0 to Header.MaxIndex do
begin
// load next 512 bytes buffer if necessary
if (Integer(Run)-Integer(@Buffer))>506 then
begin
Temp.Read(Buffer,sizeof(Buffer));
Run:=@Buffer;
end;
B:=Run^;
Inc(Run);
G:=Run^;
Inc(Run);
R:=Run^;
Inc(Run);
FBitmap.DIBPalEntries[I]:=Windows.RGB(R,G,B);
end;
finally
Temp.Free;
end;
end
else
begin
// no external palette so use gray scale
for I:=0 to 255 do FBitmap.DIBPalEntries[I]:=Windows.RGB(I,I,I);
end;
end;
//----------------- TGIFGraphic ----------------------------------------------------------------------------------------
const
// logical screen descriptor packed field masks
GIF_GLOBALCOLORTABLE = $80;
GIF_COLORRESOLUTION = $70;
GIF_GLOBALCOLORTABLESORTED = $08;
GIF_COLORTABLESIZE = $07;
// image flags
GIF_LOCALCOLORTABLE = $80;
GIF_INTERLACED = $40;
GIF_LOCALCOLORTABLESORTED= $20;
// block identifiers
GIF_PLAINTEXT = $01;
GIF_GRAPHICCONTROLEXTENSION = $F9;
GIF_COMMENTEXTENSION = $FE;
GIF_APPLICATIONEXTENSION = $FF;
GIF_IMAGEDESCRIPTOR = Ord(',');
GIF_EXTENSIONINTRODUCER = Ord('!');
GIF_TRAILER = Ord(';');
type
TGIFHeader = packed record
Signature: array[0..2] of Char; // magic ID 'GIF'
Version: array[0..2] of Char; // '87a' or '89a'
end;
TLogicalScreenDescriptor = packed record
ScreenWidth: Word;
ScreenHeight: Word;
PackedFields,
BackgroundColorIndex, // index into global color table
AspectRatio: Byte; // actual ratio = (AspectRatio + 15) / 64
end;
TImageDescriptor = packed record
//Separator: Byte; // leave that out since we always read one bye ahead
Left: Word; // X position of image with respect to logical screen
Top: Word; // Y position
Width: Word;
Height: Word;
PackedFields: Byte;
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TGIFGraphic.CanLoad(Stream: PStream): boolean;
var Header: TGIFHeader;
LastPosition: cardinal;
begin
LastPosition:=Stream.Position;
Result:=(Stream.Size-Stream.Position)>(sizeof(TGIFHeader)+sizeof(TLogicalScreenDescriptor)+sizeof(TImageDescriptor));
if Result then
begin
Stream.Read(Header,sizeof(Header));
Result:=UpperCase(Header.Signature)='GIF';
end;
Stream.Position:=LastPosition;
end;
function TGIFGraphic.Transparent: boolean;
begin
Result := ImageProperties.HasAlpha;
end;
function TGIFGraphic.Count: Integer;
begin
Result := ImageProperties.ImageCount;
end;
//----------------------------------------------------------------------------------------------------------------------
function TGIFGraphic.SkipExtensions: byte;
// Skips all blocks until an image block has been found in the data stream.
// Result is the image block ID if an image block could be found.
var Increment: byte;
begin
// iterate through the blocks until first image is found
repeat
FStream.Read(Result,1);
if Result=GIF_EXTENSIONINTRODUCER then
begin
// skip any extension
FStream.Read(Result,1);
case Result of
GIF_PLAINTEXT:
begin
// block size of text grid data
FStream.Read(Increment,1);
FStream.Seek(Increment,spCurrent);
// skip variable lengthed text block
repeat
// block size
FStream.Read(Increment,1);
if Increment=0 then Break;
FStream.Seek(Increment,spCurrent);
until False;
end;
GIF_GRAPHICCONTROLEXTENSION:
begin
// block size
FStream.Read(Increment,1);
// skip block and its terminator
FStream.Seek(Increment+1,spCurrent);
end;
GIF_COMMENTEXTENSION:
repeat
// block size
FStream.Read(Increment,1);
if Increment=0 then Break;
FStream.Seek(Increment,spCurrent);
until False;
GIF_APPLICATIONEXTENSION:
begin
// application id and authentication code plus potential application data
repeat
FStream.Read(Increment,1);
if Increment=0 then Break;
FStream.Seek(Increment,spCurrent);
until False;
end;
end;
end;
until (Result=GIF_IMAGEDESCRIPTOR) or (Result=GIF_TRAILER);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TGIFGraphic.LoadFromStream(Stream: PStream);
var Header: TGIFHeader;
ScreenDescriptor: TLogicalScreenDescriptor;
ImageDescriptor: TImageDescriptor;
I,NE: cardinal;
R,G,B,BlockID,InitCodeSize: byte;
RawData,Run: PByte;
TargetBuffer,TargetRun,Line: pointer;
Pass,Increment,Marker: integer;
{$IFDEF NOCLASSES} Decoder: PGIFLZWDecoder; {$ELSE} Decoder: TGIFLZWDecoder; {$ENDIF}
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
FStream:=Stream;
if ReadImageProperties(Stream,0) then
begin
with FImageProperties do
begin
Stream.Position:=FBasePosition;
Stream.Read(Header,sizeof(Header));
FBitmap:=NewBitmap(Width,Height);
FBitmap.PixelFormat:=pf8Bit;
// general information
Stream.Read(ScreenDescriptor,sizeof(ScreenDescriptor));
// read global color table if given
if (ScreenDescriptor.PackedFields and GIF_GLOBALCOLORTABLE)<>0 then
begin
// the global color table immediately follows the screen descriptor
NE:=2 shl (ScreenDescriptor.PackedFields and GIF_COLORTABLESIZE);
for I:=0 to pred(NE) do
begin
Stream.Read(B,1);
Stream.Read(G,1);
Stream.Read(R,1);
FBitmap.DIBPalEntries[I]:=Windows.RGB(R,G,B);
end;
end;
BlockID:=SkipExtensions;
// image found?
if BlockID=GIF_IMAGEDESCRIPTOR then
begin
Stream.Read(ImageDescriptor,sizeof(TImageDescriptor));
// if there is a local color table then override the already set one
if (ImageDescriptor.PackedFields and GIF_LOCALCOLORTABLE)<>0 then
begin
// the global color table immediately follows the image descriptor
NE:=2 shl (ImageDescriptor.PackedFields and GIF_COLORTABLESIZE);
for I:=0 to pred(NE) do
begin
Stream.Read(B,1);
Stream.Read(G,1);
Stream.Read(R,1);
FBitmap.DIBPalEntries[I]:=Windows.RGB(R,G,B);
end;
end;
Stream.Read(InitCodeSize,1);
// decompress data in one step
// 1) count data
Marker:=Stream.Position;
Pass:=0;
Increment:=0;
repeat
if Stream.Read(Increment,1)=0 then Break;
Inc(Pass,Increment);
Stream.Seek(Increment,spCurrent);
until Increment=0;
// 2) allocate enough memory
GetMem(RawData,Pass);
// add one extra line of extra memory for badly coded images
GetMem(TargetBuffer,FBitmap.Width*(FBitmap.Height+1));
try
// 3) read and decode data
Stream.Position:=Marker;
Increment:=0;
Run:=RawData;
repeat
if Stream.Read(Increment,1)=0 then Break;
Stream.Read(Run^,Increment);
Inc(Run,Increment);
until Increment=0;
{$IFDEF NOCLASSES} new( Decoder, Create( InitCodeSize, FBitmap.Width ) );
{$ELSE} Decoder:=TGIFLZWDecoder.Create(InitCodeSize, FBitmap.Width); {$ENDIF}
try
Run:=RawData;
Decoder.Decode(Pointer(Run),TargetBuffer,Pass,FBitmap.Width*FBitmap.Height);
finally
Decoder.Free;
if Decoder.GIFCorrupted then
FCorrupted := TRUE;
end;
// finally transfer image data
if (ImageDescriptor.PackedFields and GIF_INTERLACED)=0 then
begin
TargetRun:=TargetBuffer;
for I:=0 to pred(FBitmap.Height) do
begin
Line:=FBitmap.ScanLine[I];
Move(TargetRun^,Line^,FBitmap.Width);
Inc(PByte(TargetRun),FBitmap.Width);
end;
end
else
begin
TargetRun:=TargetBuffer;
// interlaced image, need to move in four passes
for Pass:=0 to 3 do
begin
// determine start line and increment of the pass
case Pass of
0: begin
I:=0;
Increment:=8;
end;
1: begin
I:=4;
Increment:=8;
end;
2: begin
I:=2;
Increment:=4;
end;
else
I:=1;
Increment:=2;
end;
while I<DWORD(FBitmap.Height) do
begin
Line:=FBitmap.ScanLine[I];
Move(TargetRun^,Line^,FBitmap.Width);
Inc(PByte(TargetRun),FBitmap.Width);
Inc(I,Increment);
end;
end;
end;
finally
if Assigned(TargetBuffer) then FreeMem(TargetBuffer);
if Assigned(RawData) then FreeMem(RawData);
end;
end;
end;
end
else GraphicExError(1{gesInvalidImage},['GIF']);
end;
//----------------------------------------------------------------------------------------------------------------------
function TGIFGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): Boolean;
var Header: TGIFHeader;
ScreenDescriptor: TLogicalScreenDescriptor;
ImageDescriptor: TImageDescriptor;
BlockID: integer;
begin
Result:=inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
Stream.Read(Header,sizeof(Header));
if UpperCase(Header.Signature)='GIF' then
begin
Version:=Str2Int(Copy(Header.Version,1,2));
ColorScheme:=csIndexed;
SamplesPerPixel:=1;
// might be overwritten
BitsPerSample:=8;
Compression:=ctLZW;
// general information
Stream.Read(ScreenDescriptor,sizeof(ScreenDescriptor));
// skip global color table if given
if (ScreenDescriptor.PackedFields and GIF_GLOBALCOLORTABLE)<>0 then
begin
BitsPerSample:=(ScreenDescriptor.PackedFields and GIF_COLORTABLESIZE)+1;
// the global color table immediately follows the screen descriptor
Stream.Seek(3*(1 shl BitsPerSample),spCurrent);
end;
BlockID:=SkipExtensions;
// image found?
if BlockID=GIF_IMAGEDESCRIPTOR then
begin
Stream.Read(ImageDescriptor,sizeof(TImageDescriptor));
Width:=ImageDescriptor.Width;
if Width=0 then Width:=ScreenDescriptor.ScreenWidth;
Height:=ImageDescriptor.Height;
if Height=0 then Height:=ScreenDescriptor.ScreenHeight;
// if there is a local color table then override the already set one
LocalColorTable:=(ImageDescriptor.PackedFields and GIF_LOCALCOLORTABLE)<>0;
if LocalColorTable then BitsPerSample:=(ImageDescriptor.PackedFields and GIF_LOCALCOLORTABLE)+1;
Interlaced:=(ImageDescriptor.PackedFields and GIF_INTERLACED)<>0;
end;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
Result:=True;
end;
end;
end;
//----------------- TRLAGraphic ----------------------------------------------------------------------------------------
// This implementation is based on code from Dipl. Ing. Ingo Neumann (ingo@upstart.de, ingo_n@dialup.nacamar.de).
type
TRLAWindow = packed record
Left,Right,Bottom,Top: smallint;
end;
TRLAHeader = packed record
Window, // overall image size
Active_window: TRLAWindow; // size of non-zero portion of image (we use this as actual image size)
Frame, // frame number if part of a sequence
Storage_type, // type of image channels (0 - integer data, 1 - float data)
Num_chan, // samples per pixel (usually 3: r, g, b)
Num_matte, // number of matte channels (usually only 1)
Num_aux, // number of auxiliary channels, usually 0
Revision: smallint; // always $FFFE
Gamma: array[0..15] of Char; // gamma single value used when writing the image
Red_pri: array[0..23] of Char; // used chromaticity for red channel (typical format: "%7.4f %7.4f")
Green_pri: array[0..23] of Char; // used chromaticity for green channel
Blue_pri: array[0..23] of Char; // used chromaticity for blue channel
White_pt: array[0..23] of Char; // used chromaticity for white point
Job_num: integer; // rendering speciifc
Name: array[0..127] of Char; // original file name
Desc: array[0..127] of Char; // a file description
ProgramName: array[0..63] of Char; // name of program which created the image
Machine: array[0..31] of Char; // name of computer on which the image was rendered
User: array[0..31] of Char; // user who ran the creation program of the image
Date: array[0..19] of Char; // creation data of image (ex: Sep 30 12:29 1993)
Aspect: array[0..23] of Char; // aspect format of the file (external resource)
Aspect_ratio: array[0..7] of Char; // float number Width /Height
Chan: array[0..31] of Char; // color space (can be: rgb, xyz, sampled or raw)
Field: smallint; // 0 - non-field rendered data, 1 - field rendered data
Time: array[0..11] of Char; // time needed to create the image (used when rendering)
Filter: array[0..31] of Char; // filter name to post-process image data
Chan_bits, // bits per sample
Matte_type, // type of matte channel (see aux_type)
Matte_bits, // precision of a pixel's matte channel (1..32)
Aux_type, // type of aux channel (0 - integer data; 4 - single (float) data
Aux_bits: smallint; // bits precision of the pixel's aux channel (1..32 bits)
Aux: array[0..31] of Char; // auxiliary channel as either range or depth
Space: array[0..35] of Char; // unused
Next: integer; // offset for next header if multi-frame image
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TRLAGraphic.CanLoad(Stream: PStream): boolean;
var Header: TRLAHeader;
LastPosition: cardinal;
begin
LastPosition:=Stream.Position;
Result:=(Stream.Size-Stream.Position)>sizeof(Header);
if Result then
begin
Stream.Read(Header,sizeof(Header));
Result:=(System.Swap(Word(Header.Revision))=$FFFE) and ((LowerCase(Header.Chan)='rgb') or (LowerCase(Header.Chan)='xyz'));
end;
Stream.Position:=LastPosition;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TRLAGraphic.LoadFromStream(Stream: PStream);
var Offsets: TCardinalArray;
RLELength: word;
Line: pointer;
Y,I: Integer;
// RLE buffers
RawBuffer,RedBuffer,GreenBuffer,BlueBuffer,AlphaBuffer: pointer;
{$IFDEF NOCLASSES} Decoder: PRLADecoder; {$ELSE} Decoder: TRLADecoder; {$ENDIF}
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
if ReadImageProperties(Stream,0) then
begin
with FImageProperties do
begin
// dimension of image, top might be larger than bottom denoting a bottom up image
FBitmap:=NewBitmap(Width,Height);
ColorManager.SourceSamplesPerPixel:=SamplesPerPixel;
ColorManager.TargetSamplesPerPixel:=SamplesPerPixel;
ColorManager.SourceBitsPerSample:=BitsPerSample;
if BitsPerSample>8 then ColorManager.TargetBitsPerSample:=8 else ColorManager.TargetBitsPerSample:=BitsPerSample;
ColorManager.SourceColorScheme:=ColorScheme;
if ColorScheme=csRGBA then ColorManager.TargetColorScheme:=csBGRA else ColorManager.TargetColorScheme:=csBGR;
FBitmap.PixelFormat:=ColorManager.TargetPixelFormat;
if FileGamma<>1 then
begin
ColorManager.SetGamma(FileGamma);
ColorManager.TargetOptions:=ColorManager.TargetOptions+[coApplyGamma];
Include(Options,ioUseGamma);
end;
// each scanline is organized in RLE compressed strips whose location in the stream
// is determined by the offsets table
SetLength(Offsets,Height);
Stream.Read(Offsets[0],Height*sizeof(Cardinal));
for I:=0 to pred(Height) do SwapLong(@Offsets[I],1);
// setup intermediate storage
{$IFDEF NOCLASSES} new( Decoder, Create );
{$ELSE} Decoder:=TRLADecoder.Create; {$ENDIF}
RawBuffer:=nil;
RedBuffer:=nil;
GreenBuffer:=nil;
BlueBuffer:=nil;
AlphaBuffer:=nil;
try
GetMem(RedBuffer,Width);
GetMem(GreenBuffer,Width);
GetMem(BlueBuffer,Width);
GetMem(AlphaBuffer,Width);
// no go for each scanline
for Y:=0 to pred(Height) do
begin
Stream.Position:=FBasePosition+Offsets[Y];
if BottomUp then Line:=FBitmap.ScanLine[Integer(Height)-Y-1] else Line:=FBitmap.ScanLine[Y];
// read channel data to decode
// red
Stream.Read(RLELength,sizeof(RLELength));
RLELength:=System.Swap(RLELength);
ReallocMem(RawBuffer,RLELength);
Stream.Read(RawBuffer^,RLELength);
Decoder.Decode(RawBuffer,RedBuffer,RLELength,Width);
// green
Stream.Read(RLELength,sizeof(RLELength));
RLELength:=System.Swap(RLELength);
ReallocMem(RawBuffer,RLELength);
Stream.Read(RawBuffer^,RLELength);
Decoder.Decode(RawBuffer,GreenBuffer,RLELength,Width);
// blue
Stream.Read(RLELength,sizeof(RLELength));
RLELength:=System.Swap(RLELength);
ReallocMem(RawBuffer,RLELength);
Stream.Read(RawBuffer^,RLELength);
Decoder.Decode(RawBuffer,BlueBuffer,RLELength,Width);
if ColorManager.TargetColorScheme=csBGR then
begin
ColorManager.ConvertRow([RedBuffer,GreenBuffer,BlueBuffer],Line,Width,$FF);
end
else
begin
// alpha
Stream.Read(RLELength,sizeof(RLELength));
RLELength:=System.Swap(RLELength);
ReallocMem(RawBuffer,RLELength);
Stream.Read(RawBuffer^,RLELength);
Decoder.Decode(RawBuffer,AlphaBuffer,RLELength,Width);
ColorManager.ConvertRow([RedBuffer,GreenBuffer,BlueBuffer,AlphaBuffer],Line,Width,$FF);
end;
end;
finally
if Assigned(RawBuffer) then FreeMem(RawBuffer);
if Assigned(RedBuffer) then FreeMem(RedBuffer);
if Assigned(GreenBuffer) then FreeMem(GreenBuffer);
if Assigned(BlueBuffer) then FreeMem(BlueBuffer);
if Assigned(AlphaBuffer) then FreeMem(AlphaBuffer);
Decoder.Free;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
function TRLAGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Header: TRLAHeader;
begin
Result:=inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
Stream.Read(Header,sizeof(Header));
// data is always given in big endian order, so swap data which needs this
SwapHeader(Header);
Options:=[ioBigEndian];
SamplesPerPixel:=Header.num_chan;
if Header.num_matte=1 then Inc(SamplesPerPixel);
BitsPerSample:=Header.Chan_bits;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
if LowerCase(Header.Chan)='rgb' then
begin
if Header.num_matte>0 then ColorScheme:=csRGBA else ColorScheme:=csRGB;
end
else
if LowerCase(Header.Chan)='xyz' then Exit;
try
FileGamma:=Str2Double(Header.Gamma);
except
end;
Compression:=ctRLE;
// dimension of image, top might be larger than bottom denoting a bottom up image
Width:=Header.Active_window.Right-Header.Active_window.Left+1;
Height:=Abs(Header.Active_window.Bottom-Header.Active_window.Top)+1;
BottomUp:=(Header.Active_window.Bottom-Header.Active_window.Top)<0;
Result:=True;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TRLAGraphic.SwapHeader(var Header);
// separate swap method to ease reading the main flow of the LoadFromStream method
begin
with TRLAHeader(Header) do
begin
SwapShort(@Window,4);
SwapShort(@Active_window,4);
Frame:=System.Swap(Frame);
Storage_type:=System.Swap(Storage_type);
Num_chan:=System.Swap(Num_chan);
Num_matte:=System.Swap(Num_matte);
Num_aux:=System.Swap(Num_aux);
Revision:=System.Swap(Revision);
Job_num:=SwapLong(Job_num);
Field:=System.Swap(Field);
Chan_bits:=System.Swap(Chan_bits);
Matte_type:=System.Swap(Matte_type);
Matte_bits:=System.Swap(Matte_bits);
Aux_type:=System.Swap(Aux_type);
Aux_bits:=System.Swap(Aux_bits);
Next:=SwapLong(Next);
end;
end;
//----------------- TPSDGraphic ----------------------------------------------------------------------------------------
const
// color modes
PSD_BITMAP = 0;
PSD_GRAYSCALE = 1;
PSD_INDEXED = 2;
PSD_RGB = 3;
PSD_CMYK = 4;
PSD_MULTICHANNEL = 7;
PSD_DUOTONE = 8;
PSD_LAB = 9;
PSD_COMPRESSION_NONE = 0;
PSD_COMPRESSION_RLE = 1; // RLE compression (same as TIFF packed bits)
type
TPSDHeader = packed record
Signature: array[0..3] of Char; // always '8BPS'
Version: word; // always 1
Reserved: array[0..5] of byte; // reserved, always 0
Channels: word; // 1..24, number of channels in the image (including alpha)
Rows,
Columns: cardinal; // 1..30000, size of image
Depth: word; // 1,8,16 bits per channel
Mode: word; // color mode (see constants above)
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TPSDGraphic.CanLoad(Stream: PStream): boolean;
var Header: TPSDHeader;
LastPosition: cardinal;
begin
LastPosition:=Stream.Position;
Result:=(Stream.Size-Stream.Position)>sizeof(Header);
if Result then
begin
Stream.Read(Header,sizeof(Header));
Result:=(UpperCase(Header.Signature)='8BPS') and (System.Swap(Header.Version)=1);
end;
Stream.Position:=LastPosition;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPSDGraphic.LoadFromStream(Stream: PStream);
var Header: TPSDHeader;
Count: cardinal;
{$IFDEF NOCLASSES} Decoder: PPackbitsRLEDecoder; {$ELSE} Decoder: TDecoder; {$ENDIF}
RLELength: array[0..65535] of word;
Y: integer;
BPS: cardinal; // bytes per sample either 1 or 2 for 8 bits per channel and 16 bits per channel respectively
ChannelSize: integer; // size of one channel (taking BPS into account)
NChannels: Integer;
Increment: integer; // pointer increment from one line to next
// RLE buffers
Line,RawBuffer, // all image data compressed
Buffer: pointer; // all image data uncompressed
Run1, // running pointer in Buffer 1
Run2, // etc.
Run3,
Run4: PByte;
RawPalette: array[0..767] of byte;
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
if ReadImageProperties(Stream,0) then
begin
with FImageProperties do
begin
Stream.Position:=FBasePosition;
Stream.Read(Header,sizeof(Header));
// initialize color manager
ColorManager.SourceOptions:=[coNeedByteSwap];
ColorManager.SourceBitsPerSample:=BitsPerSample;
if BitsPerSample=16 then ColorManager.TargetBitsPerSample:=8 else ColorManager.TargetBitsPerSample:=BitsPerSample;
ColorManager.SourceSamplesPerPixel:=SamplesPerPixel;
ColorManager.TargetSamplesPerPixel:=SamplesPerPixel;
if (SamplesPerPixel = 2) and (ColorScheme = csG) then
ColorManager.TargetSamplesPerPixel := 1;
// color space
ColorManager.SourceColorScheme:=ColorScheme;
case ColorScheme of
csG,csIndexed: ColorManager.TargetColorScheme:=ColorScheme;
csRGB: ColorManager.TargetColorScheme:=csBGR;
csRGBA: ColorManager.TargetColorScheme:=csBGRA;
csCMYK: begin
ColorManager.TargetColorScheme:=csBGR;
ColorManager.TargetSamplesPerPixel:=3;
end;
csCIELab: begin
// PSD uses 0..255 for a and b so we need to convert them to -128..127
ColorManager.SourceOptions:=ColorManager.SourceOptions+[coLabByteRange,coLabChromaOffset];
ColorManager.TargetColorScheme:=csBGR;
end;
end;
FBitmap:=NewDibBitmap(Width,Height, {);
FBitmap.PixelFormat:=}ColorManager.TargetPixelFormat);
// size of palette
Stream.Read(Count,sizeof(Count));
Count:=SwapLong(Count);
// setup the palette if necessary, color data immediately follows header
case ColorScheme of
csG: ColorManager.CreateGrayscalePalette(FBitmap,ioMinIsWhite in Options);
csIndexed:
begin
Stream.Read(RawPalette,Count);
Count:=Count div 3;
ColorManager.CreateColorPalette(FBitmap,[@RawPalette,@RawPalette[Count],@RawPalette[2*Count]],pfPlane8Triple,Count,False);
end;
end;
// skip resource and layers section
Stream.Read(Count,sizeof(Count));
Count:=SwapLong(Count);
Stream.Seek(Count,spCurrent);
Stream.Read(Count,sizeof(Count));
Count:=SwapLong(Count);
// +2 in order to skip the following compression value
Stream.Seek(Count+2,spCurrent);
// now read out image data
RawBuffer:=nil;
if Compression=ctPackedBits then
begin
{$IFDEF NOCLASSES} new( Decoder, Create );
{$ELSE} Decoder:=TPackbitsRLEDecoder.Create; {$ENDIF}
//+++++++++++++++ by VK: if not clear buffer before using it,
//process can be VERY slow even for small images!
FillChar( RLELength, SizeOf( RLELength ), 0 );
Stream.Read(RLELength,2*Height*Channels);
SwapShort(@RLELength[0],Height*Channels);
end
else Decoder:=nil;
try
case ColorScheme of
csG,csIndexed:
begin
// very simple format here, we don't need the color conversion manager
if Assigned(Decoder) then
begin
// determine whole compressed size
Count:=0;
for Y:=0 to pred(Height) do Inc(Count,RLELength[Y]);
GetMem(RawBuffer,Count);
try
Stream.Read(RawBuffer^,Count);
Run1:=RawBuffer;
for Y:=0 to pred(Height) do
begin
Count:=RLELength[Y];
Line:=FBitmap.ScanLine[Y];
Decoder.Decode(Pointer(Run1),Line,Count,Width);
Inc(Run1,Count);
end;
finally
if Assigned(RawBuffer) then FreeMem(RawBuffer);
end;
end
else // uncompressed data
for Y:=0 to pred(Height) do
begin
Stream.Read(FBitmap.ScanLine[Y]^,Width);
end;
end;
csRGB,csRGBA,csCMYK,csCIELab:
begin
// Data is organized in planes. This means first all red rows, then
// all green and finally all blue rows.
BPS:=BitsPerSample div 8;
ChannelSize:=BPS*Width*Height;
GetMem(Buffer,Channels*ChannelSize);
try
// first run: load image data and decompress it if necessary
if Assigned(Decoder) then
begin
// determine whole compressed size
Count:=0;
for Y:=0 to High(RLELength) do Inc(Count,RLELength[Y]);
Count:=Count*Cardinal(BPS);
GetMem(RawBuffer,Count);
try
Stream.Read(RawBuffer^,Count);
NChannels := Channels;
Decoder.Decode(RawBuffer,Buffer,Count,NChannels*ChannelSize);
finally
if Assigned(RawBuffer) then FreeMem(RawBuffer);
end;
end
else Stream.Read(Buffer^,Channels*ChannelSize);
Increment:=BPS*Width;
// second run: put data into image (convert color space if necessary)
case ColorScheme of
csRGB:
begin
Run1:=Buffer;
Run2:=Run1;
Inc(Run2,ChannelSize);
Run3:=Run2;
Inc(Run3,ChannelSize);
for Y:=0 to pred(Height) do
begin
ColorManager.ConvertRow([Run1,Run2,Run3],FBitmap.ScanLine[Y],Width,$FF);
Inc(Run1,Increment);
Inc(Run2,Increment);
Inc(Run3,Increment);
end;
end;
csRGBA:
begin
Run1:=Buffer;
Run2:=Run1;
Inc(Run2,ChannelSize);
Run3:=Run2;
Inc(Run3,ChannelSize);
Run4:=Run3;
Inc(Run4,ChannelSize);
for Y:=0 to pred(Height) do
begin
ColorManager.ConvertRow([Run1,Run2,Run3,Run4],FBitmap.ScanLine[Y],Width,$FF);
Inc(Run1,Increment);
Inc(Run2,Increment);
Inc(Run3,Increment);
Inc(Run4,Increment);
end;
end;
csCMYK:
begin
// Photoshop CMYK values are given with 0 for maximum values, but the
// (general) CMYK conversion works with 255 as maxium value. Hence we must reverse
// all entries in the buffer.
Run1:=Buffer;
for Y:=1 to 4*ChannelSize do
begin
Run1^:=255-Run1^;
Inc(Run1);
end;
Run1:=Buffer;
Run2:=Run1;
Inc(Run2,ChannelSize);
Run3:=Run2;
Inc(Run3,ChannelSize);
Run4:=Run3;
Inc(Run4,ChannelSize);
for Y:=0 to pred(Height) do
begin
ColorManager.ConvertRow([Run1,Run2,Run3,Run4],FBitmap.ScanLine[Y],Width,$FF);
Inc(Run1,Increment);
Inc(Run2,Increment);
Inc(Run3,Increment);
Inc(Run4,Increment);
end;
end;
csCIELab:
begin
Run1:=Buffer;
Run2:=Run1;
Inc(Run2,ChannelSize);
Run3:=Run2;
Inc(Run3,ChannelSize);
for Y:=0 to pred(Height) do
begin
ColorManager.ConvertRow([Run1,Run2,Run3],FBitmap.ScanLine[Y],Width,$FF);
Inc(Run1,Increment);
Inc(Run2,Increment);
Inc(Run3,Increment);
end;
end;
end;
finally
if Assigned(Buffer) then FreeMem(Buffer);
end;
end;
end;
finally
Decoder.Free;
end;
end;
end
else GraphicExError(1{gesInvalidImage},['PSD or PDD']);
end;
//----------------------------------------------------------------------------------------------------------------------
function TPSDGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Header: TPSDHeader;
Dummy: word;
Count: cardinal;
begin
Result:=inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
Stream.Read(Header,sizeof(Header));
if Header.Signature='8BPS' then
begin
with Header do
begin
// PSD files are big endian only
Channels:=System.Swap(Channels);
Rows:=SwapLong(Rows);
Columns:=SwapLong(Columns);
Depth:=System.Swap(Depth);
Mode:=System.Swap(Mode);
end;
Options:=[ioBigEndian];
// initialize color manager
BitsPerSample:=Header.Depth;
Channels:=Header.Channels;
// 1..24 channels are supported in PSD files, we can only use 4.
// The documentation states that main image data (rgb(a), cmyk etc.) is always
// written as first channels in their component order.
if Channels>4 then SamplesPerPixel:=4 else SamplesPerPixel:=Channels;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
// color space
case Header.Mode of
PSD_DUOTONE, // duo tone should be handled as grayscale
PSD_GRAYSCALE: ColorScheme:=csG;
PSD_BITMAP: // B&W
begin
ColorScheme:=csG;
Include(Options,ioMinIsWhite);
end;
PSD_INDEXED: // 8 bits only are assumed because 16 bit wouldn't make sense here
ColorScheme:=csIndexed;
PSD_MULTICHANNEL,
PSD_RGB:
if Header.Channels=3 then ColorScheme:=csRGB else ColorScheme:=csRGBA;
PSD_CMYK: ColorScheme:=csCMYK;
PSD_LAB: ColorScheme:=csCIELab;
end;
Width:=Header.Columns;
Height:=Header.Rows;
// size of palette
Stream.Read(Count,sizeof(Count));
Count:=SwapLong(Count);
// skip palette (count is always given, might be 0 however, e.g. for RGB)
Stream.Seek(Count,spCurrent);
// skip resource and layers section
Stream.Read(Count,sizeof(Count));
Count:=SwapLong(Count);
Stream.Seek(Count,spCurrent);
Stream.Read(Count,sizeof(Count));
Count:=SwapLong(Count);
Stream.Seek(Count,spCurrent);
Stream.Read(Dummy,sizeof(Dummy));
if System.Swap(Dummy)=1 then Compression:=ctPackedBits else Compression:=ctNone;
Result:=True;
end;
end;
end;
//----------------- TPSPGraphic ----------------------------------------------------------------------------------------
const
// block identifiers
PSP_IMAGE_BLOCK = 0; // General Image Attributes Block (main)
PSP_CREATOR_BLOCK = 1; // Creator Data Block (main)
PSP_COLOR_BLOCK = 2; // Color Palette Block (main and sub)
PSP_LAYER_START_BLOCK = 3; // Layer Bank Block (main)
PSP_LAYER_BLOCK = 4; // Layer Block (sub)
PSP_CHANNEL_BLOCK = 5; // Channel Block (sub)
PSP_SELECTION_BLOCK = 6; // Selection Block (main)
PSP_ALPHA_BANK_BLOCK = 7; // Alpha Bank Block (main)
PSP_ALPHA_CHANNEL_BLOCK = 8; // Alpha Channel Block (sub)
PSP_THUMBNAIL_BLOCK = 9; // Thumbnail Block (main)
PSP_EXTENDED_DATA_BLOCK = 10; // Extended Data Block (main)
PSP_TUBE_BLOCK = 11; // Picture Tube Data Block (main)
PSP_ADJUSTMENT_EXTENSION_BLOCK = 12; // Adjustment Layer Extension Block (sub)
PSP_VECTOR_EXTENSION_BLOCK = 13; // Vector Layer Extension Block (sub)
PSP_SHAPE_BLOCK = 14; // Vector Shape Block (sub)
PSP_PAINTSTYLE_BLOCK = 15; // Paint Style Block (sub)
PSP_COMPOSITE_IMAGE_BANK_BLOCK = 16; // Composite Image Bank (main)
PSP_COMPOSITE_ATTRIBUTES_BLOCK = 17; // Composite Image Attributes (sub)
PSP_JPEG_BLOCK = 18; // JPEG Image Block (sub)
// bitmap types
PSP_DIB_IMAGE = 0; // Layer color bitmap
PSP_DIB_TRANS_MASK = 1; // Layer transparency mask bitmap
PSP_DIB_USER_MASK = 2; // Layer user mask bitmap
PSP_DIB_SELECTION= 3; // Selection mask bitmap
PSP_DIB_ALPHA_MASK = 4; // Alpha channel mask bitmap
PSP_DIB_THUMBNAIL = 5; // Thumbnail bitmap
PSP_DIB_THUMBNAIL_TRANS_MASK = 6; // Thumbnail transparency mask
PSP_DIB_ADJUSTMENT_LAYER = 7; // Adjustment layer bitmap
PSP_DIB_COMPOSITE = 8; // Composite image bitmap
PSP_DIB_COMPOSITE_TRANS_MASK = 9; // Composite image transparency
// composite image type
PSP_IMAGE_COMPOSITE = 0; // Composite Image
PSP_IMAGE_THUMBNAIL = 1; // Thumbnail Image
// graphic contents flags
PSP_GC_RASTERLAYERS = 1; // At least one raster layer
PSP_GC_VectorLayers = 2; // At least one vector layer
PSP_GC_ADJUSTMENTLAYERS = 4; // At least one adjustment layer
// Additional attributes
PSP_GC_THUMBNAIL = $01000000; // Has a thumbnail
PSP_GC_THUMBNAILTRANSPARENCY = $02000000; // Thumbnail transp.
PSP_GC_COMPOSITE = $04000000; // Has a composite image
PSP_GC_COMPOSITETRANSPARENCY = $08000000; // Composite transp.
PSP_GC_FLATIMAGE = $10000000; // Just a background
PSP_GC_SELECTION = $20000000; // Has a selection
PSP_GC_FLOATINGSELECTIONLAYER = $40000000; // Has float. selection
PSP_GC_ALPHACHANNELS = $80000000; // Has alpha channel(s)
// character style flags
PSP_STYLE_ITALIC = 1; // Italic property bit
PSP_STYLE_STRUCK = 2; // Strike-out property bit
PSP_STYLE_UNDERLINED = 4; // Underlined property bit
// layer flags
PSP_LAYER_VISIBLEFLAG = 1; // Layer is visible
PSP_LAYER_MASKPRESENCEFLAG = 2; // Layer has a mask
// Shape property flags
PSP_SHAPE_ANTIALIASED = 1; // Shape is anti-aliased
PSP_SHAPE_Selected = 2; // Shape is selected
PSP_SHAPE_Visible = 4; // Shape is visible
// Polyline node type flags
PSP_NODE_UNCONSTRAINED = 0; // Default node type
PSP_NODE_SMOOTH = 1; // Node is smooth
PSP_NODE_SYMMETRIC = 2; // Node is symmetric
PSP_NODE_ALIGNED = 4; // Node is aligned
PSP_NODE_ACTIVE = 8; // Node is active
PSP_NODE_LOCKED = 16; // Node is locked (PSP doc says 0x16 here, but this seems to be a typo)
PSP_NODE_SELECTED = 32; // Node is selected (PSP doc says 0x32 here)
PSP_NODE_VISIBLE = 64; // Node is visible (PSP doc says 0x64 here)
PSP_NODE_CLOSED = 128; // Node is closed (PSP doc says 0x128 here)
// Blend modes
LAYER_BLEND_NORMAL = 0;
LAYER_BLEND_DARKEN = 1;
LAYER_BLEND_LIGHTEN = 2;
LAYER_BLEND_HUE = 3;
LAYER_BLEND_SATURATION = 4;
LAYER_BLEND_COLOR = 5;
LAYER_BLEND_LUMINOSITY = 6;
LAYER_BLEND_MULTIPLY = 7;
LAYER_BLEND_SCREEN = 8;
LAYER_BLEND_DISSOLVE = 9;
LAYER_BLEND_OVERLAY = 10;
LAYER_BLEND_HARD_LIGHT = 11;
LAYER_BLEND_SOFT_LIGHT = 12;
LAYER_BLEND_DIFFERENCE = 130;
LAYER_BLEND_DODGE = 14;
LAYER_BLEND_BURN = 15;
LAYER_BLEND_EXCLUSION = 16;
LAYER_BLEND_ADJUST = 255;
// Adjustment layer types
PSP_ADJUSTMENT_NONE = 0; // Undefined adjustment layer type
PSP_ADJUSTMENT_LEVEL = 1; // Level adjustment
PSP_ADJUSTMENT_CURVE = 2; // Curve adjustment
PSP_ADJUSTMENT_BRIGHTCONTRAST = 3; // Brightness-contrast adjustment
PSP_ADJUSTMENT_COLORBAL = 4; // Color balance adjustment
PSP_ADJUSTMENT_HSL = 5; // HSL adjustment
PSP_ADJUSTMENT_CHANNELMIXER = 6; // Channel mixer adjustment
PSP_ADJUSTMENT_INVERT = 7; // Invert adjustment
PSP_ADJUSTMENT_THRESHOLD = 8; // Threshold adjustment
PSP_ADJUSTMENT_POSTER = 9; // Posterize adjustment
// Vector shape types
PSP_VST_Unknown = 0; // Undefined vector type
PSP_VST_TEXT = 1; // Shape represents lines of text
PSP_VST_POLYLINE = 2; // Shape represents a multiple segment line
PSP_VST_ELLIPSE = 3; // Shape represents an ellipse (or circle)
PSP_VST_POLYGON = 4; // Shape represents a closed polygon
// Text element types
PSP_TET_UNKNOWN = 0; // Undefined text element type
PSP_TET_CHAR = 1; // A single character code
PSP_TET_CHARSTYLE = 2; // A character style change
PSP_TET_LINESTYLE = 3; // A line style change
// Text alignment types
PSP_TAT_LEFT = 0; // Left text alignment
PSP_TAT_CENTER = 1; // Center text alignment
PSP_TAT_RIGHT = 2; // Right text alignment
// Paint style types
PSP_STYLE_NONE = 0; // Undefined paint style
PSP_STYLE_COLOR = 1; // Paint using color (RGB or palette index)
PSP_STYLE_GRADIENT = 2; // Paint using gradient
// Channel types
PSP_CHANNEL_COMPOSITE = 0; // Channel of single channel bitmap
PSP_CHANNEL_RED = 1; // Red channel of 24 bit bitmap
PSP_CHANNEL_GREEN = 2; // Green channel of 24 bit bitmap
PSP_CHANNEL_BLUE = 3; // Blue channel of 24 bit bitmap
// Resolution metrics
PSP_METRIC_UNDEFINED = 0; // Metric unknown
PSP_METRIC_INCH = 1; // Resolution is in inches
PSP_METRIC_CM = 2; // Resolution is in centimeters
// Compression types
PSP_COMP_NONE = 0; // No compression
PSP_COMP_RLE = 1; // RLE compression
PSP_COMP_LZ77 = 2; // LZ77 compression
PSP_COMP_JPEG = 3; // JPEG compression (only used by thumbnail and composite image)
// Picture tube placement mode
PSP_TPM_Random = 0; // Place tube images in random intervals
PSPS_TPM_Constant = 1; // Place tube images in constant intervals
// Tube selection mode
PSP_TSM_RANDOM =0; // Randomly select the next image in tube to display
PSP_TSM_INCREMENTAL = 1; // Select each tube image in turn
PSP_TSM_ANGULAR = 2; // Select image based on cursor direction
PSP_TSM_PRESSURE = 3; // Select image based on pressure (from pressure-sensitive pad)
PSP_TSM_VELOCITY = 4; // Select image based on cursor speed
// Extended data field types
PSP_XDATA_TRNS_INDEX = 0; // Transparency index field
// Creator field types
PSP_CRTR_FLD_TITLE = 0; // Image document title field
PSP_CRTR_FLD_CRT_DATE = 1; // Creation date field
PSP_CRTR_FLD_MOD_DATE = 2; // Modification date field
PSP_CRTR_FLD_ARTIST = 3; // Artist name field
PSP_CRTR_FLD_CPYRGHT = 4; // Copyright holder name field
PSP_CRTR_FLD_DESC = 5; // Image document description field
PSP_CRTR_FLD_APP_ID = 6; // Creating app id field
PSP_CRTR_FLD_APP_VER = 7; // Creating app version field
// Creator application identifier
PSP_CREATOR_APP_UNKNOWN = 0; // Creator application unknown
PSP_CREATOR_APP_PAINT_SHOP_PRO = 1; // Creator is Paint Shop Pro
// Layer types (file version 3)
PSP_LAYER_NORMAL = 0; // Normal layer
PSP_LAYER_FLOATING_SELECTION = 1; // Floating selection layer
// Layer types (file version 4)
PSP_LAYER_UNDEFINED = 0; // Undefined layer type
PSP_LAYER_RASTER = 1; // Standard raster layer
PSP_LAYER_FLOATINGRASTERSELECTION = 2; // Floating selection (raster layer)
PSP_LAYER_Vector = 3; // Vector layer
PSP_LAYER_ADJUSTMENT = 4; // Adjustment layer
MagicID = 'Paint Shop Pro Image File';
type
// These block header structures are here for informational purposes only because the data of those
// headers is read member by member to generalize code for the different file versions
TPSPBlockHeader3 = packed record // block header file version 3
HeaderIdentifier: array[0..3] of Char; // i.e. "~BK" followed by a zero byte
BlockIdentifier: word; // one of the block identifiers
InitialChunkLength, // length of the first sub chunk header or similar
TotalBlockLength: cardinal; // length of this block excluding this header
end;
TPSPBlockHeader4 = packed record // block header file version 4
HeaderIdentifier: array[0..3] of Char; // i.e. "~BK" followed by a zero byte
BlockIdentifier: word; // one of the block identifiers
TotalBlockLength: cardinal; // length of this block excluding this header
end;
TPSPColorPaletteInfoChunk = packed record
EntryCount: cardinal; // number of entries in the palette
end;
TPSPColorPaletteChunk = array[0..255] of TRGBQuad; // might actually be shorter
TPSPChannelInfoChunk = packed record
CompressedSize,
UncompressedSize: cardinal;
BitmapType, // one of the bitmap types
ChannelType: word; // one of the channel types
end;
// PSP defines a channel content chunk which is just a bunch of bytes (size is CompressedSize).
// There is no sense to define this record type here.
TPSPFileHeader = packed record
Signature: array[0..31] of Char; // the string "Paint Shop Pro Image File\n\x1a", padded with zeroes
MajorVersion,
MinorVersion: word;
end;
TPSPImageAttributes = packed record
Width,Height: integer;
Resolution: double; // Number of pixels per metric
ResolutionMetric: byte; // Metric used for resolution (one of the metric constants)
Compression, // compression type of image (not thumbnail, it has its own compression)
BitDepth, // The bit depth of the color bitmap in each Layer of the image document
// (must be 1, 4, 8 or 24).
PlaneCount: word; // Number of planes in each layer of the image document (usually 1)
ColorCount: cardinal; // number of colors in each layer (2^bit depth)
GreyscaleFlag: boolean; // Indicates whether the color bitmap in each layer of image document is a
// greyscale (False = not greyscale, True = greyscale).
TotalImageSize: cardinal; // Sum of the sizes of all layer color bitmaps.
ActiveLayer: integer; // Identifies the layer that was active when the image document was saved.
LayerCount: word; // Number of layers in the document.
GraphicContents: cardinal; // A series of flags that helps define the image's graphic contents.
end;
TPSPLayerInfoChunk = packed record
//LayerName: array[0..255] of Char; // Name of layer (in ASCII text). Has been replaced in version 4
// by a Delphi like short string (length word and variable length string)
LayerType: byte; // Type of layer.
ImageRectangle, // Rectangle defining image border.
SavedImageRectangle: TRect; // Rectangle within image rectangle that contains "significant" data
// (only the contents of this rectangle are saved to the file).
LayerOpacity: byte; // Overall layer opacity.
BlendingMode: byte; // Mode to use when blending layer.
Visible: boolean; // TRUE if layer was visible at time of save, FALSE otherwise.
TransparencyProtected: boolean; // TRUE if transparency is protected.
LinkGroupIdentifier: byte; // Identifies group to which this layer belongs.
MaskRectangle, // Rectangle defining user mask border.
SavedMaskRectangle: TRect; // Rectangle within mask rectangle that contains "significant" data
// (only the contents of this rectangle are saved to the file).
MaskLinked: boolean; // TRUE if mask linked to layer (i.e., mask moves relative to layer)
MaskDisabled: boolean; // TRUE if mask is disabled, FALSE otherwise.
InvertMask: boolean; // TRUE if mask should be inverted when the layer is merged, FALSE otherwise.
BlendRangeCount: word; // Number of valid source-destination field pairs to follow (note, there are
// currently always 5 such pairs, but they are not necessarily all valid).
SourceBlendRange1, // First source blend range value.
DestinationBlendRange1, // First destination blend range value.
SourceBlendRange2,
DestinationBlendRange2,
SourceBlendRange3,
DestinationBlendRange3,
SourceBlendRange4,
DestinationBlendRange4,
SourceBlendRange5,
DestinationBlendRange5: array[0..3] of byte;
// these fields are obsolete since file version 4 because there's an own chunk for them
// BitmapCount: Word; // Number of bitmaps to follow.
// ChannelCount: Word; // Number of channels to follow.
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TPSPGraphic.CanLoad(Stream: PStream): boolean;
var Header: TPSPFileHeader;
LastPosition: cardinal;
begin
LastPosition:=Stream.Position;
Result:=(Stream.Size-Stream.Position)>sizeof(Header);
if Result then
begin
Stream.Read(Header,sizeof(Header));
Result:=(StrLIComp(Header.Signature,MagicID,Length(MagicID))=0) and (Header.MajorVersion>=3);
end;
Stream.Position:=LastPosition;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPSPGraphic.LoadFromStream(Stream: PStream);
var Header: TPSPFileHeader;
Image: TPSPImageAttributes;
// to use the code below for file 3 and 4 I read the parts of the block header
// separately instead as a structure
HeaderIdentifier: array[0..3] of Char; // i.e. "~BK" followed by a zero byte
BlockIdentifier: word; // one of the block identifiers
InitialChunkLength, // length of the first sub chunk header or similar
TotalBlockLength: cardinal; // length of this block excluding this header
LastPosition,ChunkSize: cardinal;
LayerInfo: TPSPLayerInfoChunk;
ChannelInfo: TPSPChannelInfoChunk;
LayerName: string;
NameLength: word;
NextLayerPosition,
NextMainBlock: integer;
// file version 4 specific data
BitmapCount,ChannelCount: word;
// load and decoding of image data
R,G,B,C: PByte;
RedBuffer,GreenBuffer,BlueBuffer,CompBuffer: pointer;
X,Y,Index,RowSize: integer; // size in bytes of one scanline
// other data
RawPalette: array[0..1023] of byte;
//--------------- local functions -------------------------------------------
function ReadBlockHeader: boolean;
// Fills in the block header variables according to the file version.
// Returns True if a block header could be read otherwise False (stream end).
begin
Result:=Stream.Position<Stream.Size;
//TotalBlockLength := 0;
if Result then
begin
Stream.Read(HeaderIdentifier,sizeof(HeaderIdentifier));
Stream.Read(BlockIdentifier,sizeof(BlockIdentifier));
if Header.MajorVersion=3 then Stream.Read(InitialChunkLength,sizeof(InitialChunkLength));
Stream.Read(TotalBlockLength,sizeof(TotalBlockLength));
end;
end;
//---------------------------------------------------------------------------
procedure ReadAndDecompress(Target: pointer);
// reads a stream of data from file stream and decompresses it into Target
var RawBuffer,Source: pointer;
{$IFDEF NOCLASSES} Decoder: PDecoder;
PSPRLEDecoder: PPSPRLEDecoder;
LZ77Decoder: PLZ77Decoder;
{$ELSE} Decoder: TDecoder; {$ENDIF}
begin
Decoder:=nil;
GetMem(RawBuffer,ChannelInfo.CompressedSize);
try
Stream.Read(RawBuffer^,ChannelInfo.CompressedSize);
// pointer might be advanced while decoding, so use a copy
Source:=RawBuffer;
case Image.Compression of
PSP_COMP_RLE:
begin
{$IFDEF NOCLASSES}
new( PSPRLEDecoder, Create ); Decoder := PSPRLEDecoder;
{$ELSE} Decoder:=TPSPRLEDecoder.Create; {$ENDIF}
Decoder.Decode(Source,Target,ChannelInfo.CompressedSize,ChannelInfo.UncompressedSize);
end;
PSP_COMP_LZ77:
begin
{$IFDEF NOCLASSES}
new( LZ77Decoder, Create(Z_FINISH,False) ); Decoder := LZ77Decoder;
{$ELSE} Decoder:=TLZ77Decoder.Create(Z_FINISH,False); {$ENDIF}
Decoder.DecodeInit;
Decoder.Decode(Source,Target,ChannelInfo.CompressedSize,ChannelInfo.UncompressedSize);
end;
PSP_COMP_JPEG: ; // here just for completeness, used only in thumbnails and composite images
end;
Decoder.DecodeEnd;
finally
if Assigned(RawBuffer) then FreeMem(RawBuffer);
Decoder.Free;
end;
end;
//---------------------------------------------------------------------------
procedure ReadChannelData;
// Reads the actual data of one channel from the current stream position.
// Decompression is done by the way.
begin
ReadBlockHeader;
if Header.MajorVersion>3 then Stream.Read(ChunkSize,sizeof(ChunkSize));
Stream.Read(ChannelInfo,sizeof(ChannelInfo));
case ChannelInfo.ChannelType of
PSP_CHANNEL_COMPOSITE: // single channel bitmap (indexed or transparency mask)
begin
if Assigned(CompBuffer) then FreeMem(CompBuffer);
GetMem(CompBuffer,ChannelInfo.UncompressedSize);
if Image.Compression<>PSP_COMP_NONE then
ReadAndDecompress(CompBuffer)
else
Stream.Read(CompBuffer^,ChannelInfo.CompressedSize);
end;
PSP_CHANNEL_RED: // red channel of 24 bit bitmap
begin
if Assigned(RedBuffer) then FreeMem(RedBuffer);
GetMem(RedBuffer,ChannelInfo.UncompressedSize);
if Image.Compression<>PSP_COMP_NONE then
ReadAndDecompress(RedBuffer)
else
Stream.Read(RedBuffer^,ChannelInfo.CompressedSize);
end;
PSP_CHANNEL_GREEN:
begin
if Assigned(GreenBuffer) then FreeMem(GreenBuffer);
GetMem(GreenBuffer,ChannelInfo.UncompressedSize);
if Image.Compression<>PSP_COMP_NONE then
ReadAndDecompress(GreenBuffer)
else
Stream.Read(GreenBuffer^,ChannelInfo.CompressedSize);
end;
PSP_CHANNEL_BLUE:
begin
if Assigned(BlueBuffer) then FreeMem(BlueBuffer);
GetMem(BlueBuffer,ChannelInfo.UncompressedSize);
if Image.Compression<>PSP_COMP_NONE then
ReadAndDecompress(BlueBuffer)
else
Stream.Read(BlueBuffer^,ChannelInfo.CompressedSize);
end;
end;
end;
//--------------- end local functions ---------------------------------------
var RowIncrement: Integer;
RowWidth: Integer;
RowOffset: Integer;
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
if ReadImageProperties(Stream,0) then
begin
Stream.Position:=FBasePosition;
RedBuffer:=nil;
GreenBuffer:=nil;
BlueBuffer:=nil;
CompBuffer := nil; //*//
with FImageProperties do
try
// Note: To be robust with future PSP images any reader must be able to skip data
// which it doesn't know instead of relying on the size of known structures.
// Hence there's some extra work needed with the stream (mainly to keep the
// current position before a chunk is read and advancing the stream using the
// chunk size field).
Stream.Read(Header,sizeof(Header));
// read general image attribute block
ReadBlockHeader;
LastPosition:=Stream.Position;
if Version>3 then Stream.Read(ChunkSize,sizeof(ChunkSize));
Stream.Read(Image,sizeof(Image));
Stream.Position:=LastPosition+TotalBlockLength;
//FBitmap:=NewBitmap(Width,Height);
with Image do
begin
ColorManager.SourceOptions:=[];
ColorManager.SourceBitsPerSample:=BitsPerSample;
ColorManager.TargetBitsPerSample:=BitsPerSample;
ColorManager.SourceSamplesPerPixel:=SamplesPerPixel;
ColorManager.TargetSamplesPerPixel:=SamplesPerPixel;
ColorManager.SourceColorScheme:=ColorScheme;
if ColorScheme=csRGB then ColorManager.TargetColorScheme:=csBGR
else ColorManager.TargetColorScheme:=ColorScheme;
//FBitmap.PixelFormat:=ColorManager.TargetPixelFormat;
FBitmap:=NewDibBitmap(Width,Height,ColorManager.TargetPixelFormat);
end;
// set bitmap properties
RowSize:=0; // make compiler quiet
case BitsPerSample of
1: RowSize:=(Image.Width+7) div 8;
4: RowSize:=Image.Width div 2+1;
8: RowSize:=Image.Width;
else
GraphicExError(2{gesInvalidColorFormat},['PSP']);
end;
// go through main blocks and read what is needed
repeat
if not ReadBlockHeader then Break;
NextMainBlock:=Stream.Position+TotalBlockLength;
// no more blocks?
if HeaderIdentifier[0]<>'~' then Break;
case BlockIdentifier of
PSP_COMPOSITE_IMAGE_BANK_BLOCK:
begin
// composite image block, if present then it must appear before the layer start block
// and represents a composition of several layers
// do not need to read anything further
//Break;
end;
PSP_LAYER_START_BLOCK:
repeat
if not ReadBlockHeader then Break;
// calculate start of next (layer) block in case we need to skip this one
NextLayerPosition:=Stream.Position+TotalBlockLength;
// if all layers have been considered the break loop to continue with other blocks if necessary
if BlockIdentifier<>PSP_LAYER_BLOCK then Break;
// layer information chunk
if Version>3 then
begin
LastPosition:=Stream.Position;
Stream.Read(ChunkSize,sizeof(ChunkSize));
Stream.Read(NameLength,sizeof(NameLength));
SetLength(LayerName,NameLength);
if NameLength>0 then Stream.Read(LayerName[1],NameLength);
Stream.Read(LayerInfo,sizeof(LayerInfo));
Stream.Position:=LastPosition+ChunkSize;
// continue only with undefined or raster chunks
if not (LayerInfo.LayerType in [PSP_LAYER_UNDEFINED,PSP_LAYER_RASTER]) then
begin
Stream.Position:=NextLayerPosition;
Continue;
end;
// in file version 4 there's also an additional bitmap chunk which replaces
// two fields formerly located in the LayerInfo chunk
LastPosition:=Stream.Position;
Stream.Read(ChunkSize,sizeof(ChunkSize));
end
else
begin
SetLength(LayerName,256);
Stream.Read(LayerName[1],256);
Stream.Read(LayerInfo,sizeof(LayerInfo));
// continue only with normal (raster) chunks
if LayerInfo.LayerType<>PSP_LAYER_NORMAL then
begin
Stream.Position:=NextLayerPosition;
Continue;
end;
end;
{if LayerInfo.Visible = 0 then
begin
Stream.Position:=NextLayerPosition;
Continue;
end;}
Stream.Read(BitmapCount,sizeof(BitmapCount));
Stream.Read(ChannelCount,sizeof(ChannelCount));
// But now we can reliably say whether we have an alpha channel or not.
// This kind of information can only be read very late and causes us to
// possibly reallocate the entire image (because it is copied by the VCL
// when changing the pixel format).
// I don't know another way (preferably before the size of the image is set).
//if BitmapCount > 0 then
begin
//Dec( BitmapCount );
if ChannelCount>3 then
begin
ColorManager.TargetColorScheme:=csBGRA;
FBitmap.PixelFormat:=pf32Bit;
end;
if Version>3 then Stream.Position:=LastPosition+ChunkSize;
// allocate memory for all channels and read raw data
for X:=0 to pred(ChannelCount) do
ReadChannelData;
R:=RedBuffer;
G:=GreenBuffer;
B:=BlueBuffer;
C:=CompBuffer;
TRY
RowWidth := LayerInfo.SavedImageRectangle.Right -
LayerInfo.SavedImageRectangle.Left;
CASE ImageProperties.BitsPerSample of
1: RowIncrement:=(RowWidth +7) div 8;
4: RowIncrement:=RowWidth div 2+1;
8: RowIncrement:=RowWidth;
else RowIncrement := RowSize;
end;
RowOffset := LayerInfo.SavedImageRectangle.Left *
((BitsPerSample + 7) div 8);
if ColorManager.TargetColorScheme in [csIndexed,csG] then
begin
//for Y:=0 to pred(Height) do
for Y:= LayerInfo.SavedImageRectangle.Top to
LayerInfo.SavedImageRectangle.Bottom do
begin
//ColorManager.ConvertRow([C],FBitmap.ScanLine[Y],Width,$FF);
ColorManager.ConvertRow([C],
Pointer( Integer( FBitmap.ScanLine[Y] ) + RowOffset ),
RowWidth,$FF);
Inc( C, RowIncrement ); //Inc(C,RowSize);
end;
end
else
begin
//for Y:=0 to pred(Height) do
for Y:= LayerInfo.SavedImageRectangle.Top to
LayerInfo.SavedImageRectangle.Bottom-1 do
begin
//ColorManager.ConvertRow([R,G,B,C],FBitmap.ScanLine[Y],Width,$FF);
ColorManager.ConvertRow([R,G,B,C],
Pointer( Integer( FBitmap.ScanLine[Y] ) + RowOffset ),
RowWidth,$FF);
Inc( R, RowIncrement ); //Inc(R,RowSize);
Inc( G, RowIncrement ); //Inc(G,RowSize);
Inc( B, RowIncrement ); //Inc(B,RowSize);
Inc( C, RowIncrement ); //Inc(C,RowSize);
end;
end;
FINALLY
{if Assigned(RedBuffer) then FreeMem(RedBuffer);
if Assigned(GreenBuffer) then FreeMem(GreenBuffer);
if Assigned(BlueBuffer) then FreeMem(BlueBuffer);
if Assigned(CompBuffer) then FreeMem(CompBuffer);
RedBuffer := nil;
GreenBuffer := nil;
BlueBuffer := nil;
CompBuffer := nil;}
END;
// after the raster layer has been read there's no need to loop further
asm
nop
end;
Break; //!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end;
until False; // layer loop
PSP_COLOR_BLOCK: // color palette block (this is also present for gray scale and b&w images)
begin
if Version>3 then Stream.Read(ChunkSize,sizeof(ChunkSize));
Stream.Read(Index,sizeof(Index));
Stream.Read(RawPalette,Index*sizeof(TRGBQuad));
ColorManager.CreateColorPalette(FBitmap,[@RawPalette],pfInterlaced8Quad,Index,True);
end;
end;
// explicitly set stream position to next main block as we might have read a block only partially
Stream.Position:=NextMainBlock;
until False; // main block loop
finally
if Assigned(RedBuffer) then FreeMem(RedBuffer);
if Assigned(GreenBuffer) then FreeMem(GreenBuffer);
if Assigned(BlueBuffer) then FreeMem(BlueBuffer);
if Assigned(CompBuffer) then FreeMem(BlueBuffer);
end;
end
else GraphicExError(1{gesInvalidImage},['PSP']);
end;
//----------------------------------------------------------------------------------------------------------------------
function TPSPGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Header: TPSPFileHeader;
Image: TPSPImageAttributes;
// to use the code below for file 3 and 4 I read the parts of the block header
// separately instead as a structure
HeaderIdentifier: array[0..3] of Char; // i.e. "~BK" followed by a zero byte
BlockIdentifier: word; // one of the block identifiers
InitialChunkLength, // length of the first sub chunk header or similar
TotalBlockLength: cardinal; // length of this block excluding this header
LastPosition,ChunkSize: cardinal;
//--------------- local functions -------------------------------------------
function ReadBlockHeader: Boolean;
// Fills in the block header variables according to the file version.
// Returns True if a block header could be read otherwise False (stream end).
begin
Result:=Stream.Position<Stream.Size;
if Result then
begin
Stream.Read(HeaderIdentifier,sizeof(HeaderIdentifier));
Stream.Read(BlockIdentifier,sizeof(BlockIdentifier));
if Header.MajorVersion=3 then Stream.Read(InitialChunkLength,sizeof(InitialChunkLength));
Stream.Read(TotalBlockLength,sizeof(TotalBlockLength));
end;
end;
//--------------- end local functions ---------------------------------------
begin
Result:=inherited ReadImageProperties(Stream,ImageIndex);
with FImageProperties do
begin
Stream.Read(Header, sizeof(Header));
if (StrLIComp(Header.Signature,MagicID,Length(MagicID))=0) and (Header.MajorVersion>=3) then
begin
Version:=Header.MajorVersion;
// read general image attribute block
ReadBlockHeader;
LastPosition:=Stream.Position;
if Header.MajorVersion>3 then Stream.Read(ChunkSize,sizeof(ChunkSize));
Stream.Read(Image,sizeof(Image));
Stream.Position:=LastPosition+TotalBlockLength;
if Image.BitDepth=24 then
begin
BitsPerSample:=8;
SamplesPerPixel:=3;
ColorScheme:=csRGB; // an alpha channel might exist, this is determined by the layer's channel count
end
else
begin
BitsPerSample:=Image.BitDepth;
SamplesPerPixel:=1;
if Image.GreyscaleFlag then ColorScheme:=csG else ColorScheme:=csIndexed;
end;
BitsPerPixel:=BitsPerSample*SamplesPerPixel;
Width:=Image.Width;
Height:=Image.Height;
case Image.Compression of
PSP_COMP_NONE: Compression:=ctNone;
PSP_COMP_RLE: Compression:=ctRLE;
PSP_COMP_LZ77: Compression:=ctLZ77;
PSP_COMP_JPEG: Compression:=ctJPEG;
else
Compression:=ctUnknown;
end;
XResolution:=Image.Resolution;
if Image.ResolutionMetric=PSP_METRIC_CM then XResolution:=XResolution*2.54;
YResolution:=XResolution;
Result:=True;
end;
end;
end;
//----------------- TPNGGraphic ----------------------------------------------------------------------------------------
const
PNGMagic: array[0..7] of Byte = (137,80,78,71,13,10,26,10);
// recognized and handled chunk types
IHDR = 'IHDR';
IDAT = 'IDAT';
IEND = 'IEND';
PLTE = 'PLTE';
gAMA = 'gAMA';
tRNS = 'tRNS';
bKGD = 'bKGD';
CHUNKMASK = $20; // used to check bit 5 in chunk types
type
// The following chunks structures are those which appear in the data field of the general chunk structure
// given above.
// chunk type: 'IHDR'
PIHDRChunk = ^TIHDRChunk;
TIHDRChunk = packed record
Width,
Height: cardinal;
BitDepth, // bits per sample (allowed are 1,2,4,8 and 16)
ColorType, // combination of:
// 1 - palette used
// 2 - colors used
// 4 - alpha channel used
// allowed values are:
// 0 - gray scale (allowed bit depths are: 1,2,4,8,16)
// 2 - RGB (8,16)
// 3 - palette (1,2,4,8)
// 4 - gray scale with alpha (8,16)
// 6 - RGB with alpha (8,16)
Compression, // 0 - LZ77, others are not yet defined
Filter, // filter mode 0 is the only one currently defined
Interlaced: byte; // 0 - not interlaced, 1 - Adam7 interlaced
end;
//----------------------------------------------------------------------------------------------------------------------
{$IFNDEF NOCLASSES} class {$ENDIF}
function TPNGGraphic.CanLoad(Stream: PStream): boolean;
var Magic: array[0..7] of byte;
LastPosition: cardinal;
begin
LastPosition:=Stream.Position;
Result:=(Stream.Size-Stream.Position)>sizeof(Magic);
if Result then
begin
Stream.Read(Magic,sizeof(Magic));
Result:=CompareMem(@Magic,@PNGMagic,8);
end;
Stream.Position:=LastPosition;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPNGGraphic.IsChunk(ChunkType: TChunkType): boolean;
// determines, independant of the cruxial 5ths bits in each "letter", whether the
// current chunk type in the header is the same as the given chunk type
const
Mask = not $20202020;
begin
Result:=(Cardinal(FHeader.ChunkType) and Mask)=(Cardinal(ChunkType) and Mask);
end;
//----------------------------------------------------------------------------------------------------------------------
function TPNGGraphic.LoadAndSwapHeader: cardinal;
// read next chunk header and swap fields to little endian,
// returns the intial CRC value for following checks
begin
FStream.Read(FHeader,sizeof(FHeader));
Result:=CRC32(0,@FHeader.ChunkType,4);
FHeader.Length:=SwapLong(FHeader.Length);
end;
//----------------------------------------------------------------------------------------------------------------------
function PaethPredictor(A,B,C: byte): byte;
var P,PA,PB,PC: integer;
begin
// a = left, b = above, c = upper left
P:=A+B-C; // initial estimate
PA:=Abs(P-A); // distances to a, b, c
PB:=Abs(P-B);
PC:=Abs(P-C);
// return nearest of a, b, c, breaking ties in order a, b, c
if (PA<=PB) and (PA<=PC) then Result:=A else
if PB<=PC then Result:=B else Result:=C;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPNGGraphic.ApplyFilter(Filter: byte; Line,PrevLine,Target: PByte; BPP,BytesPerRow: integer);
// Applies the filter given in Filter to all bytes in Line (eventually using PrevLine).
// Note: The filter type is assumed to be of filter mode 0, as this is the only one currently
// defined in PNG.
// In opposition to the PNG documentation different identifiers are used here.
// Raw refers to the current, not yet decoded value. Decoded refers to the current, already
// decoded value (this one is called "raw" in the docs) and Prior is the current value in the
// previous line. For the Paeth prediction scheme a fourth pointer is used (PriorDecoded) to describe
// the value in the previous line but less the BPP value (Prior[x - BPP]).
var I: integer;
Raw,Decoded,Prior,PriorDecoded,TargetRun: PByte;
begin
case Filter of
0: Move(Line^,Target^,BytesPerRow); // no filter, just copy data
1: begin // subtraction filter
Raw:=Line;
TargetRun:=Target;
// Transfer BPP bytes without filtering. This mimics the effect of bytes left to the
// scanline being zero.
Move(Raw^,TargetRun^,BPP);
// now do rest of the line
Decoded:=TargetRun;
Inc(Raw,BPP);
Inc(TargetRun,BPP);
Dec(BytesPerRow,BPP);
while BytesPerRow>0 do
begin
TargetRun^:=Byte(Raw^+Decoded^);
Inc(Raw);
Inc(Decoded);
Inc(TargetRun);
Dec(BytesPerRow);
end;
end;
2: begin // Up filter
Raw:=Line;
Prior:=PrevLine;
TargetRun:=Target;
while BytesPerRow>0 do
begin
TargetRun^:=Byte(Raw^+Prior^);
Inc(Raw);
Inc(Prior);
Inc(TargetRun);
Dec(BytesPerRow);
end;
end;
3: begin // average filter
// first handle BPP virtual pixels to the left
Raw:=Line;
Decoded:=Line;
Prior:=PrevLine;
TargetRun:=Target;
for I:=0 to pred(BPP) do
begin
TargetRun^:=Byte(Raw^+Floor(Prior^/2));
Inc(Raw);
Inc(Prior);
Inc(TargetRun);
end;
Dec(BytesPerRow,BPP);
// now do rest of line
while BytesPerRow>0 do
begin
TargetRun^:=Byte(Raw^+Floor((Decoded^+Prior^)/2));
Inc(Raw);
Inc(Decoded);
Inc(Prior);
Inc(TargetRun);
Dec(BytesPerRow);
end;
end;
4: begin // paeth prediction
// again, start with first BPP pixel which would refer to non-existing pixels to the left
Raw:=Line;
Decoded:=Target;
Prior:=PrevLine;
PriorDecoded:=PrevLine;
TargetRun:=Target;
for I:=0 to pred(BPP) do
begin
TargetRun^:=Byte(Raw^+PaethPredictor(0,Prior^,0));
Inc(Raw);
Inc(Prior);
Inc(TargetRun);
end;
Dec(BytesPerRow,BPP);
// finally do rest of line
while BytesPerRow>0 do
begin
TargetRun^:=Byte(Raw^+PaethPredictor(Decoded^,Prior^,PriorDecoded^));
Inc(Raw);
Inc(Decoded);
Inc(Prior);
Inc(PriorDecoded);
Inc(TargetRun);
Dec(BytesPerRow);
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPNGGraphic.LoadFromStream(Stream: PStream);
var Description: TIHDRChunk;
begin
// free previous image
if Assigned(FBitmap) then FBitmap.Free;
FBasePosition:=Stream.Position;
FDecoder:=nil;
FStream:=Stream;
if ReadImageProperties(Stream,0) then
begin
with FImageProperties do
begin
FBitmap:=NewBitmap(Width,Height);
Stream.Position:=FBasePosition+8; // skip magic
FBackgroundColor:=clWhite;
FTransparentColor:=clNone;
// first chunk must be an IHDR chunk
FCurrentCRC:=LoadAndSwapHeader;
FRawBuffer:=nil;
ColorManager.SourceOptions:=[coNeedByteSwap];
try
// read IHDR chunk
ReadDataAndCheckCRC;
Move(FRawBuffer^,Description,sizeof(Description));
SwapLong(@Description,2);
// currently only one compression type is supported by PNG (LZ77)
if Compression=ctLZ77 then
begin
{$IFDEF NOCLASSES}
new( FDecoder, Create(Z_PARTIAL_FLUSH,False) );
{$ELSE} FDecoder:=TLZ77Decoder.Create(Z_PARTIAL_FLUSH,False); {$ENDIF}
FDecoder.DecodeInit;
end
else
GraphicExError(5{gesUnsupportedFeature},[ErrorMsg[11]{gesCompressionScheme},PNG]);
// setup is done, now go for the chunks
repeat
FCurrentCRC:=LoadAndSwapHeader;
if IsChunk(IDAT) then
begin
LoadIDAT(Description);
// After reading the image data the next chunk header has already been loaded
// so continue with code below instead trying to load a new chunk header.
end
else
if IsChunk(PLTE) then
begin
// palette chunk
if (FHeader.Length mod 3)<>0 then GraphicExError(9{gesInvalidPalette},[PNG]);
ReadDataAndCheckCRC;
// load palette only if the image is indexed colors
if Description.ColorType=3 then
begin
// first setup pixel format before actually creating a palette
FSourceBPP:=SetupColorDepth(Description.ColorType,Description.BitDepth);
ColorManager.CreateColorPalette(FBitmap,[FRawBuffer],pfInterlaced8Triple,FHeader.Length div 3,True);
end;
Continue;
end
else
if IsChunk(gAMA) then
begin
ReadDataAndCheckCRC;
// the file gamme given here is a scaled cardinal (e.g. 0.45 is expressed as 45000)
ColorManager.SetGamma(SwapLong(PCardinal(FRawBuffer)^)/100000);
ColorManager.TargetOptions:=ColorManager.TargetOptions+[coApplyGamma];
Include(Options,ioUseGamma);
Continue;
end
else
if IsChunk(bKGD) then
begin
LoadBackgroundColor(Description);
Continue;
end
else
if IsChunk(tRNS) then
begin
LoadTransparency(Description);
Continue;
end;
// Skip unknown or unsupported chunks (+4 because of always present CRC).
// IEND will be skipped as well, but this chunk is empty, so the stream will correctly
// end on the first byte after the IEND chunk.
Stream.Seek(FHeader.Length+4,spCurrent);
if IsChunk(IEND) then Break;
// Note: According to the specs an unknown, but as critical marked chunk is a fatal error.
if (Byte(FHeader.ChunkType[0]) and CHUNKMASK)=0 then GraphicExError(10{gesUnknownCriticalChunk});
until False;
finally
if Assigned(FDecoder) then
begin
FDecoder.DecodeEnd;
FDecoder.Free;
end;
if Assigned(FRawBuffer) then FreeMem(FRawBuffer);
end;
end;
end
else GraphicExError(1{gesInvalidImage},[PNG]);
end;
//----------------------------------------------------------------------------------------------------------------------
function TPNGGraphic.ReadImageProperties(Stream: PStream; ImageIndex: cardinal): boolean;
var Magic: array[0..7] of byte;
Description: TIHDRChunk;
begin
Result:=inherited ReadImageProperties(Stream,ImageIndex);
FStream:=Stream;
with FImageProperties do
begin
Stream.Read(Magic,8);
if CompareMem(@Magic,@PNGMagic,8) then
begin
// first chunk must be an IHDR chunk
FCurrentCRC:=LoadAndSwapHeader;
if IsChunk(IHDR) then
begin
Include(Options,ioBigEndian);
// read IHDR chunk
ReadDataAndCheckCRC;
Move(FRawBuffer^,Description,sizeof(Description));
SwapLong(@Description,2);
if (Description.Width=0) or (Description.Height=0) then Exit;
Width:=Description.Width;
Height:=Description.Height;
if Description.Compression=0 then Compression:=ctLZ77 else Compression:=ctUnknown;
BitsPerSample:=Description.BitDepth;
SamplesPerPixel:=1;
case Description.ColorType of
0: ColorScheme:=csG;
2: begin
ColorScheme:=csRGB;
SamplesPerPixel:=3;
end;
3: ColorScheme:=csIndexed;
4: ColorScheme:=csGA;
6: begin
ColorScheme:=csRGBA;
SamplesPerPixel:=4;
end;
else ColorScheme:=csUnknown;
end;
BitsPerPixel:=SamplesPerPixel*BitsPerSample;
FilterMode:=Description.Filter;
Interlaced:=Description.Interlaced<>0;
HasAlpha:=ColorScheme in [csGA,csRGBA,csBGRA];
// find gamma
repeat
FCurrentCRC:=LoadAndSwapHeader;
if IsChunk(gAMA) then
begin
ReadDataAndCheckCRC;
// the file gamme given here is a scaled cardinal (e.g. 0.45 is expressed as 45000)
FileGamma:=SwapLong(PCardinal(FRawBuffer)^)/100000;
Break;
end;
Stream.Seek(FHeader.Length+4,spCurrent);
if IsChunk(IEND) then Break;
until False;
Result:=True;
end;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPNGGraphic.LoadBackgroundColor(const Description);
// loads the data from the current chunk (must be a bKGD chunk) and fills the bitmpap with that color
var Run: PWord;
R,G,B: byte;
begin
ReadDataAndCheckCRC;
with TIHDRChunk(Description) do
begin
case ColorType of
0,4: // G(A)
begin
case BitDepth of
2: FBackgroundColor:=MulDiv16(System.Swap(PWord(FRawBuffer)^),15,3);
16: FBackgroundColor:=MulDiv16(System.Swap(PWord(FRawBuffer)^),255,65535);
else // 1,4,8 bits gray scale
FBackgroundColor:=Byte(System.Swap(PWord(FRawBuffer)^));
end;
end;
2,6: // RGB(A)
begin
Run:=FRawBuffer;
if BitDepth=16 then
begin
R:=MulDiv16(System.Swap(Run^),255,65535);
Inc(Run);
G:=MulDiv16(System.Swap(Run^),255,65535);
Inc(Run);
B:=MulDiv16(System.Swap(Run^),255,65535);
end
else
begin
R:=Byte(System.Swap(Run^));
Inc(Run);
G:=Byte(System.Swap(Run^));
Inc(Run);
B:=Byte(System.Swap(Run^));
end;
FBackgroundColor:=Windows.RGB(R,G,B);
end;
else // indexed color scheme (3)
FBackgroundColor:=PByte(FRawBuffer)^;
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPNGGraphic.LoadIDAT(const Description);
// loads image data from the current position of the stream
const
// interlace start and offsets
RowStart: array[0..6] of integer = (0,0,4,0,2,0,1);
ColumnStart: array[0..6] of integer = (0,4,0,2,0,1,0);
RowIncrement: array[0..6] of integer = (8,8,8,4,4,2,2);
ColumnIncrement: array[0..6] of integer = (8,8,4,4,2,2,1);
PassMask: array[0..6] of byte = ($80,$08,$88,$22,$AA,$55,$FF);
var Row: Integer;
TargetBPP: integer;
RowBuffer: array[Boolean] of PChar; // I use PChar here instead of simple pointer to ease pointer math below
EvenRow: boolean; // distincts between the two rows we need to hold for filtering
Pass,BytesPerRow,InterlaceRowBytes,InterlaceWidth: integer;
begin
RowBuffer[False]:=nil;
RowBuffer[True]:=nil;
try
// we can set the dimensions too without
// initiating color conversions
if FBitmap=nil then FBitmap:=NewBitmap(TIHDRChunk(Description).Width,TIHDRChunk(Description).Height);
// adjust pixel format etc. if not yet done
if FBitmap.PixelFormat=pfDevice then FSourceBPP:=SetupColorDepth(TIHDRChunk(Description).ColorType,TIHDRChunk(Description).BitDepth);
if TIHDRChunk(Description).BitDepth=16 then TargetBPP:=FSourceBPP div 2 else TargetBPP:=FSourceBPP;
// set background and transparency color, these values must be set after the
// bitmap is actually valid (although, not filled)
FBitmap.Canvas.Brush.Color:=FBackgroundColor;
FBitmap.Canvas.FillRect(Rect(0,0,FBitmap.Width,FBitmap.Height));
// determine maximum number of bytes per row and consider there's one filter byte at the start of each row
BytesPerRow:=TargetBPP*((FBitmap.Width*TIHDRChunk(Description).BitDepth+7) div 8)+1;
RowBuffer[True]:=AllocMem(BytesPerRow);
RowBuffer[False]:=AllocMem(BytesPerRow);
// there can be more than one IDAT chunk in the file but then they must directly
// follow each other (handled in ReadRow)
EvenRow:=True;
// prepare interlaced images
if TIHDRChunk(Description).Interlaced=1 then
begin
for Pass:=0 to 6 do
begin
// prepare next interlace run
if FBitmap.Width<=ColumnStart[Pass] then Continue;
InterlaceWidth:=(FBitmap.Width+ColumnIncrement[Pass]-1-ColumnStart[Pass]) div ColumnIncrement[Pass];
InterlaceRowBytes:=TargetBPP*((InterlaceWidth*TIHDRChunk(Description).BitDepth+7) div 8)+1;
Row:=RowStart[Pass];
while Row<FBitmap.Height do
begin
ReadRow(RowBuffer[EvenRow],InterlaceRowBytes);
ApplyFilter(Byte(RowBuffer[EvenRow]^),Pointer(RowBuffer[EvenRow]+1),
Pointer(RowBuffer[not EvenRow]+1),Pointer(RowBuffer[EvenRow]+1),
FSourceBPP,InterlaceRowBytes-1);
ColorManager.ConvertRow([Pointer(RowBuffer[EvenRow]+1)],FBitmap.ScanLine[Row],FBitmap.Width,PassMask[Pass]);
EvenRow:=not EvenRow;
// continue with next row in interlaced order
Inc(Row,RowIncrement[Pass]);
end;
end;
end
else
begin
for Row:=0 to pred(FBitmap.Height) do
begin
ReadRow(RowBuffer[EvenRow],BytesPerRow);
ApplyFilter(Byte(RowBuffer[EvenRow]^),Pointer(RowBuffer[EvenRow]+1),
Pointer(RowBuffer[not EvenRow]+1),Pointer(RowBuffer[EvenRow]+1),
FSourceBPP,BytesPerRow-1);
ColorManager.ConvertRow([Pointer(RowBuffer[EvenRow]+1)],FBitmap.ScanLine[Row],FBitmap.Width,$FF);
EvenRow:=not EvenRow;
end;
end;
// in order to improve safe failness we read all remaining but not read IDAT chunks here
while IsChunk(IDAT) do
begin
ReadDataAndCheckCRC;
FCurrentCRC:=LoadAndSwapHeader;
end;
finally
if Assigned(RowBuffer[True]) then FreeMem(RowBuffer[True]);
if Assigned(RowBuffer[False]) then FreeMem(RowBuffer[False]);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPNGGraphic.LoadTransparency(const Description);
// reads the data of the current transparency chunk
var Run: PWord;
R,G,B: byte;
begin
ReadDataAndCheckCRC;
with TIHDRChunk(Description) do
begin
case ColorType of
0: // gray
begin
case BitDepth of
2: R:=MulDiv16(System.Swap(PWord(FRawBuffer)^),15,3);
16: R:=MulDiv16(System.Swap(PWord(FRawBuffer)^),255,65535);
else // 1,4,8 bits gray scale
R:=Byte(System.Swap(PWord(FRawBuffer)^));
end;
FTransparentColor:=Windows.RGB(R,R,R);
end;
2: // RGB
begin
Run:=FRawBuffer;
if BitDepth=16 then
begin
R:=MulDiv16(System.Swap(Run^),255,65535);
Inc(Run);
G:=MulDiv16(System.Swap(Run^),255,65535);
Inc(Run);
B:=MulDiv16(System.Swap(Run^),255,65535);
end
else
begin
R:=Byte(System.Swap(Run^));
Inc(Run);
G:=Byte(System.Swap(Run^));
Inc(Run);
B:=Byte(System.Swap(Run^));
end;
FTransparentColor:=Windows.RGB(R,G,B);
end;
4,6:
// formats with full alpha channel, they shouldn't have a transparent color
else
// Indexed color scheme (3), with at most 256 alpha values (for each palette entry).
SetLength(FTransparency,255);
// read the values (at most 256)...
Move(FRawBuffer^,FTransparency[0],KOL.Max(FHeader.Length,256));
// ...and set default values (255, fully opaque) for non-supplied values
if FHeader.Length<256 then FillChar(FTransparency[FHeader.Length],256-FHeader.Length,$FF);
end;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPNGGraphic.ReadDataAndCheckCRC;
// Allocates memory in FRawBuffer and reads the next Header.Length bytes from Stream.
// Furthermore, the CRC value following the data is read as well and compared with
// the CRC value which is calculated here.
var FileCRC: cardinal;
begin
ReallocMem(FRawBuffer,FHeader.Length);
FStream.Read(FRawBuffer^,FHeader.Length);
FStream.Read(FileCRC,sizeof(FileCRC));
FileCRC:=SwapLong(FileCRC);
// The type field of a chunk is included in the CRC, this serves as initial value
// for the calculation here and is determined in LoadAndSwapHeader.
FCurrentCRC:=CRC32(FCurrentCRC,FRawBuffer,FHeader.Length);
if FCurrentCRC<>FileCRC then GraphicExError(6{gesInvalidCRC},[PNG]);
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPNGGraphic.ReadRow(RowBuffer: pointer; BytesPerRow: integer);
// reads and decodes one scanline
var LocalBuffer: pointer;
PendingOutput: integer;
begin
LocalBuffer:=RowBuffer;
PendingOutput:=BytesPerRow;
repeat
// read pending chunk data if available input has dropped to zero
if FDecoder.AvailableInput=0 then
begin
FIDATSize:=0;
// read all following chunks until enough data is available or there is no further IDAT chunk
while FIDATSize=0 do
begin
// finish if the current chunk is not an IDAT chunk
if not IsChunk(IDAT) then Exit;
ReadDataAndCheckCRC;
FCurrentSource:=FRawBuffer;
FIDATSize:=FHeader.Length;
// prepare next chunk (plus CRC)
FCurrentCRC:=LoadAndSwapHeader;
end;
end;
// this decode call will advance Source and Target accordingly
FDecoder.Decode(FCurrentSource,LocalBuffer,
FIDATSize-(Integer(FCurrentSource)-Integer(FRawBuffer)),
PendingOutput);
if FDecoder.ZLibResult=Z_STREAM_END then
begin
if (FDecoder.AvailableOutput<>0) or (FDecoder.AvailableInput<>0) then GraphicExError(8{gesExtraCompressedData},[PNG]);
Break;
end;
if FDecoder.ZLibResult<>Z_OK then GraphicExError(7{gesCompression},[PNG]);
PendingOutput:=BytesPerRow-(Integer(LocalBuffer)-Integer(RowBuffer));
until PendingOutput=0;
end;
//----------------------------------------------------------------------------------------------------------------------
function TPNGGraphic.SetupColorDepth(ColorType,BitDepth: integer): integer;
begin
Result:=0;
// determine color scheme and setup related stuff,
// Note: The calculated BPP value is always at least 1 even for 1 bits per pixel etc. formats
// and used in filter calculation.
case ColorType of
0: // gray scale (allowed bit depths are: 1, 2, 4, 8, 16 bits)
if BitDepth in [1,2,4,8,16] then
begin
ColorManager.SourceColorScheme:=csG;
ColorManager.TargetColorScheme:=csG;
ColorManager.SourceSamplesPerPixel:=1;
ColorManager.TargetSamplesPerPixel:=1;
ColorManager.SourceBitsPerSample:=BitDepth;
// 2 bits values are converted to 4 bits values because DIBs don't know the former variant
case BitDepth of
2: ColorManager.TargetBitsPerSample:=4;
16: ColorManager.TargetBitsPerSample:=8;
else
ColorManager.TargetBitsPerSample:=BitDepth;
end;
FBitmap.PixelFormat:=ColorManager.TargetPixelFormat;
ColorManager.CreateGrayscalePalette(FBitmap,False);
Result:=(BitDepth+7) div 8;
end
else GraphicExError(2{gesInvalidColorFormat},[PNG]);
2: // RGB
if BitDepth in [8,16] then
begin
ColorManager.SourceSamplesPerPixel:=3;
ColorManager.TargetSamplesPerPixel:=3;
ColorManager.SourceColorScheme:=csRGB;
ColorManager.TargetColorScheme:=csBGR;
ColorManager.SourceBitsPerSample:=BitDepth;
ColorManager.TargetBitsPerSample:=8;
FBitmap.PixelFormat:=pf24Bit;
Result:=BitDepth*3 div 8;
end
else GraphicExError(2{gesInvalidColorFormat},[PNG]);
3: // palette
if BitDepth in [1,2,4,8] then
begin
ColorManager.SourceColorScheme:=csIndexed;
ColorManager.TargetColorScheme:=csIndexed;
ColorManager.SourceSamplesPerPixel:=1;
ColorManager.TargetSamplesPerPixel:=1;
ColorManager.SourceBitsPerSample:=BitDepth;
// 2 bits values are converted to 4 bits values because DIBs don't know the former variant
if BitDepth=2 then ColorManager.TargetBitsPerSample:=4 else ColorManager.TargetBitsPerSample:=BitDepth;
FBitmap.PixelFormat:=ColorManager.TargetPixelFormat;
Result:=1;
end
else GraphicExError(2{gesInvalidColorFormat},[PNG]);
4: // gray scale with alpha,
// For the moment this format is handled without alpha, but might later be converted
// to RGBA with gray pixels or use a totally different approach.
if BitDepth in [8,16] then
begin
ColorManager.SourceSamplesPerPixel:=1;
ColorManager.TargetSamplesPerPixel:=1;
ColorManager.SourceBitsPerSample:=BitDepth;
ColorManager.TargetBitsPerSample:=8;
ColorManager.SourceColorScheme:=csGA;
ColorManager.TargetColorScheme:=csIndexed;
FBitmap.PixelFormat:=pf8Bit;
ColorManager.CreateGrayScalePalette(FBitmap,False);
Result:=2*BitDepth div 8;
end
else GraphicExError(2{gesInvalidColorFormat},[PNG]);
6: // RGB with alpha (8, 16)
if BitDepth in [8,16] then
begin
ColorManager.SourceSamplesPerPixel:=4;
ColorManager.TargetSamplesPerPixel:=4;
ColorManager.SourceColorScheme:=csRGBA;
ColorManager.TargetColorScheme:=csBGRA;
ColorManager.SourceBitsPerSample:=BitDepth;
ColorManager.TargetBitsPerSample:=8;
FBitmap.PixelFormat:=pf32Bit;
Result:=BitDepth*4 div 8;
end
else GraphicExError(2{gesInvalidColorFormat},[PNG]);
else
GraphicExError(2{gesInvalidColorFormat},[PNG]);
end;
end;
//----------------------------------------------------------------------------------------------------------------------
end.
Reference in New Issue View Git Blame Copy Permalink