mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 10:39:18 +02:00
fcl-image JPEG reader/writer, PSD reader
fcl-image JPEG reader - procedure inside InternalRead moved to protected virtual methods fcl-image JPEG writer - procedure inside InternalWrite moved to protected virtual methods fcl-image PSD reader - code fixes for reading palettes, added Read of Image Resources Section
This commit is contained in:
Massimo Magnano
parent
486f3a0c7f
commit
fc714078a9
@ -16,6 +16,9 @@
|
||||
|
||||
ToDo:
|
||||
- palette
|
||||
|
||||
2023-07 - Massimo Magnano
|
||||
- procedure inside InternalRead moved to protected methods (virtual)
|
||||
}
|
||||
unit FPReadJPEG;
|
||||
|
||||
@ -45,9 +48,15 @@ type
|
||||
TJPEGScale = (jsFullSize, jsHalf, jsQuarter, jsEighth);
|
||||
TJPEGReadPerformance = (jpBestQuality, jpBestSpeed);
|
||||
|
||||
TExifOrientation = ( // all angles are clockwise
|
||||
eoUnknown, eoNormal, eoMirrorHor, eoRotate180, eoMirrorVert,
|
||||
eoMirrorHorRot270, eoRotate90, eoMirrorHorRot90, eoRotate270
|
||||
);
|
||||
|
||||
TFPReaderJPEG = class(TFPCustomImageReader)
|
||||
private
|
||||
FSmoothing: boolean;
|
||||
FSmoothing,
|
||||
Continue: boolean;
|
||||
FMinHeight:integer;
|
||||
FMinWidth:integer;
|
||||
FWidth: Integer;
|
||||
@ -59,13 +68,18 @@ type
|
||||
FInfo: jpeg_decompress_struct;
|
||||
FScale: TJPEGScale;
|
||||
FPerformance: TJPEGReadPerformance;
|
||||
FOrientation: TExifOrientation;
|
||||
|
||||
procedure SetPerformance(const AValue: TJPEGReadPerformance);
|
||||
procedure SetSmoothing(const AValue: boolean);
|
||||
protected
|
||||
procedure ReadHeader(Str: TStream; Img: TFPCustomImage); virtual;
|
||||
procedure ReadPixels(Str: TStream; Img: TFPCustomImage); virtual;
|
||||
procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
|
||||
function InternalCheck(Str: TStream): boolean; override;
|
||||
class function InternalSize(Str:TStream): TPoint; override;
|
||||
property CompressInfo : jpeg_decompress_struct Read Finfo Write FInfo;
|
||||
property Orientation: TExifOrientation Read FOrientation Write FOrientation;
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
@ -80,12 +94,6 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
TExifOrientation = ( // all angles are clockwise
|
||||
eoUnknown, eoNormal, eoMirrorHor, eoRotate180, eoMirrorVert,
|
||||
eoMirrorHorRot270, eoRotate90, eoMirrorHorRot90, eoRotate270
|
||||
);
|
||||
|
||||
procedure ReadCompleteStreamToStream(SrcStream, DestStream: TStream;
|
||||
StartSize: integer);
|
||||
var
|
||||
@ -170,56 +178,13 @@ begin
|
||||
FPerformance:=AValue;
|
||||
end;
|
||||
|
||||
procedure TFPReaderJPEG.InternalRead(Str: TStream; Img: TFPCustomImage);
|
||||
procedure TFPReaderJPEG.ReadHeader(Str: TStream; Img: TFPCustomImage);
|
||||
var
|
||||
MemStream: TMemoryStream;
|
||||
Orientation: TExifOrientation;
|
||||
|
||||
function TranslatePixel(const Px: TPoint): TPoint;
|
||||
begin
|
||||
case Orientation of
|
||||
eoUnknown, eoNormal: Result := Px;
|
||||
eoMirrorHor:
|
||||
begin
|
||||
Result.X := FInfo.output_width-1-Px.X;
|
||||
Result.Y := Px.Y;
|
||||
end;
|
||||
eoRotate180:
|
||||
begin
|
||||
Result.X := FInfo.output_width-1-Px.X;
|
||||
Result.Y := FInfo.output_height-1-Px.Y;
|
||||
end;
|
||||
eoMirrorVert:
|
||||
begin
|
||||
Result.X := Px.X;
|
||||
Result.Y := FInfo.output_height-1-Px.Y;
|
||||
end;
|
||||
eoMirrorHorRot270:
|
||||
begin
|
||||
Result.X := Px.Y;
|
||||
Result.Y := Px.X;
|
||||
end;
|
||||
eoRotate90:
|
||||
begin
|
||||
Result.X := FInfo.output_height-1-Px.Y;
|
||||
Result.Y := Px.X;
|
||||
end;
|
||||
eoMirrorHorRot90:
|
||||
begin
|
||||
Result.X := FInfo.output_height-1-Px.Y;
|
||||
Result.Y := FInfo.output_width-1-Px.X;
|
||||
end;
|
||||
eoRotate270:
|
||||
begin
|
||||
Result.X := Px.Y;
|
||||
Result.Y := FInfo.output_width-1-Px.X;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
S: TSize;
|
||||
|
||||
function TranslateSize(const Sz: TSize): TSize;
|
||||
begin
|
||||
case Orientation of
|
||||
case FOrientation of
|
||||
eoUnknown, eoNormal, eoMirrorHor, eoMirrorVert, eoRotate180: Result := Sz;
|
||||
eoMirrorHorRot270, eoRotate90, eoMirrorHorRot90, eoRotate270:
|
||||
begin
|
||||
@ -229,22 +194,13 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetSource;
|
||||
begin
|
||||
MemStream.Position:=0;
|
||||
jpeg_stdio_src(@FInfo, @MemStream);
|
||||
end;
|
||||
|
||||
procedure ReadHeader;
|
||||
var
|
||||
S: TSize;
|
||||
begin
|
||||
jpeg_read_header(@FInfo, TRUE);
|
||||
|
||||
if FInfo.saw_EXIF_marker and (FInfo.orientation >= Ord(Low(TExifOrientation))) and (FInfo.orientation <= Ord(High(TExifOrientation))) then
|
||||
Orientation := TExifOrientation(FInfo.orientation)
|
||||
FOrientation := TExifOrientation(FInfo.orientation)
|
||||
else
|
||||
Orientation := Low(TExifOrientation);
|
||||
FOrientation := Low(TExifOrientation);
|
||||
S := TranslateSize(TSize.Create(FInfo.image_width, FInfo.image_height));
|
||||
FWidth := S.Width;
|
||||
FHeight := S.Height;
|
||||
@ -253,6 +209,18 @@ var
|
||||
FProgressiveEncoding := jpeg_has_multiple_scans(@FInfo);
|
||||
end;
|
||||
|
||||
procedure TFPReaderJPEG.ReadPixels(Str: TStream; Img: TFPCustomImage);
|
||||
var
|
||||
SampArray: JSAMPARRAY;
|
||||
SampRow: JSAMPROW;
|
||||
Color: TFPColor;
|
||||
LinesRead: Cardinal;
|
||||
x: Integer;
|
||||
y: Integer;
|
||||
c: word;
|
||||
Status,Scan: integer;
|
||||
ReturnValue,RestartLoop: Boolean;
|
||||
|
||||
procedure InitReadingPixels;
|
||||
var d1,d2:integer;
|
||||
|
||||
@ -300,6 +268,57 @@ var
|
||||
end;
|
||||
end;
|
||||
|
||||
function TranslatePixel(const Px: TPoint): TPoint;
|
||||
begin
|
||||
case FOrientation of
|
||||
eoUnknown, eoNormal: Result := Px;
|
||||
eoMirrorHor:
|
||||
begin
|
||||
Result.X := FInfo.output_width-1-Px.X;
|
||||
Result.Y := Px.Y;
|
||||
end;
|
||||
eoRotate180:
|
||||
begin
|
||||
Result.X := FInfo.output_width-1-Px.X;
|
||||
Result.Y := FInfo.output_height-1-Px.Y;
|
||||
end;
|
||||
eoMirrorVert:
|
||||
begin
|
||||
Result.X := Px.X;
|
||||
Result.Y := FInfo.output_height-1-Px.Y;
|
||||
end;
|
||||
eoMirrorHorRot270:
|
||||
begin
|
||||
Result.X := Px.Y;
|
||||
Result.Y := Px.X;
|
||||
end;
|
||||
eoRotate90:
|
||||
begin
|
||||
Result.X := FInfo.output_height-1-Px.Y;
|
||||
Result.Y := Px.X;
|
||||
end;
|
||||
eoMirrorHorRot90:
|
||||
begin
|
||||
Result.X := FInfo.output_height-1-Px.Y;
|
||||
Result.Y := FInfo.output_width-1-Px.X;
|
||||
end;
|
||||
eoRotate270:
|
||||
begin
|
||||
Result.X := Px.Y;
|
||||
Result.Y := FInfo.output_width-1-Px.X;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetPixel(x, y: integer; const C: TFPColor);
|
||||
var
|
||||
P: TPoint;
|
||||
begin
|
||||
P := TPoint.Create(x,y);
|
||||
P := TranslatePixel(P);
|
||||
Img.Colors[P.x, P.y] := C;
|
||||
end;
|
||||
|
||||
function CorrectCMYK(const C: TFPColor): TFPColor;
|
||||
var
|
||||
MinColor: word;
|
||||
@ -314,6 +333,7 @@ var
|
||||
Result.blue:=(C.blue-MinColor) shl 8;
|
||||
Result.alpha:=alphaOpaque;
|
||||
end;
|
||||
|
||||
function CorrectYCCK(const C: TFPColor): TFPColor;
|
||||
var
|
||||
MinColor: word;
|
||||
@ -327,26 +347,8 @@ var
|
||||
Result.blue:=(C.blue-MinColor) shl 8;
|
||||
Result.alpha:=alphaOpaque;
|
||||
end;
|
||||
procedure ReadPixels;
|
||||
procedure SetPixel(x, y: integer; const C: TFPColor);
|
||||
var
|
||||
P: TPoint;
|
||||
begin
|
||||
P := TPoint.Create(x,y);
|
||||
P := TranslatePixel(P);
|
||||
Img.Colors[P.x, P.y] := C;
|
||||
end;
|
||||
var
|
||||
Continue: Boolean;
|
||||
SampArray: JSAMPARRAY;
|
||||
SampRow: JSAMPROW;
|
||||
Color: TFPColor;
|
||||
LinesRead: Cardinal;
|
||||
x: Integer;
|
||||
y: Integer;
|
||||
c: word;
|
||||
Status,Scan: integer;
|
||||
ReturnValue,RestartLoop: Boolean;
|
||||
|
||||
|
||||
procedure OutputScanLines();
|
||||
var
|
||||
x: integer;
|
||||
@ -496,6 +498,12 @@ var
|
||||
Progress(psEnding, 100, false, Rect(0,0,0,0), '', Continue);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure TFPReaderJPEG.InternalRead(Str: TStream; Img: TFPCustomImage);
|
||||
var
|
||||
MemStream: TMemoryStream;
|
||||
|
||||
begin
|
||||
FWidth:=0;
|
||||
FHeight:=0;
|
||||
@ -517,9 +525,12 @@ begin
|
||||
FProgressMgr.pub.progress_monitor := @ProgressCallback;
|
||||
FProgressMgr.instance := Self;
|
||||
FInfo.progress := @FProgressMgr.pub;
|
||||
SetSource;
|
||||
ReadHeader;
|
||||
ReadPixels;
|
||||
|
||||
MemStream.Position:=0;
|
||||
jpeg_stdio_src(@FInfo, @MemStream);
|
||||
|
||||
ReadHeader(MemStream, Img);
|
||||
ReadPixels(MemStream, Img);
|
||||
finally
|
||||
jpeg_Destroy_Decompress(@FInfo);
|
||||
end;
|
||||
@ -535,18 +546,6 @@ var
|
||||
JInfo: jpeg_decompress_struct;
|
||||
JError: jpeg_error_mgr;
|
||||
|
||||
procedure SetSource;
|
||||
begin
|
||||
jpeg_stdio_src(@JInfo, @Str);
|
||||
end;
|
||||
|
||||
procedure ReadHeader;
|
||||
begin
|
||||
jpeg_read_header(@JInfo, TRUE);
|
||||
Result.X := JInfo.image_width;
|
||||
Result.Y := JInfo.image_height;
|
||||
end;
|
||||
|
||||
begin
|
||||
FillChar(JInfo,SizeOf(JInfo),0);
|
||||
if Str.Position < Str.Size then begin
|
||||
@ -554,8 +553,11 @@ begin
|
||||
JInfo.err := @JError;
|
||||
jpeg_CreateDecompress(@JInfo, JPEG_LIB_VERSION, SizeOf(JInfo));
|
||||
try
|
||||
SetSource;
|
||||
ReadHeader;
|
||||
jpeg_stdio_src(@JInfo, @Str);
|
||||
|
||||
jpeg_read_header(@JInfo, TRUE);
|
||||
Result.X := JInfo.image_width;
|
||||
Result.Y := JInfo.image_height;
|
||||
finally
|
||||
jpeg_Destroy_Decompress(@JInfo);
|
||||
end;
|
||||
|
||||
@ -14,6 +14,11 @@
|
||||
**********************************************************************
|
||||
|
||||
ToDo: read further images
|
||||
|
||||
2023-07 - Massimo Magnano
|
||||
- code fixes for reading palettes
|
||||
- added Read of Image Resources Section
|
||||
|
||||
}
|
||||
unit FPReadPSD;
|
||||
|
||||
@ -24,6 +29,133 @@ interface
|
||||
uses
|
||||
Classes, SysUtils, FPimage;
|
||||
|
||||
const
|
||||
{ Image color modes }
|
||||
PSD_BITMAP = 0; { Bitmap image }
|
||||
PSD_GRAYSCALE = 1; { Greyscale image }
|
||||
PSD_INDEXED = 2; { Indexed image }
|
||||
PSD_RGB = 3; { RGB image }
|
||||
PSD_CMYK = 4; { CMYK }
|
||||
PSD_MULTICHANNEL = 7; { Multichannel image }
|
||||
PSD_DUOTONE = 8; { Duotone image }
|
||||
PSD_LAB = 9; { L*a*b image }
|
||||
|
||||
{ Image color spaces }
|
||||
PSD_CS_RGB = 0; { RGB }
|
||||
PSD_CS_HSB = 1; { Hue, Saturation, Brightness }
|
||||
PSD_CS_CMYK = 2; { CMYK }
|
||||
PSD_CS_PANTONE = 3; { Pantone matching system (Lab) }
|
||||
PSD_CS_FOCOLTONE = 4; { Focoltone color system (CMYK) }
|
||||
PSD_CS_TRUMATCH = 5; { Trumatch color (CMYK) }
|
||||
PSD_CS_TOYO = 6; { Toyo 88 colorfinder 1050 (Lab) }
|
||||
PSD_CS_LAB = 7; { L*a*b }
|
||||
PSD_CS_GRAYSCALE = 8; { Grey scale }
|
||||
PSD_CS_HKS = 10; { HKS colors (CMYK) }
|
||||
PSD_CS_DIC = 11; { DIC color guide (Lab) }
|
||||
PSD_CS_ANPA = 3000; { Anpa color (Lab) }
|
||||
|
||||
{ Image Resource IDs }
|
||||
PSD_ResourceSectionSignature ='8BIM';
|
||||
|
||||
PSD_PS2_IMAGE_INFO = $03e8; { Obsolete - ps 2.0 image info }
|
||||
PSD_MAC_PRINT_INFO = $03e9; { Optional - Mac print manager print info record }
|
||||
PSD_PS2_COLOR_TAB = $03eb; { Obsolete - ps 2.0 indexed color table }
|
||||
PSD_RESN_INFO = $03ed; { ResolutionInfo structure }
|
||||
PSD_ALPHA_NAMES = $03ee; { Alpha channel names }
|
||||
PSD_DISPLAY_INFO = $03ef; { Superceded by PSD_DISPLAY_INFO_NEW for ps CS3 and higher - DisplayInfo structure }
|
||||
PSD_CAPTION = $03f0; { Optional - Caption string }
|
||||
PSD_BORDER_INFO = $03f1; { Border info }
|
||||
PSD_BACKGROUND_COL = $03f2; { Background color }
|
||||
PSD_PRINT_FLAGS = $03f3; { Print flags }
|
||||
PSD_GREY_HALFTONE = $03f4; { Greyscale and multichannel halftoning info }
|
||||
PSD_COLOR_HALFTONE = $03f5; { Color halftoning info }
|
||||
PSD_DUOTONE_HALFTONE = $03f6; { Duotone halftoning info }
|
||||
PSD_GREY_XFER = $03f7; { Greyscale and multichannel transfer functions }
|
||||
PSD_COLOR_XFER = $03f8; { Color transfer functions }
|
||||
PSD_DUOTONE_XFER = $03f9; { Duotone transfer functions }
|
||||
PSD_DUOTONE_INFO = $03fa; { Duotone image information }
|
||||
PSD_EFFECTIVE_BW = $03fb; { Effective black & white values for dot range }
|
||||
PSD_OBSOLETE_01 = $03fc; { Obsolete }
|
||||
PSD_EPS_OPT = $03fd; { EPS options }
|
||||
PSD_QUICK_MASK = $03fe; { Quick mask info }
|
||||
PSD_OBSOLETE_02 = $03ff; { Obsolete }
|
||||
PSD_LAYER_STATE = $0400; { Layer state info }
|
||||
PSD_WORKING_PATH = $0401; { Working path (not saved) }
|
||||
PSD_LAYER_GROUP = $0402; { Layers group info }
|
||||
PSD_OBSOLETE_03 = $0403; { Obsolete }
|
||||
PSD_IPTC_NAA_DATA = $0404; { IPTC-NAA record (IMV4.pdf) }
|
||||
PSD_IMAGE_MODE_RAW = $0405; { Image mode for raw format files }
|
||||
PSD_JPEG_QUAL = $0406; { JPEG quality }
|
||||
PSD_GRID_GUIDE = $0408; { Grid & guide info }
|
||||
PSD_THUMB_RES = $0409; { Thumbnail resource }
|
||||
PSD_COPYRIGHT_FLG = $040a; { Copyright flag }
|
||||
PSD_URL = $040b; { URL string }
|
||||
PSD_THUMB_RES2 = $040c; { Thumbnail resource }
|
||||
PSD_GLOBAL_ANGLE = $040d; { Superceded by PSD_NEW_COLOR_SAMPLER for ps CS3 and higher - Global angle }
|
||||
PSD_COLOR_SAMPLER = $040e; { Superceded by PSD_NEW_COLOR_SAMPLER for ps CS3 and higher - Color samplers resource }
|
||||
PSD_ICC_PROFILE = $040f; { ICC Profile }
|
||||
PSD_WATERMARK = $0410; { Watermark }
|
||||
PSD_ICC_UNTAGGED = $0411; { Do not use ICC profile flag }
|
||||
PSD_EFFECTS_VISIBLE = $0412; { Show / hide all effects layers }
|
||||
PSD_SPOT_HALFTONE = $0413; { Spot halftone }
|
||||
PSD_DOC_IDS = $0414; { Document specific IDs }
|
||||
PSD_ALPHA_NAMES_UNI = $0415; { Unicode alpha names }
|
||||
PSD_IDX_COL_TAB_CNT = $0416; { Indexed color table count }
|
||||
PSD_IDX_TRANSPARENT = $0417; { Index of transparent color (if any) }
|
||||
PSD_GLOBAL_ALT = $0419; { Global altitude }
|
||||
PSD_SLICES = $041a; { Slices }
|
||||
PSD_WORKFLOW_URL_UNI = $041b; { Workflow URL - Unicode string }
|
||||
PSD_JUMP_TO_XPEP = $041c; { Jump to XPEP (?) }
|
||||
PSD_ALPHA_ID = $041d; { Alpha IDs }
|
||||
PSD_URL_LIST_UNI = $041e; { URL list - unicode }
|
||||
PSD_VERSION_INFO = $0421; { Version info }
|
||||
PSD_EXIF_DATA = $0422; { Exif data block 1 }
|
||||
PSD_EXIF_DATA_3 = $0423; { Exif data block 3 (?) }
|
||||
PSD_XMP_DATA = $0424; { XMP data block }
|
||||
PSD_CAPTION_DIGEST = $0425; { Caption digest }
|
||||
PSD_PRINT_SCALE = $0426; { Print scale }
|
||||
PSD_PIXEL_AR = $0428; { Pixel aspect ratio }
|
||||
PSD_LAYER_COMPS = $0429; { Layer comps }
|
||||
PSD_ALT_DUOTONE_COLOR = $042A;{ Alternative Duotone colors }
|
||||
PSD_ALT_SPOT_COLOR = $042B; { Alternative Spot colors }
|
||||
PSD_LAYER_SELECT_ID = $042D; { Layer selection ID }
|
||||
PSD_HDR_TONING_INFO = $042E; { HDR toning information }
|
||||
PSD_PRINT_INFO_SCALE = $042F; { Print scale }
|
||||
PSD_LAYER_GROUP_E_ID = $0430; { Layer group(s) enabled ID }
|
||||
PSD_COLOR_SAMPLER_NEW = $0431;{ Color sampler resource for ps CS3 and higher PSD files }
|
||||
PSD_MEASURE_SCALE = $0432; { Measurement scale }
|
||||
PSD_TIMELINE_INFO = $0433; { Timeline information }
|
||||
PSD_SHEET_DISCLOSE = $0434; { Sheet discloser }
|
||||
PSD_DISPLAY_INFO_NEW = $0435; { DisplayInfo structure for ps CS3 and higher PSD files }
|
||||
PSD_ONION_SKINS = $0436; { Onion skins }
|
||||
PSD_COUNT_INFO = $0438; { Count information }
|
||||
PSD_PRINT_INFO = $043A; { Print information added in ps CS5 }
|
||||
PSD_PRINT_STYLE = $043B; { Print style }
|
||||
PSD_MAC_NSPRINTINFO = $043C; { Mac NSPrintInfo }
|
||||
PSD_WIN_DEVMODE = $043D; { Windows DEVMODE }
|
||||
PSD_AUTO_SAVE_PATH = $043E; { Auto save file path }
|
||||
PSD_AUTO_SAVE_FORMAT = $043F; { Auto save format }
|
||||
PSD_PATH_INFO_FIRST = $07d0; { First path info block }
|
||||
PSD_PATH_INFO_LAST = $0bb6; { Last path info block }
|
||||
PSD_CLIPPING_PATH = $0bb7; { Name of clipping path }
|
||||
PSD_PLUGIN_R_FIRST = $0FA0; { First plugin resource }
|
||||
PSD_PLUGIN_R_LAST = $1387; { Last plugin resource }
|
||||
PSD_IMAGEREADY_VARS = $1B58; { Imageready variables }
|
||||
PSD_IMAGEREADY_DATA = $1B59; { Imageready data sets }
|
||||
PSD_LIGHTROOM_WORK = $1F40; { Lightroom workflow }
|
||||
PSD_PRINT_FLAGS_2 = $2710; { Print flags }
|
||||
|
||||
{ Display resolution units }
|
||||
PSD_RES_INCH = 1; { Pixels / inch }
|
||||
PSD_RES_CM = 2; { Pixels / cm }
|
||||
|
||||
{ Width and height units }
|
||||
PSD_UNIT_INCH = 1; { inches }
|
||||
PSD_UNIT_CM = 2; { cm }
|
||||
PSD_UNIT_POINT = 3; { points (72 points = 1 inch) }
|
||||
PSD_UNIT_PICA = 4; { pica ( 6 pica = 1 inch) }
|
||||
PSD_UNIT_COLUMN = 5;{ columns ( column defined in ps prefs, default = 2.5 inches) }
|
||||
|
||||
type
|
||||
TRGB = packed record
|
||||
Red, Green, Blue : Byte;
|
||||
@ -33,7 +165,7 @@ type
|
||||
L, a, b: byte;
|
||||
end;
|
||||
|
||||
|
||||
{ File Header Section }
|
||||
TPSDHeader = packed record
|
||||
Signature : array[0..3] of Char; // File IDs '8BPS'
|
||||
Version : word; // Version number, always 1
|
||||
@ -42,70 +174,31 @@ type
|
||||
Rows : Cardinal; // Height of image in pixels (1-30000)
|
||||
Columns : Cardinal; // Width of image in pixels (1-30000)
|
||||
Depth : Word; // Number of bits per channel (1, 8, and 16)
|
||||
Mode: Word; // Color mode
|
||||
Mode: Word; // Color mode (see previous Image color modes consts)
|
||||
end;
|
||||
{
|
||||
Mode Description
|
||||
0 Bitmap (monochrome)
|
||||
1 Gray-scale
|
||||
2 Indexed color (palette color)
|
||||
3 RGB color
|
||||
4 CMYK color
|
||||
7 Multichannel color
|
||||
8 Duotone (halftone)
|
||||
9 Lab color
|
||||
}
|
||||
|
||||
TColorModeDataBlock = packed record
|
||||
{ Image Resource Blocks }
|
||||
TPSDResourceBlock = packed record
|
||||
Types : array[0..3] of Char; // Always "8BIM"
|
||||
ID:word; // (See table below)
|
||||
Name:byte; // Even-length Pascal-format string, 2 bytes or longer
|
||||
Size : Cardinal; // Length of resource data following, in bytes
|
||||
Data:byte; // Resource data, padded to even length
|
||||
ID:word; // see previous Image Resource IDs consts
|
||||
NameLen:Byte; // Pascal-format string, 2 bytes or longer
|
||||
Name:Char;
|
||||
end;
|
||||
{
|
||||
ID Data Format Description
|
||||
03e8 WORD[5] Channels, rows, columns, depth, and mode
|
||||
03e9 Optional Macintosh print manager information
|
||||
03eb Indexed color table
|
||||
03ed (See below) Resolution information
|
||||
"TResolutionInfo"
|
||||
03ee BYTE[] Alpha channel names (Pascal-format strings)
|
||||
03ef (See below) Display information for each channel
|
||||
"TDisplayInfo"
|
||||
03f0 BYTE[] Optional Pascal-format caption string
|
||||
03f1 LONG, WORD Fixed-point border width, border units (see below)
|
||||
03f2 Background color
|
||||
03f3 BYTE[8] Print flags (see below)
|
||||
03f4 Gray-scale and halftoning information
|
||||
03f5 Color halftoning information
|
||||
03f6 Duotone halftoning information
|
||||
03f7 Gray-scale and multichannel transfer function
|
||||
03f8 Color transfer functions
|
||||
03f9 Duotone transfer functions
|
||||
03fa Duotone image information
|
||||
03fb BYTE[2] Effective black and white value for dot range
|
||||
03fc
|
||||
03fd EPS options
|
||||
03fe WORD, BYTE Quick Mask channel ID, flag for mask initially empty
|
||||
03ff
|
||||
0400 WORD Index of target layer (0=bottom)
|
||||
0401 Working path
|
||||
0402 WORD[] Layers group info, group ID for dragging groups
|
||||
0403
|
||||
0404 IPTC-NAA record
|
||||
0405 Image mode for raw-format files
|
||||
0406 JPEG quality (Adobe internal)
|
||||
07d0
|
||||
0bb6 Saved path information
|
||||
0bb7 Clipping pathname
|
||||
2710 (See below) Print flags information
|
||||
}
|
||||
PPSDResourceBlock =^TPSDResourceBlock;
|
||||
|
||||
TPSDResourceBlockData = packed record
|
||||
Size:LongWord;
|
||||
Data:Byte;
|
||||
end;
|
||||
PPSDResourceBlockData =^TPSDResourceBlockData;
|
||||
|
||||
//MaxM: Resolution always recorded in a fixed point implied decimal int32
|
||||
// with 16 bits before point and 16 after (cast as DWord and divide resolution by 2^16
|
||||
TResolutionInfo = record
|
||||
hRes:Cardinal; // Fixed-point number: pixels per inch
|
||||
hRes:Cardinal; // Fixed-point number: pixels per inch (see note before)
|
||||
hResUnit:word; // 1=pixels per inch, 2=pixels per centimeter
|
||||
WidthUnit:word; // 1=in, 2=cm, 3=pt, 4=picas, 5=columns
|
||||
vRes:Cardinal; // Fixed-point number: pixels per inch
|
||||
vRes:Cardinal; // Fixed-point number: pixels per inch (see note before)
|
||||
vResUnit:word; // 1=pixels per inch, 2=pixels per centimeter
|
||||
HeightUnit:word; // 1=in, 2=cm, 3=pt, 4=picas, 5=columns
|
||||
end;
|
||||
@ -131,7 +224,6 @@ type
|
||||
FOnCreateImage: TPSDCreateCompatibleImgEvent;
|
||||
protected
|
||||
FHeader : TPSDHeader;
|
||||
FColorDataBlock: TColorModeDataBlock;
|
||||
FBytesPerPixel : Byte;
|
||||
FScanLine : PByte;
|
||||
FLineSize : PtrInt;
|
||||
@ -146,6 +238,8 @@ type
|
||||
procedure CreateBWPalette;
|
||||
function ReadPalette(Stream: TStream): boolean;
|
||||
procedure AnalyzeHeader;
|
||||
procedure ReadResourceBlockData(Img: TFPCustomImage; blockID:Word;
|
||||
blockName:ShortString; Size:LongWord; Data:Pointer); virtual;
|
||||
procedure InternalRead(Stream: TStream; Img: TFPCustomImage); override;
|
||||
function ReadScanLine(Stream: TStream): boolean; virtual;
|
||||
procedure WriteScanLine(Img: TFPCustomImage); virtual;
|
||||
@ -233,37 +327,57 @@ end;
|
||||
|
||||
function TFPReaderPSD.ReadPalette(Stream: TStream): boolean;
|
||||
Var
|
||||
I : Integer;
|
||||
c : TFPColor;
|
||||
OldPos: Integer;
|
||||
BufSize:Longint;
|
||||
PalBuf: array[0..767] of Byte;
|
||||
|
||||
procedure ReadPaletteFromStream;
|
||||
var
|
||||
i : Integer;
|
||||
c : TFPColor;
|
||||
{%H-}PalBuf: array[0..767] of Byte;
|
||||
ContProgress: Boolean;
|
||||
|
||||
begin
|
||||
Result:=false;
|
||||
ThePalette.count := 0;
|
||||
OldPos := Stream.Position;
|
||||
BufSize:=0;
|
||||
Stream.Read(BufSize, SizeOf(BufSize));
|
||||
BufSize:=BEtoN(BufSize);
|
||||
Stream.Read(PalBuf, BufSize);
|
||||
Stream.Read({%H-}PalBuf, BufSize);
|
||||
ContProgress:=true;
|
||||
Progress(FPimage.psRunning, trunc(100.0 * (Stream.position / Stream.size)),
|
||||
False, Rect(0,0,0,0), '', ContProgress);
|
||||
Progress(FPimage.psRunning, 0, False, Rect(0,0,0,0), '', ContProgress);
|
||||
if not ContProgress then exit;
|
||||
For I:=0 To BufSize div 3 Do
|
||||
Begin
|
||||
With c do
|
||||
for i:=0 to BufSize div 3 do
|
||||
begin
|
||||
with c do
|
||||
begin
|
||||
Red:=PalBuf[I] shl 8;
|
||||
Green:=PalBuf[I+(BufSize div 3)] shl 8;
|
||||
Blue:=PalBuf[I+(BufSize div 3)* 2] shl 8;
|
||||
Alpha:=alphaOpaque;
|
||||
end;
|
||||
ThePalette.Add(C);
|
||||
End;
|
||||
Stream.Position := OldPos;
|
||||
Result:=true;
|
||||
FPalette.Add(c);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result:=False;
|
||||
BufSize:=0;
|
||||
Stream.Read(BufSize, SizeOf(BufSize));
|
||||
BufSize:=BEtoN(BufSize);
|
||||
|
||||
Case FHeader.Mode of
|
||||
PSD_BITMAP :begin // Bitmap (monochrome)
|
||||
FPalette := TFPPalette.Create(0);
|
||||
CreateBWPalette;
|
||||
end;
|
||||
PSD_GRAYSCALE,
|
||||
PSD_DUOTONE:begin // Gray-scale or Duotone image
|
||||
FPalette := TFPPalette.Create(0);
|
||||
CreateGrayPalette;
|
||||
end;
|
||||
PSD_INDEXED:begin // Indexed color (palette color)
|
||||
FPalette := TFPPalette.Create(0);
|
||||
if (BufSize=0) then exit;
|
||||
ReadPaletteFromStream;
|
||||
end;
|
||||
end;
|
||||
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
procedure TFPReaderPSD.AnalyzeHeader;
|
||||
@ -288,12 +402,76 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPReaderPSD.ReadResourceBlockData(Img: TFPCustomImage; blockID: Word;
|
||||
blockName: ShortString; Size: LongWord; Data: Pointer);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TFPReaderPSD.InternalRead(Stream: TStream; Img: TFPCustomImage);
|
||||
var
|
||||
H: Integer;
|
||||
BufSize:Cardinal;
|
||||
Encoding:word;
|
||||
ContProgress: Boolean;
|
||||
|
||||
procedure ReadResourceBlocks;
|
||||
var
|
||||
TotalBlockSize,
|
||||
pPosition:LongWord;
|
||||
blockData,
|
||||
curBlock :PPSDResourceBlock;
|
||||
curBlockData :PPSDResourceBlockData;
|
||||
signature:String[4];
|
||||
blockName:ShortString;
|
||||
blockID:Word;
|
||||
dataSize:LongWord;
|
||||
|
||||
begin
|
||||
//MaxM: Do NOT Remove the Casts after BEToN
|
||||
Stream.Read(TotalBlockSize, 4);
|
||||
TotalBlockSize :=BEtoN(DWord(TotalBlockSize));
|
||||
GetMem(blockData, TotalBlockSize);
|
||||
try
|
||||
Stream.Read(blockData^, TotalBlockSize);
|
||||
|
||||
pPosition :=0;
|
||||
curBlock :=blockData;
|
||||
|
||||
repeat
|
||||
signature :=curBlock^.Types;
|
||||
|
||||
if (signature=PSD_ResourceSectionSignature) then
|
||||
begin
|
||||
blockID :=BEtoN(Word(curBlock^.ID));
|
||||
blockName :=curBlock^.Name;
|
||||
setLength(blockName, curBlock^.NameLen);
|
||||
curBlockData :=PPSDResourceBlockData(curBlock);
|
||||
|
||||
Inc(Pointer(curBlockData), sizeof(TPSDResourceBlock));
|
||||
|
||||
if (curBlock^.NameLen>0) then //MaxM: Maybe tested, in all my tests is always 0
|
||||
begin
|
||||
Inc(Pointer(curBlockData), curBlock^.NameLen);
|
||||
if not(Odd(curBlock^.NameLen))
|
||||
then Inc(Pointer(curBlockData), 1);
|
||||
end;
|
||||
|
||||
dataSize :=BEtoN(DWord(curBlockData^.Size));
|
||||
Inc(Pointer(curBlockData), 4);
|
||||
ReadResourceBlockData(Img, blockID, blockName, dataSize, curBlockData);
|
||||
Inc(Pointer(curBlockData), dataSize);
|
||||
end
|
||||
else Inc(Pointer(curBlockData), 1); //skip padding or something went wrong, search for next '8BIM'
|
||||
|
||||
curBlock :=PPSDResourceBlock(curBlockData);
|
||||
pPosition :=Pointer(curBlockData)-Pointer(blockData);
|
||||
until (pPosition >= TotalBlockSize);
|
||||
|
||||
finally
|
||||
FreeMem(blockData, TotalBlockSize);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
FScanLine:=nil;
|
||||
FPalette:=nil;
|
||||
@ -307,35 +485,17 @@ begin
|
||||
Progress(FPimage.psRunning, trunc(100.0 * (Stream.position / Stream.size)), False, Rect(0,0,0,0), '', ContProgress);
|
||||
if not ContProgress then exit;
|
||||
AnalyzeHeader;
|
||||
Case FHeader.Mode of
|
||||
0:begin // Bitmap (monochrome)
|
||||
FPalette := TFPPalette.Create(0);
|
||||
CreateBWPalette;
|
||||
end;
|
||||
1, 8:begin // Gray-scale
|
||||
FPalette := TFPPalette.Create(0);
|
||||
CreateGrayPalette;
|
||||
end;
|
||||
2:begin // Indexed color (palette color)
|
||||
FPalette := TFPPalette.Create(0);
|
||||
if not ReadPalette(stream) then exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// color palette
|
||||
ReadPalette(Stream);
|
||||
|
||||
if Assigned(OnCreateImage) then
|
||||
OnCreateImage(Self,Img);
|
||||
Img.SetSize(FWidth,FHeight);
|
||||
|
||||
// color palette
|
||||
BufSize:=0;
|
||||
Stream.Read(BufSize, SizeOf(BufSize));
|
||||
BufSize:=BEtoN(BufSize);
|
||||
Stream.Seek(BufSize, soCurrent);
|
||||
// color data block
|
||||
Stream.Read(BufSize, SizeOf(BufSize));
|
||||
BufSize:=BEtoN(BufSize);
|
||||
Stream.Read(FColorDataBlock, SizeOf(FColorDataBlock));
|
||||
Stream.Seek(BufSize-SizeOf(FColorDataBlock), soCurrent);
|
||||
// Image Resources Section
|
||||
ReadResourceBlocks;
|
||||
|
||||
// mask
|
||||
Stream.Read(BufSize, SizeOf(BufSize));
|
||||
BufSize:=BEtoN(BufSize);
|
||||
|
||||
@ -13,6 +13,10 @@
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation, Inc.,
|
||||
51 Franklin Street, Fifth Floor, Boston, MA 02111-1301, USA.
|
||||
|
||||
2023-07 - Massimo Magnano
|
||||
- procedure inside InternalWrite moved to protected methods (virtual)
|
||||
|
||||
}
|
||||
unit FPWriteJPEG;
|
||||
|
||||
@ -31,14 +35,16 @@ type
|
||||
|
||||
TFPWriterJPEG = class(TFPCustomImageWriter)
|
||||
private
|
||||
FGrayscale: boolean;
|
||||
FGrayscale, Continue: Boolean;
|
||||
FInfo: jpeg_compress_struct;
|
||||
FError: jpeg_error_mgr;
|
||||
FProgressiveEncoding: boolean;
|
||||
FQuality: TFPJPEGCompressionQuality;
|
||||
FProgressMgr: TFPJPEGProgressManager;
|
||||
protected
|
||||
procedure InitWriting; virtual;
|
||||
procedure InitWriting(Str: TStream; Img: TFPCustomImage); virtual;
|
||||
procedure WriteHeader(Str: TStream; Img: TFPCustomImage); virtual;
|
||||
procedure WritePixels(Str: TStream; Img: TFPCustomImage); virtual;
|
||||
procedure InternalWrite(Str: TStream; Img: TFPCustomImage); override;
|
||||
property CompressInfo : jpeg_compress_struct Read FInfo Write FInfo;
|
||||
public
|
||||
@ -98,7 +104,7 @@ end;
|
||||
{ TFPWriterJPEG }
|
||||
|
||||
|
||||
procedure TFPWriterJPEG.InitWriting;
|
||||
procedure TFPWriterJPEG.InitWriting(Str: TStream; Img: TFPCustomImage);
|
||||
begin
|
||||
FError := jpeg_std_error;
|
||||
FInfo := Default(jpeg_compress_struct);
|
||||
@ -107,24 +113,9 @@ begin
|
||||
FInfo.progress := @FProgressMgr.pub;
|
||||
FProgressMgr.pub.progress_monitor := @ProgressCallback;
|
||||
FProgressMgr.instance := Self;
|
||||
|
||||
end;
|
||||
|
||||
procedure TFPWriterJPEG.InternalWrite(Str: TStream; Img: TFPCustomImage);
|
||||
var
|
||||
MemStream: TMemoryStream;
|
||||
Continue: Boolean;
|
||||
|
||||
procedure SetDestination;
|
||||
begin
|
||||
if Str is TMemoryStream then
|
||||
MemStream:=TMemoryStream(Str)
|
||||
else
|
||||
MemStream := TMemoryStream.Create;
|
||||
jpeg_stdio_dest(@FInfo, @MemStream);
|
||||
end;
|
||||
|
||||
procedure WriteHeader;
|
||||
procedure TFPWriterJPEG.WriteHeader(Str: TStream; Img: TFPCustomImage);
|
||||
begin
|
||||
FInfo.image_width := Img.Width;
|
||||
FInfo.image_height := Img.Height;
|
||||
@ -146,7 +137,7 @@ var
|
||||
jpeg_simple_progression(@FInfo);
|
||||
end;
|
||||
|
||||
procedure WritePixels;
|
||||
procedure TFPWriterJPEG.WritePixels(Str: TStream; Img: TFPCustomImage);
|
||||
var
|
||||
LinesWritten: Cardinal;
|
||||
SampArray: JSAMPARRAY;
|
||||
@ -189,6 +180,19 @@ var
|
||||
Progress(psEnding, 100, False, Rect(0,0,0,0), '', Continue);
|
||||
end;
|
||||
|
||||
procedure TFPWriterJPEG.InternalWrite(Str: TStream; Img: TFPCustomImage);
|
||||
var
|
||||
MemStream: TMemoryStream;
|
||||
|
||||
procedure SetDestination;
|
||||
begin
|
||||
if Str is TMemoryStream then
|
||||
MemStream:=TMemoryStream(Str)
|
||||
else
|
||||
MemStream := TMemoryStream.Create;
|
||||
jpeg_stdio_dest(@FInfo, @MemStream);
|
||||
end;
|
||||
|
||||
procedure EndWriting;
|
||||
begin
|
||||
jpeg_destroy_compress(@FInfo);
|
||||
@ -198,10 +202,10 @@ begin
|
||||
Continue := true;
|
||||
MemStream:=nil;
|
||||
try
|
||||
InitWriting;
|
||||
InitWriting(Str, Img);
|
||||
SetDestination;
|
||||
WriteHeader;
|
||||
WritePixels;
|
||||
WriteHeader(MemStream, Img);
|
||||
WritePixels(MemStream, Img);
|
||||
if MemStream<>Str then begin
|
||||
MemStream.Position:=0;
|
||||
Str.CopyFrom(MemStream,MemStream.Size);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user