Writer don't use Reader but common files; Some method to protected

packages/fcl-image/src/fpreadjpeg.pas

@@ -28,13 +28,11 @@ unit FPReadJPEG;
 interface
 
 uses
-  Classes, SysUtils, Types, FPImage, JPEGLib, JdAPImin, JDataSrc, JdAPIstd, JmoreCfg;
+  Classes, SysUtils, Types, FPImage, JPEGcomn, JPEGLib, JdAPImin, JDataSrc, JdAPIstd, JmoreCfg;
 
 type
-  { TFPReaderJPEG }
-  { This is a FPImage reader for jpeg images. }
-
-  TFPReaderJPEG = class;
+  //MaxM: these common types should stay only in JPEGcomn units, but we should change LCL uses
+  TFPJPEGCompressionQuality = 1..100;   // 100 = best quality, 25 = pretty awful
 
   PFPJPEGProgressManager = ^TFPJPEGProgressManager;
   TFPJPEGProgressManager = record
@@ -54,6 +52,9 @@ type
     eoMirrorHorRot270, eoRotate90, eoMirrorHorRot90, eoRotate270
   );
 
+  { TFPReaderJPEG }
+  { This is a FPImage reader for jpeg images. }
+
   TFPReaderJPEG = class(TFPCustomImageReader)
   private
     FSmoothing,
@@ -94,9 +95,6 @@ type
   end;
 
 
-function density_unitToResolutionUnit(Adensity_unit: UINT8): TResolutionUnit;
-function ResolutionUnitTodensity_unit(AResolutionUnit: TResolutionUnit): UINT8;
-
 implementation
 
 procedure ReadCompleteStreamToStream(SrcStream, DestStream: TStream;
@@ -169,24 +167,6 @@ begin
   // ToDo
 end;
 
-function density_unitToResolutionUnit(Adensity_unit: UINT8): TResolutionUnit;
-begin
-  Case Adensity_unit of
-  1: Result :=ruPixelsPerInch;
-  2: Result :=ruPixelsPerCentimeter;
-  else Result :=ruNone;
-  end;
-end;
-
-function ResolutionUnitTodensity_unit(AResolutionUnit: TResolutionUnit): UINT8;
-begin
-  Case AResolutionUnit of
-  ruPixelsPerInch: Result :=1;
-  ruPixelsPerCentimeter: Result :=2;
-  else Result :=0;
-  end;
-end;
-
 { TFPReaderJPEG }
 
 procedure TFPReaderJPEG.SetSmoothing(const AValue: boolean);

packages/fcl-image/src/fpreadpng.pp

@@ -21,18 +21,11 @@ uses
   SysUtils,Classes, FPImage, FPImgCmn, PNGComn, ZStream;
 
 Type
+  { TFPReaderPNG }
 
   TSetPixelProc = procedure (x,y:integer; CD : TColordata) of object;
   TConvertColorProc = function (CD:TColorData) : TFPColor of object;
 
-  TPNGPhysicalDimensions = packed record
-    X_Pixels, Y_Pixels :DWord;
-    Unit_Specifier :Byte;
-  end;
-  PPNGPhysicalDimensions=^TPNGPhysicalDimensions;
-
-  { TFPReaderPNG }
-
   TFPReaderPNG = class (TFPCustomImageReader)
     private
 

packages/fcl-image/src/fpreadpnm.pp

@@ -52,7 +52,7 @@ type
       FBitPP        : Byte;
       FScanLineSize : Integer;
       FScanLine   : PByte;
-      procedure ReadHeader(Stream : TStream);
+      procedure ReadHeader(Stream : TStream); virtual;
       function  InternalCheck (Stream:TStream):boolean;override;
       procedure InternalRead(Stream:TStream;Img:TFPCustomImage);override;
       procedure ReadScanLine(Row : Integer; Stream:TStream);

packages/fcl-image/src/fpreadpsd.pas

@@ -28,190 +28,9 @@ unit FPReadPSD;
 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)  }
