index 97e6c4e419fd8c966bc7a7577a53b33ba0421aff..89d862d2e02a7c9811f62eb4dbfa23d336cf2893 100644 (file)
{
{
- $Id: ImagingPortableMaps.pas 163 2009-07-28 21:44:10Z galfar $
Vampyre Imaging Library
by Marek Mauder
http://imaginglib.sourceforge.net
Vampyre Imaging Library
by Marek Mauder
http://imaginglib.sourceforge.net
protected
FIdNumbers: TChar2;
FSaveBinary: LongBool;
protected
FIdNumbers: TChar2;
FSaveBinary: LongBool;
+ FUSFormat: TFormatSettings;
+ procedure Define; override;
function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
OnlyFirstLevel: Boolean): Boolean; override;
function SaveDataInternal(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt; var MapInfo: TPortableMapInfo): Boolean;
public
function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
OnlyFirstLevel: Boolean): Boolean; override;
function SaveDataInternal(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt; var MapInfo: TPortableMapInfo): Boolean;
public
- constructor Create; override;
function TestFormat(Handle: TImagingHandle): Boolean; override;
published
{ If set to True images will be saved in binary format. If it is False
function TestFormat(Handle: TImagingHandle): Boolean; override;
published
{ If set to True images will be saved in binary format. If it is False
PBM images can be loaded but not saved. Loaded images are returned in
ifGray8 format (witch pixel values scaled from 1bit to 8bit).}
TPBMFileFormat = class(TPortableMapFileFormat)
PBM images can be loaded but not saved. Loaded images are returned in
ifGray8 format (witch pixel values scaled from 1bit to 8bit).}
TPBMFileFormat = class(TPortableMapFileFormat)
- public
- constructor Create; override;
+ protected
+ procedure Define; override;
end;
{ Portable Gray Map is used to store grayscale 8bit or 16bit images.
Raster data can be saved as text or binary data.}
TPGMFileFormat = class(TPortableMapFileFormat)
protected
end;
{ Portable Gray Map is used to store grayscale 8bit or 16bit images.
Raster data can be saved as text or binary data.}
TPGMFileFormat = class(TPortableMapFileFormat)
protected
+ procedure Define; override;
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt): Boolean; override;
procedure ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo); override;
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt): Boolean; override;
procedure ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo); override;
- public
- constructor Create; override;
end;
{ Portable Pixel Map is used to store RGB images with 8bit or 16bit channels.
Raster data can be saved as text or binary data.}
TPPMFileFormat = class(TPortableMapFileFormat)
protected
end;
{ Portable Pixel Map is used to store RGB images with 8bit or 16bit channels.
Raster data can be saved as text or binary data.}
TPPMFileFormat = class(TPortableMapFileFormat)
protected
+ procedure Define; override;
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt): Boolean; override;
procedure ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo); override;
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt): Boolean; override;
procedure ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo); override;
- public
- constructor Create; override;
end;
{ Portable Arbitrary Map is format that can store image data formats
end;
{ Portable Arbitrary Map is format that can store image data formats
ifR8G8B8, ifR16G16R16, ifA8R8G8B8, and ifA16R16G16B16.}
TPAMFileFormat = class(TPortableMapFileFormat)
protected
ifR8G8B8, ifR16G16R16, ifA8R8G8B8, and ifA16R16G16B16.}
TPAMFileFormat = class(TPortableMapFileFormat)
protected
+ procedure Define; override;
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt): Boolean; override;
procedure ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo); override;
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt): Boolean; override;
procedure ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo); override;
- public
- constructor Create; override;
end;
{ Portable Float Map is unofficial extension of PNM format family which
end;
{ Portable Float Map is unofficial extension of PNM format family which
or RGB images are supported by PFM format (so no alpha).}
TPFMFileFormat = class(TPortableMapFileFormat)
protected
or RGB images are supported by PFM format (so no alpha).}
TPFMFileFormat = class(TPortableMapFileFormat)
protected
+ procedure Define; override;
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt): Boolean; override;
procedure ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo); override;
function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
Index: LongInt): Boolean; override;
procedure ConvertToSupported(var Image: TImageData;
const Info: TImageFormatInfo); override;
- public
- constructor Create; override;
end;
implementation
end;
implementation
ifR8G8B8, ifR16G16B16, ifA8R8G8B8, ifA16R16G16B16];
SPFMFormatName = 'Portable Float Map';
SPFMMasks = '*.pfm';
ifR8G8B8, ifR16G16B16, ifA8R8G8B8, ifA16R16G16B16];
SPFMFormatName = 'Portable Float Map';
SPFMMasks = '*.pfm';
- PFMSupportedFormats = [ifR32F, ifA32B32G32R32F];
+ PFMSupportedFormats = [ifR32F, ifB32G32R32F];
const
{ TAB, CR, LF, and Space are used as seperators in Portable map headers and data.}
const
{ TAB, CR, LF, and Space are used as seperators in Portable map headers and data.}
{ TPortableMapFileFormat }
{ TPortableMapFileFormat }
-constructor TPortableMapFileFormat.Create;
+procedure TPortableMapFileFormat.Define;
begin
begin
- inherited Create;
- FCanLoad := True;
- FCanSave := True;
- FIsMultiImageFormat := False;
+ inherited;
+ FFeatures := [ffLoad, ffSave];
FSaveBinary := PortableMapDefaultBinary;
FSaveBinary := PortableMapDefaultBinary;
+ FUSFormat := GetFormatSettingsForFloats;
end;
function TPortableMapFileFormat.LoadData(Handle: TImagingHandle;
end;
function TPortableMapFileFormat.LoadData(Handle: TImagingHandle;
Dest: PByte;
MonoData: Pointer;
Info: TImageFormatInfo;
Dest: PByte;
MonoData: Pointer;
Info: TImageFormatInfo;
- PixelFP: TColorFPRec;
LineBuffer: array[0..LineBufferCapacity - 1] of AnsiChar;
LineEnd, LinePos: LongInt;
MapInfo: TPortableMapInfo;
LineBuffer: array[0..LineBufferCapacity - 1] of AnsiChar;
LineEnd, LinePos: LongInt;
MapInfo: TPortableMapInfo;
I: TTupleType;
TupleTypeName: string;
Scale: Single;
I: TTupleType;
TupleTypeName: string;
Scale: Single;
- OldSeparator: Char;
begin
Result := False;
with GetIO do
begin
Result := False;
with GetIO do
// Read header of PFM file
MapInfo.Width := ReadIntValue;
MapInfo.Height := ReadIntValue;
// Read header of PFM file
MapInfo.Width := ReadIntValue;
MapInfo.Height := ReadIntValue;
- OldSeparator := DecimalSeparator;
- DecimalSeparator := '.';
- Scale := StrToFloatDef(ReadString, 0);
- DecimalSeparator := OldSeparator;
+ Scale := StrToFloatDef(ReadString, 0, FUSFormat);
MapInfo.IsBigEndian := Scale > 0.0;
if Id[1] = 'F' then
MapInfo.TupleType := ttRGBFP
MapInfo.IsBigEndian := Scale > 0.0;
if Id[1] = 'F' then
MapInfo.TupleType := ttRGBFP
LineEnd := 0;
LinePos := 0;
SetLength(Images, 1);
LineEnd := 0;
LinePos := 0;
SetLength(Images, 1);
+
with GetIO, Images[0] do
begin
Format := ifUnknown;
with GetIO, Images[0] do
begin
Format := ifUnknown;
ttRGB: Format := IffFormat(MapInfo.BitCount = 8, ifR8G8B8, ifR16G16B16);
ttRGBAlpha: Format := IffFormat(MapInfo.BitCount = 8, ifA8R8G8B8, ifA16R16G16B16);
ttGrayScaleFP: Format := ifR32F;
ttRGB: Format := IffFormat(MapInfo.BitCount = 8, ifR8G8B8, ifR16G16B16);
ttRGBAlpha: Format := IffFormat(MapInfo.BitCount = 8, ifA8R8G8B8, ifA16R16G16B16);
ttGrayScaleFP: Format := ifR32F;
- ttRGBFP: Format := ifA32B32G32R32F;
+ ttRGBFP: Format := ifB32G32R32F;
end;
// Exit if no matching data format was found
if Format = ifUnknown then Exit;
end;
// Exit if no matching data format was found
if Format = ifUnknown then Exit;
// FP images are in BGR order and endian swap maybe needed.
// Some programs store scanlines in bottom-up order but
// I will stick with Photoshops behaviour here
// FP images are in BGR order and endian swap maybe needed.
// Some programs store scanlines in bottom-up order but
// I will stick with Photoshops behaviour here
- for I := 0 to Width * Height - 1 do
- begin
- Read(Handle, @PixelFP, MapInfo.BitCount div 8);
- if MapInfo.TupleType = ttRGBFP then
- with PColorFPRec(Dest)^ do
- begin
- A := 1.0;
- R := PixelFP.R;
- G := PixelFP.G;
- B := PixelFP.B;
- if MapInfo.IsBigEndian then
- SwapEndianLongWord(PLongWord(Dest), 3);
- end
- else
- begin
- PSingle(Dest)^ := PixelFP.B;
- if MapInfo.IsBigEndian then
- SwapEndianLongWord(PLongWord(Dest), 1);
- end;
- Inc(Dest, Info.BytesPerPixel);
- end;
+ Read(Handle, Bits, Size);
+ if MapInfo.IsBigEndian then
+ SwapEndianLongWord(PLongWord(Dest), Size div SizeOf(LongWord));
end;
if MapInfo.TupleType in [ttBlackAndWhite, ttBlackAndWhiteAlpha] then
end;
if MapInfo.TupleType in [ttBlackAndWhite, ttBlackAndWhiteAlpha] then
GetMem(MonoData, MonoSize);
try
Read(Handle, MonoData, MonoSize);
GetMem(MonoData, MonoSize);
try
Read(Handle, MonoData, MonoSize);
- Convert1To8(MonoData, Bits, Width, Height, ScanLineSize);
- // 1bit mono images must be scaled to 8bit (where 0=white, 1=black)
+ Convert1To8(MonoData, Bits, Width, Height, ScanLineSize, False);
+ // 1bit mono images must be scaled to 8bit, but inverted (where 0=white, 1=black)
for I := 0 to Width * Height - 1 do
PByteArray(Bits)[I] := 255 - PByteArray(Bits)[I] * 255;
finally
for I := 0 to Width * Height - 1 do
PByteArray(Bits)[I] := 255 - PByteArray(Bits)[I] * 255;
finally
end;
procedure WriteHeader;
end;
procedure WriteHeader;
- var
- OldSeparator: Char;
begin
WriteString('P' + MapInfo.FormatId);
if not MapInfo.HasPAMHeader then
begin
WriteString('P' + MapInfo.FormatId);
if not MapInfo.HasPAMHeader then
ttGrayScale, ttRGB: WriteString(IntToStr(Pow2Int(MapInfo.BitCount) - 1));
ttGrayScaleFP, ttRGBFP:
begin
ttGrayScale, ttRGB: WriteString(IntToStr(Pow2Int(MapInfo.BitCount) - 1));
ttGrayScaleFP, ttRGBFP:
begin
- OldSeparator := DecimalSeparator;
- DecimalSeparator := '.';
// Negative value indicates that raster data is saved in little endian
// Negative value indicates that raster data is saved in little endian
- WriteString(FloatToStr(-1.0));
- DecimalSeparator := OldSeparator;
+ WriteString(FloatToStr(-1.0, FUSFormat));
end;
end;
end
end;
end;
end
end
else
begin
end
else
begin
- // 8bit RGB/ARGB images: read and blue must be swapped and
+ // 8bit RGB/ARGB images: red and blue must be swapped and
// 3 or 4 bytes must be written
Src := Bits;
for I := 0 to Width * Height - 1 do
// 3 or 4 bytes must be written
Src := Bits;
for I := 0 to Width * Height - 1 do
begin
// Floating point images (no need to swap endian here - little
// endian is specified in file header)
begin
// Floating point images (no need to swap endian here - little
// endian is specified in file header)
- if MapInfo.TupleType = ttGrayScaleFP then
- begin
- // Grayscale images can be written in one Write call
- Write(Handle, Bits, Size);
- end
- else
- begin
- // Expected data format of PFM RGB file is B32G32R32F which is not
- // supported by Imaging. We must write pixels one by one and
- // write only RGB part of A32B32G32B32 image.
- Src := Bits;
- for I := 0 to Width * Height - 1 do
- begin
- Write(Handle, Src, SizeOf(Single) * 3);
- Inc(Src, Info.BytesPerPixel);
- end;
- end;
+ Write(Handle, Bits, Size);
end;
end;
Result := True;
end;
end;
Result := True;
{ TPBMFileFormat }
{ TPBMFileFormat }
-constructor TPBMFileFormat.Create;
+procedure TPBMFileFormat.Define;
begin
begin
- inherited Create;
+ inherited;
FName := SPBMFormatName;
FName := SPBMFormatName;
- FCanSave := False;
+ FFeatures := [ffLoad];
AddMasks(SPBMMasks);
FIdNumbers := '14';
end;
{ TPGMFileFormat }
AddMasks(SPBMMasks);
FIdNumbers := '14';
end;
{ TPGMFileFormat }
-constructor TPGMFileFormat.Create;
+procedure TPGMFileFormat.Define;
begin
begin
- inherited Create;
+ inherited;
FName := SPGMFormatName;
FSupportedFormats := PGMSupportedFormats;
AddMasks(SPGMMasks);
FName := SPGMFormatName;
FSupportedFormats := PGMSupportedFormats;
AddMasks(SPGMMasks);
{ TPPMFileFormat }
{ TPPMFileFormat }
-constructor TPPMFileFormat.Create;
+procedure TPPMFileFormat.Define;
begin
begin
- inherited Create;
+ inherited;
FName := SPPMFormatName;
FSupportedFormats := PPMSupportedFormats;
AddMasks(SPPMMasks);
FName := SPPMFormatName;
FSupportedFormats := PPMSupportedFormats;
AddMasks(SPPMMasks);
{ TPAMFileFormat }
{ TPAMFileFormat }
-constructor TPAMFileFormat.Create;
+procedure TPAMFileFormat.Define;
begin
begin
- inherited Create;
+ inherited;
FName := SPAMFormatName;
FSupportedFormats := PAMSupportedFormats;
AddMasks(SPAMMasks);
FName := SPAMFormatName;
FSupportedFormats := PAMSupportedFormats;
AddMasks(SPAMMasks);
{ TPFMFileFormat }
{ TPFMFileFormat }
-constructor TPFMFileFormat.Create;
+procedure TPFMFileFormat.Define;
begin
begin
- inherited Create;
+ inherited;
FName := SPFMFormatName;
AddMasks(SPFMMasks);
FIdNumbers := 'Ff';
FName := SPFMFormatName;
AddMasks(SPFMMasks);
FIdNumbers := 'Ff';
const Info: TImageFormatInfo);
begin
if (Info.ChannelCount > 1) or Info.IsIndexed then
const Info: TImageFormatInfo);
begin
if (Info.ChannelCount > 1) or Info.IsIndexed then
- ConvertImage(Image, ifA32B32G32R32F)
+ ConvertImage(Image, ifB32G32R32F)
else
ConvertImage(Image, ifR32F);
end;
else
ConvertImage(Image, ifR32F);
end;
-- TODOS ----------------------------------------------------
- nothing now
-- TODOS ----------------------------------------------------
- nothing now
+ -- 0.77.1 Changes/Bug Fixes -----------------------------------
+ - Native RGB floating point format of PFM is now supported by Imaging
+ so we use it now for saving instead of A32B32G32B32.
+ - String to float formatting changes (don't change global settings).
+
-- 0.26.3 Changes/Bug Fixes -----------------------------------
- Fixed D2009 Unicode related bug in PNM saving.
-- 0.26.3 Changes/Bug Fixes -----------------------------------
- Fixed D2009 Unicode related bug in PNM saving.