+  Classes, SysUtils, PSDcomn, FPimage;
 
 type
-  TRGB = packed record
-    Red, Green, Blue : Byte;
-  end;
-
-  TLab = record
-    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
-    Reserved : array[0..5] of Byte;    // Reserved, must be zeroed
-    Channels : Word;                   // Number of color channels (1-24) including alpha channels
-    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 (see previous  Image color modes consts)
-  end;
-
-  { Image Resource Blocks }
-  TPSDResourceBlock = packed record
-    Types : array[0..3] of Char;   // Always "8BIM"
-    ID:word;                       // see previous Image Resource IDs consts
-    NameLen:Byte;                  // Pascal-format string, 2 bytes or longer
-    Name:Char;
-  end;
-  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  (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  (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;
-
-  TDisplayInfo = record
-    ColorSpace:word;
-    Color:array[0..3] of word;
-    Opacity:word;          // 0-100
-    Kind:byte;             // 0=selected, 1=protected
-    Padding:byte;          // Always zero
-  end;
-
   TFPReaderPSD = class;
 
   TPSDCreateCompatibleImgEvent = procedure(Sender: TFPReaderPSD;
@@ -258,9 +77,6 @@ type
     property OnCreateImage: TPSDCreateCompatibleImgEvent read FOnCreateImage write FOnCreateImage;
   end;
 
-function PSDResolutionUnitToResolutionUnit(APSDResolutionUnit: Word): TResolutionUnit;
-function ResolutionUnitToPSdResolutionUnit(AResolutionUnit: TResolutionUnit): Word;
-
 implementation
 
 function CorrectCMYK(const C : TFPColor): TFPColor;
@@ -301,24 +117,6 @@ begin
   Result:=colBlack;
 end;
 
-function PSDResolutionUnitToResolutionUnit(APSDResolutionUnit: Word): TResolutionUnit;
-begin
-  Case APSDResolutionUnit of
-  PSD_RES_INCH: Result :=ruPixelsPerInch;
-  PSD_RES_CM: Result :=ruPixelsPerCentimeter;
-  else Result :=ruNone;
-  end;
-end;
-
-function ResolutionUnitToPSdResolutionUnit(AResolutionUnit: TResolutionUnit): Word;
-begin
-  Case AResolutionUnit of
-  ruPixelsPerInch: Result :=PSD_RES_INCH;
-  ruPixelsPerCentimeter: Result :=PSD_RES_CM;
-  else Result :=0;
-  end;
-end;
-
 { TFPReaderPSD }
 
 procedure TFPReaderPSD.CreateGrayPalette;

packages/fcl-image/src/fpreadtiff.pas

@@ -58,12 +58,6 @@ type
   TTiffCreateCompatibleImgEvent = procedure(Sender: TFPReaderTiff;
                                             ImgFileDir: TTiffIFD) of object;
 
-  TTiffCheckIFDOrder = (
-    tcioSmart,
-    tcioAlways,
-    tcioNever
-    );
-
   { TFPReaderTiff }
 
   TFPReaderTiff = class(TFPCustomImageReader)
@@ -84,11 +78,6 @@ type
     procedure SetStreamPos(p: DWord);
     function ReadTiffHeader(QuickTest: boolean; out IFDStart: DWord): boolean; // returns IFD: offset to first IFD
     function ReadIFD(Start: DWord; IFD: TTiffIFD): DWord;// Image File Directory
-    procedure ReadDirectoryEntry(var EntryTag: Word; IFD: TTiffIFD);
-    function ReadEntryUnsigned: DWord;
-    function ReadEntrySigned: Cint32;
-    function ReadEntryRational: TTiffRational;
-    function ReadEntryString: string;
     function ReadByte: Byte;
     function ReadWord: Word;
     function ReadDWord: DWord;
@@ -112,6 +101,11 @@ type
     procedure DecodeLZW(var Buffer: Pointer; var Count: PtrInt);
     procedure DecodeDeflate(var Buffer: Pointer; var Count: PtrInt; ExpectedCount: PtrInt);
   protected
+    procedure ReadDirectoryEntry(var EntryTag: Word; IFD: TTiffIFD); virtual;
+    function ReadEntryUnsigned: DWord;
+    function ReadEntrySigned: Cint32;
+    function ReadEntryRational: TTiffRational;
+    function ReadEntryString: string;
     procedure InternalRead(Str: TStream; AnImage: TFPCustomImage); override;
     function InternalCheck(Str: TStream): boolean; override;
     procedure DoCreateImage(ImgFileDir: TTiffIFD); virtual;
@@ -153,9 +147,6 @@ function DecompressDeflate(Compressed: PByte; CompressedCount: cardinal;
   out Decompressed: PByte; var DecompressedCount: cardinal;
   ErrorMsg: PAnsiString = nil): boolean;
 
-function TifResolutionUnitToResolutionUnit(ATifResolutionUnit: DWord): TResolutionUnit;
-function ResolutionUnitToTifResolutionUnit(AResolutionUnit: TResolutionUnit): DWord;
-
 implementation
 
 function CMYKToFPColor(C,M,Y,K: Word): TFPColor;
@@ -2479,24 +2470,6 @@ begin
   Result:=true;
 end;
 
-function TifResolutionUnitToResolutionUnit(ATifResolutionUnit: DWord): TResolutionUnit;
-begin
-  Case ATifResolutionUnit of
-  2: Result :=ruPixelsPerInch;
-  3: Result :=ruPixelsPerCentimeter;
-  else Result :=ruNone;
-  end;
-end;
-
-function ResolutionUnitToTifResolutionUnit(AResolutionUnit: TResolutionUnit): DWord;
-begin
-  Case AResolutionUnit of
-  ruPixelsPerInch: Result :=2;
-  ruPixelsPerCentimeter: Result :=3;
-  else Result :=1;
-  end;
-end;
-
 
 initialization
   if ImageHandlers.ImageReader[TiffHandlerName]=nil then

packages/fcl-image/src/fptiffcmn.pas

@@ -100,12 +100,19 @@ const
   // Planar configuration - TIFF 6.0 spec p. 38
   TiffPlanarConfigurationChunky = 1; //Chunky format
   TiffPlanarConfigurationPlanar = 2; //Planar format
+
 type
   TTiffChunkType = (
     tctStrip,
     tctTile
     );
 
+  TTiffCheckIFDOrder = (
+    tcioSmart,
+    tcioAlways,
+    tcioNever
+    );
+
   { TTiffIFD - Image File Directory }
 
   TTiffIFD = class
@@ -177,6 +184,9 @@ procedure CopyTiffExtras(SrcImg, DestImg: TFPCustomImage);
 procedure WriteTiffExtras(Msg: string; Img: TFPCustomImage);
 function TiffCompressionName(c: Word): string;
 
+function TifResolutionUnitToResolutionUnit(ATifResolutionUnit: DWord): TResolutionUnit;
+function ResolutionUnitToTifResolutionUnit(AResolutionUnit: TResolutionUnit): DWord;
+
 implementation
 
 function TiffRationalToStr(const r: TTiffRational): string;
@@ -258,6 +268,24 @@ begin
   end;
 end;
 
+function TifResolutionUnitToResolutionUnit(ATifResolutionUnit: DWord): TResolutionUnit;
+begin
+  Case ATifResolutionUnit of
+  2: Result :=ruPixelsPerInch;
+  3: Result :=ruPixelsPerCentimeter;
+  else Result :=ruNone;
+  end;
+end;
+
+function ResolutionUnitToTifResolutionUnit(AResolutionUnit: TResolutionUnit): DWord;
+begin
+  Case AResolutionUnit of
+  ruPixelsPerInch: Result :=2;
+  ruPixelsPerCentimeter: Result :=3;
+  else Result :=1;
+  end;
+end;
+
 { TTiffIFD }
 
 procedure TTiffIFD.Clear;

packages/fcl-image/src/fpwritejpeg.pas

@@ -26,14 +26,12 @@ unit FPWriteJPEG;
 interface
 
 uses
-  Classes, SysUtils, FPImage, JPEGLib, FPReadJPEG, JcAPIstd, JcAPImin, JDataDst,
+  Classes, SysUtils, FPImage, JPEGLib, JPEGcomn, JcAPIstd, JcAPImin, JDataDst,
   JcParam, JError;
 
 type
   { TFPWriterJPEG }
 
-  TFPJPEGCompressionQuality = 1..100;   // 100 = best quality, 25 = pretty awful
-
   TFPWriterJPEG = class(TFPCustomImageWriter)
   private
     FGrayscale,   Continue: Boolean;

packages/fcl-image/src/fpwritepng.pp

@@ -106,8 +106,6 @@ type
 
 implementation
 
-uses FPReadPNG;
-
 constructor TFPWriterPNG.create;
 begin
   inherited;

packages/fcl-image/src/fpwritepnm.pp

@@ -36,6 +36,7 @@ type
     FBinaryFormat: boolean;
     procedure SetFullWidth(AValue: Boolean);
   protected
+    function SaveHeader(useBitMapType:Integer;Stream:TStream;Img:TFPCustomImage):boolean; virtual;
     procedure InternalWrite(Stream:TStream;Img:TFPCustomImage);override;
   public
     Property FullWidth: Boolean Read FFullWidth Write SetFullWidth; {if true write 16 bits per colour for P5, P6 formats}
@@ -127,32 +128,32 @@ begin
     BinaryFormat:=True;
 end;
 
+function TFPWriterPNM.SaveHeader(useBitMapType:Integer;Stream:TStream;Img:TFPCustomImage):boolean;
+const
+    MagicWords:Array[1..6]OF String[2]=('P1','P2','P3','P4','P5','P6');
+var
+   PNMInfo:String;
+   strWidth,StrHeight:String[15];
+begin
+    Result:=false;
+    with Img do
+      begin
+        Str(Img.Width,StrWidth);
+        Str(Img.Height,StrHeight);
+      end;
+    PNMInfo:=Concat(MagicWords[useBitMapType],#10,StrWidth,#32,StrHeight,#10);
+    if (useBitMapType in [5,6]) and FullWidth then
+      PNMInfo:=Concat(PNMInfo,'65535'#10)
+    else if (useBitMapType in [2,3,5,6]) then
+      PNMInfo:=Concat(PNMInfo,'255'#10);
+    stream.seek(0,soFromBeginning);
+    stream.Write(PNMInfo[1],Length(PNMInfo));
+    Result := true;
+end;
+
 procedure TFPWriterPNM.InternalWrite(Stream:TStream;Img:TFPCustomImage);
-var useBitMapType: integer;
-
-  function SaveHeader(stream:TStream):boolean;
-    const
-      MagicWords:Array[1..6]OF String[2]=('P1','P2','P3','P4','P5','P6');
-    var
-      PNMInfo:String;
-      strWidth,StrHeight:String[15];
-    begin
-      SaveHeader:=false;
-      with Img do
-        begin
-          Str(Img.Width,StrWidth);
-          Str(Img.Height,StrHeight);
-        end;
-      PNMInfo:=Concat(MagicWords[useBitMapType],#10,StrWidth,#32,StrHeight,#10);
-      if (useBitMapType in [5,6]) and FullWidth then
-        PNMInfo:=Concat(PNMInfo,'65535'#10)
-      else if (useBitMapType in [2,3,5,6]) then
-        PNMInfo:=Concat(PNMInfo,'255'#10);
-      stream.seek(0,soFromBeginning);
-      stream.Write(PNMInfo[1],Length(PNMInfo));
-      SaveHeader := true;
-    end;
-  var
+var
+    useBitMapType: integer;
     Row,Coulumn,nBpLine,i:Integer;
     aColor:TFPColor;
     aLine:PByte;
@@ -161,7 +162,7 @@ var useBitMapType: integer;
     LinuxEndOfLine: char;
     UseColorDepth: TPNMColorDepth;
 
-  begin
+begin
     LinuxEndOfLine := #10;
 
     //determine color depth
@@ -178,7 +179,7 @@ var useBitMapType: integer;
     if BinaryFormat then inc(useBitMapType,3);
     if FullWidth and Not BinaryFormat then
       Raise FPImageException.Create('Fullwidth can only be used with binary format');
-    SaveHeader(Stream);
+    SaveHeader(useBitMapType, Stream, Img);
     case useBitMapType of
       1:nBpLine:=Img.Width*2;{p p p}
       2:nBpLine:=Img.Width*4;{lll lll lll}
@@ -255,7 +256,7 @@ var useBitMapType: integer;
         if useBitMapType in[1..3] then Stream.Write(LinuxEndOfLine,1);
       end;
     FreeMem(aLine,nBpLine);
-  end;
+end;
 
 function TFPWriterPNM.GetColorDepthOfExtension(AExtension: string
   ): TPNMColorDepth;

packages/fcl-image/src/fpwritetiff.pas

@@ -44,7 +44,6 @@ uses
   Math, Classes, SysUtils, zbase, zdeflate, FPimage, FPTiffCmn;
 
 type
-
   { TTiffWriterEntry }
 
   TTiffWriterEntry = class
@@ -88,7 +87,6 @@ type
     procedure SortEntries;
     procedure WriteTiff;
     procedure WriteHeader;
-    procedure WriteIFDs;
     procedure WriteEntry(Entry: TTiffWriterEntry);
     procedure WriteData;
     procedure WriteEntryData(Entry: TTiffWriterEntry);
@@ -96,6 +94,7 @@ type
     procedure WriteWord(w: Word);
     procedure WriteDWord(d: DWord);
   protected
+    procedure WriteIFDs; virtual;
     procedure InternalWrite(Stream: TStream; Img: TFPCustomImage); override;
     procedure AddEntryString(Tag: word; const s: string);
     procedure AddEntryShort(Tag: word; Value: Word);
@@ -125,8 +124,6 @@ function CompressDeflate(InputData: PByte; InputCount: cardinal;
 
 implementation
 
-uses FPReadTiff;
-
 function CompareTiffWriteEntries(Entry1, Entry2: Pointer): integer;
 begin
   Result:=integer(TTiffWriterEntry(Entry1).Tag)-integer(TTiffWriterEntry(Entry2).Tag);

packages/fcl-image/src/jpegcomn.pas

@@ -0,0 +1,71 @@
+{*****************************************************************************}
+{
+    This file is part of the Free Pascal's "Free Components Library".
+    Copyright (c) 2023 by Massimo Magnano
+
+    JPEG reader/writer common code.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+{*****************************************************************************}
+unit JPEGcomn;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, JPEGLib, FPImage;
+
+type
+    TFPJPEGCompressionQuality = 1..100;   // 100 = best quality, 25 = pretty awful
+
+    PFPJPEGProgressManager = ^TFPJPEGProgressManager;
+    TFPJPEGProgressManager = record
+      pub : jpeg_progress_mgr;
+      instance: TObject;
+      last_pass: Integer;
+      last_pct: Integer;
+      last_time: Integer;
+      last_scanline: Integer;
+    end;
+
+    TJPEGScale = (jsFullSize, jsHalf, jsQuarter, jsEighth);
+    TJPEGReadPerformance = (jpBestQuality, jpBestSpeed);
+
+    TExifOrientation = ( // all angles are clockwise
+      eoUnknown, eoNormal, eoMirrorHor, eoRotate180, eoMirrorVert,
+      eoMirrorHorRot270, eoRotate90, eoMirrorHorRot90, eoRotate270
+    );
+
+
+function density_unitToResolutionUnit(Adensity_unit: UINT8): TResolutionUnit;
+function ResolutionUnitTodensity_unit(AResolutionUnit: TResolutionUnit): UINT8;
+
+implementation
+
+function density_unitToResolutionUnit(Adensity_unit: UINT8): TResolutionUnit;
+begin
+  Case Adensity_unit of
+  1: Result :=ruPixelsPerInch;
+  2: Result :=ruPixelsPerCentimeter;
+  else Result :=ruNone;
+  end;
+end;
+
+function ResolutionUnitTodensity_unit(AResolutionUnit: TResolutionUnit): UINT8;
+begin
+  Case AResolutionUnit of
+  ruPixelsPerInch: Result :=1;
+  ruPixelsPerCentimeter: Result :=2;
+  else Result :=0;
+  end;
+end;
+
+end.
+

packages/fcl-image/src/pngcomn.pp

@@ -52,6 +52,12 @@ type
     BitDepth, ColorType, Compression, Filter, Interlace : byte;
   end;
 
+  TPNGPhysicalDimensions = packed record
+    X_Pixels, Y_Pixels :DWord;
+    Unit_Specifier :Byte;
+  end;
+  PPNGPhysicalDimensions=^TPNGPhysicalDimensions;
+
 const
 
   Signature    : Array[0..7] of Byte = ($89, $50, $4E, $47, $0D, $0A, $1A, $0A);

packages/fcl-image/src/psdcomn.pas

@@ -0,0 +1,232 @@
+{*****************************************************************************}
+{
+    This file is part of the Free Pascal's "Free Components Library".
+    Copyright (c) 2023 by Massimo Magnano
+
+    PSD reader/writer common code.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+{*****************************************************************************}
+unit PSDcomn;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, 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;
+  end;
+
+  TLab = record
+    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
+    Reserved : array[0..5] of Byte;    // Reserved, must be zeroed
+    Channels : Word;                   // Number of color channels (1-24) including alpha channels
+    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 (see previous  Image color modes consts)
+  end;
+
+  { Image Resource Blocks }
+  TPSDResourceBlock = packed record
+    Types : array[0..3] of Char;   // Always "8BIM"
+    ID:word;                       // see previous Image Resource IDs consts
+    NameLen:Byte;                  // Pascal-format string, 2 bytes or longer
+    Name:Char;
+  end;
+  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  (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  (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;
+
+  TDisplayInfo = record
+    ColorSpace:word;
+    Color:array[0..3] of word;
+    Opacity:word;          // 0-100
+    Kind:byte;             // 0=selected, 1=protected
+    Padding:byte;          // Always zero
+  end;
+
+
+function PSDResolutionUnitToResolutionUnit(APSDResolutionUnit: Word): TResolutionUnit;
+function ResolutionUnitToPSdResolutionUnit(AResolutionUnit: TResolutionUnit): Word;
+
+implementation
+
+function PSDResolutionUnitToResolutionUnit(APSDResolutionUnit: Word): TResolutionUnit;
+begin
+  Case APSDResolutionUnit of
+  PSD_RES_INCH: Result :=ruPixelsPerInch;
+  PSD_RES_CM: Result :=ruPixelsPerCentimeter;
+  else Result :=ruNone;
+  end;
+end;
+
+function ResolutionUnitToPSdResolutionUnit(AResolutionUnit: TResolutionUnit): Word;
+begin
+  Case AResolutionUnit of
+  ruPixelsPerInch: Result :=PSD_RES_INCH;
+  ruPixelsPerCentimeter: Result :=PSD_RES_CM;
+  else Result :=0;
+  end;
+end;
+
+end.
+