ImagingJpeg2000.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652
  1. {
  2. Vampyre Imaging Library
  3. by Marek Mauder
  4. http://imaginglib.sourceforge.net
  5. The contents of this file are used with permission, subject to the Mozilla
  6. Public License Version 1.1 (the "License"); you may not use this file except
  7. in compliance with the License. You may obtain a copy of the License at
  8. http://www.mozilla.org/MPL/MPL-1.1.html
  9. Software distributed under the License is distributed on an "AS IS" basis,
  10. WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  11. the specific language governing rights and limitations under the License.
  12. Alternatively, the contents of this file may be used under the terms of the
  13. GNU Lesser General Public License (the "LGPL License"), in which case the
  14. provisions of the LGPL License are applicable instead of those above.
  15. If you wish to allow use of your version of this file only under the terms
  16. of the LGPL License and not to allow others to use your version of this file
  17. under the MPL, indicate your decision by deleting the provisions above and
  18. replace them with the notice and other provisions required by the LGPL
  19. License. If you do not delete the provisions above, a recipient may use
  20. your version of this file under either the MPL or the LGPL License.
  21. For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
  22. }
  23. { This unit contains image format loader/saver for Jpeg 2000 images.}
  24. unit ImagingJpeg2000;
  25. {$I ImagingOptions.inc}
  26. interface
  27. {$IF not (
  28. (Defined(DCC) and Defined(CPUX86) and not Defined(MACOS)) or
  29. (Defined(FPC) and not Defined(MSDOS) and
  30. ((Defined(CPUX86) and (Defined(LINUX) or Defined(WIN32) or Defined(MACOS)) or
  31. (Defined(CPUX64) and Defined(LINUX)))))
  32. )}
  33. // JPEG2000 only for 32bit Windows/Linux/OSX and for 64bit Unix with FPC
  34. implementation
  35. begin
  36. {$ELSE}
  37. uses
  38. SysUtils, ImagingTypes, Imaging, ImagingColors, ImagingIO, ImagingUtility,
  39. ImagingExtFileFormats, OpenJpeg;
  40. type
  41. { Type Jpeg 2000 file (needed for OpenJPEG codec settings).}
  42. TJpeg2000FileType = (jtInvalid, jtJP2, jtJ2K, jtJPT);
  43. { Class for loading/saving Jpeg 2000 images. It uses OpenJPEG library
  44. compiled to object files and linked to Object Pascal program. Jpeg 2000
  45. supports wide variety of data formats. You can have arbitrary number
  46. of components/channels, each with different bitdepth and optional
  47. "signedness". Jpeg 2000 images can be lossy or lossless compressed.
  48. Imaging can load most data formats (except images
  49. with componenet bitdepth > 16 => no Imaging data format equivalents).
  50. Components with sample separation are loaded correctly, ICC profiles
  51. or palettes are not used, YCbCr images are translated to RGB.
  52. You can set various options when saving Jpeg-2000 images. Look at
  53. properties of TJpeg2000FileFormat for details.}
  54. TJpeg2000FileFormat = class(TImageFileFormat)
  55. private
  56. FQuality: LongInt;
  57. FCodeStreamOnly: LongBool;
  58. FLosslessCompression: LongBool;
  59. FScaleOutput: LongBool;
  60. function GetFileType(Handle: TImagingHandle): TJpeg2000FileType;
  61. protected
  62. procedure Define; override;
  63. function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
  64. OnlyFirstLevel: Boolean): Boolean; override;
  65. function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
  66. Index: LongInt): Boolean; override;
  67. procedure ConvertToSupported(var Image: TImageData;
  68. const Info: TImageFormatInfo); override;
  69. public
  70. function TestFormat(Handle: TImagingHandle): Boolean; override;
  71. procedure CheckOptionsValidity; override;
  72. published
  73. { Controls JPEG 2000 lossy compression quality. It is number in range 1..100.
  74. 1 means small/ugly file, 100 means large/nice file. Accessible trough
  75. ImagingJpeg2000Quality option. Default value is 80.}
  76. property Quality: LongInt read FQuality write FQuality;
  77. { Controls whether JPEG 2000 image is saved with full file headers or just
  78. as code stream. Default value is False. Accessible trough
  79. ImagingJpeg2000CodeStreamOnly option.}
  80. property CodeStreamOnly: LongBool read FCodeStreamOnly write FCodeStreamOnly;
  81. { Specifies JPEG 2000 image compression type. If True, saved JPEG 2000 files
  82. will be losslessly compressed. Otherwise lossy compression is used.
  83. Default value is False. Accessible trough
  84. ImagingJpeg2000LosslessCompression option.}
  85. property LosslessCompression: LongBool read FLosslessCompression write FLosslessCompression;
  86. { Specifies JPEG 2000 output scaling. Since JPEG 2000 supports arbitrary Bit Depths,
  87. the default behaviour is to scale the images up tp the next 8^n bit depth.
  88. This can be disabled by setting this option to False.
  89. Defaul value is True. Accessible through
  90. ImagingJpeg2000ScaleOutput option.}
  91. property ScaleOutput: LongBool read FScaleOutput write FScaleOutput;
  92. end;
  93. implementation
  94. const
  95. SJpeg2000FormatName = 'JPEG 2000 Image';
  96. SJpeg2000Masks = '*.jp2,*.j2k,*.j2c,*.jpx,*.jpc';
  97. Jpeg2000SupportedFormats: TImageFormats = [ifGray8, ifGray16,
  98. ifA8Gray8, ifA16Gray16, ifR8G8B8, ifR16G16B16, ifA8R8G8B8, ifA16R16G16B16];
  99. Jpeg2000DefaultQuality = 80;
  100. Jpeg2000DefaultCodeStreamOnly = False;
  101. Jpeg2000DefaultLosslessCompression = False;
  102. Jpeg2000DefaultScaleOutput = True;
  103. const
  104. JP2Signature: TChar8 = #0#0#0#$0C#$6A#$50#$20#$20;
  105. J2KSignature: TChar4 = #$FF#$4F#$FF#$51;
  106. procedure TJpeg2000FileFormat.Define;
  107. begin
  108. inherited;
  109. FName := SJpeg2000FormatName;
  110. FFeatures := [ffLoad, ffSave];
  111. FSupportedFormats := Jpeg2000SupportedFormats;
  112. FQuality := Jpeg2000DefaultQuality;
  113. FCodeStreamOnly := Jpeg2000DefaultCodeStreamOnly;
  114. FLosslessCompression := Jpeg2000DefaultLosslessCompression;
  115. FScaleOutput := Jpeg2000DefaultScaleOutput;
  116. AddMasks(SJpeg2000Masks);
  117. RegisterOption(ImagingJpeg2000Quality, @FQuality);
  118. RegisterOption(ImagingJpeg2000CodeStreamOnly, @FCodeStreamOnly);
  119. RegisterOption(ImagingJpeg2000LosslessCompression, @FLosslessCompression);
  120. RegisterOption(ImagingJpeg2000ScaleOutput, @FScaleOutput);
  121. end;
  122. procedure TJpeg2000FileFormat.CheckOptionsValidity;
  123. begin
  124. // Check if option values are valid
  125. if not (FQuality in [1..100]) then
  126. FQuality := Jpeg2000DefaultQuality;
  127. end;
  128. function TJpeg2000FileFormat.GetFileType(Handle: TImagingHandle): TJpeg2000FileType;
  129. var
  130. ReadCount: LongInt;
  131. Id: TChar8;
  132. begin
  133. Result := jtInvalid;
  134. with GetIO do
  135. begin
  136. ReadCount := Read(Handle, @Id, SizeOf(Id));
  137. if ReadCount = SizeOf(Id) then
  138. begin
  139. // Check if we have full JP2 file format or just J2K code stream
  140. if CompareMem(@Id, @JP2Signature, SizeOf(JP2Signature)) then
  141. Result := jtJP2
  142. else if CompareMem(@Id, @J2KSignature, SizeOf(J2KSignature)) then
  143. Result := jtJ2K;
  144. end;
  145. Seek(Handle, -ReadCount, smFromCurrent);
  146. end;
  147. end;
  148. function TJpeg2000FileFormat.LoadData(Handle: TImagingHandle;
  149. var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
  150. type
  151. TChannelInfo = record
  152. DestOffset: Integer;
  153. CompType: OPJ_COMPONENT_TYPE;
  154. Shift: Integer;
  155. SrcMaxValue: Integer;
  156. DestMaxValue: Integer;
  157. end;
  158. var
  159. FileType: TJpeg2000FileType;
  160. Buffer: PByte;
  161. BufferSize, ChannelSize, I: Integer;
  162. Info: TImageFormatInfo;
  163. dinfo: popj_dinfo_t;
  164. parameters: opj_dparameters_t;
  165. cio: popj_cio_t;
  166. image: popj_image_t;
  167. StartPos: Int64;
  168. Channels: array of TChannelInfo;
  169. procedure WriteSample(Dest: PByte; ChannelSize, Value: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
  170. begin
  171. case ChannelSize of
  172. 1: Dest^ := Value;
  173. 2: PWord(Dest)^ := Value;
  174. 4: PUInt32(Dest)^ := Value;
  175. end;
  176. end;
  177. procedure CopySample(Src, Dest: PByte; ChannelSize: Integer); {$IFDEF USE_INLINE}inline;{$ENDIF}
  178. begin
  179. case ChannelSize of
  180. 1: Dest^ := Src^;
  181. 2: PWord(Dest)^ := PWord(Src)^;
  182. 4: PUInt32(Dest)^ := PUInt32(Src)^;
  183. end;
  184. end;
  185. procedure ReadChannel(const Image: TImageData; const Info: TChannelInfo; const Comp: opj_image_comp; BytesPerPixel: Integer);
  186. var
  187. X, Y, SX, SY, SrcIdx, LineBytes: Integer;
  188. DestPtr, NewPtr, LineUpPtr: PByte;
  189. DontScaleSamples: Boolean;
  190. begin
  191. DontScaleSamples := (Info.SrcMaxValue = Info.DestMaxValue) or not FScaleOutput;
  192. LineBytes := Image.Width * BytesPerPixel;
  193. DestPtr := @PByteArray(Image.Bits)[Info.DestOffset];
  194. SrcIdx := 0;
  195. if (Comp.dx = 1) and (Comp.dy = 1) then
  196. begin
  197. // X and Y sample separation is 1 so just need to assign component values
  198. // to image pixels one by one
  199. for Y := 0 to Image.Height * Image.Width - 1 do
  200. begin
  201. if DontScaleSamples then
  202. WriteSample(DestPtr, ChannelSize, Comp.data[SrcIdx] + Info.Shift)
  203. else
  204. WriteSample(DestPtr, ChannelSize, MulDiv(Comp.data[SrcIdx] + Info.Shift, Info.DestMaxValue, Info.SrcMaxValue));
  205. Inc(SrcIdx);
  206. Inc(DestPtr, BytesPerPixel);
  207. end;
  208. end
  209. else
  210. begin
  211. // Sample separation is active - component is sub-sampled. Real component
  212. // dimensions are [Comp.w * Comp.dx, Comp.h * Comp.dy]
  213. for Y := 0 to Comp.h - 1 do
  214. begin
  215. LineUpPtr := @PByteArray(Image.Bits)[Y * Comp.dy * LineBytes + Info.DestOffset];
  216. DestPtr := LineUpPtr;
  217. for X := 0 to Comp.w - 1 do
  218. begin
  219. if DontScaleSamples then
  220. WriteSample(DestPtr, ChannelSize, Comp.data[SrcIdx] + Info.Shift)
  221. else
  222. WriteSample(DestPtr, ChannelSize, MulDiv(Comp.data[SrcIdx] + Info.Shift, Info.DestMaxValue, Info.SrcMaxValue));
  223. NewPtr := DestPtr;
  224. for SX := 1 to Comp.dx - 1 do
  225. begin
  226. if X * Comp.dx + SX >= Image.Width then Break;
  227. // Replicate pixels on line
  228. Inc(NewPtr, BytesPerPixel);
  229. CopySample(DestPtr, NewPtr, ChannelSize);
  230. end;
  231. Inc(SrcIdx);
  232. Inc(DestPtr, BytesPerPixel * Comp.dx);
  233. end;
  234. for SY := 1 to Comp.dy - 1 do
  235. begin
  236. if Y * Comp.dy + SY >= Image.Height then Break;
  237. // Replicate line
  238. NewPtr := @PByteArray(Image.Bits)[(Y * Comp.dy + SY) * LineBytes + Info.DestOffset];
  239. for X := 0 to Image.Width - 1 do
  240. begin
  241. CopySample(LineUpPtr, NewPtr, ChannelSize);
  242. Inc(LineUpPtr, BytesPerPixel);
  243. Inc(NewPtr, BytesPerPixel);
  244. end;
  245. end;
  246. end;
  247. end;
  248. end;
  249. procedure ConvertYCbCrToRGB(Pixels: PByte; NumPixels, BytesPerPixel: Integer);
  250. var
  251. I: Integer;
  252. PixPtr: PByte;
  253. CY, CB, CR: Byte;
  254. CYW, CBW, CRW: Word;
  255. begin
  256. PixPtr := Pixels;
  257. for I := 0 to NumPixels - 1 do
  258. begin
  259. if BytesPerPixel in [3, 4] then
  260. with PColor24Rec(PixPtr)^ do
  261. begin
  262. CY := R;
  263. CB := G;
  264. CR := B;
  265. YCbCrToRGB(CY, CB, CR, R, G, B);
  266. end
  267. else
  268. with PColor48Rec(PixPtr)^ do
  269. begin
  270. CYW := R;
  271. CBW := G;
  272. CRW := B;
  273. YCbCrToRGB16(CYW, CBW, CRW, R, G, B);
  274. end;
  275. Inc(PixPtr, BytesPerPixel);
  276. end;
  277. end;
  278. begin
  279. Result := False;
  280. image := nil;
  281. cio := nil;
  282. opj_set_default_decoder_parameters(@parameters);
  283. // Determine which codec to use
  284. FileType := GetFileType(Handle);
  285. case FileType of
  286. jtJP2: dinfo := opj_create_decompress(CODEC_JP2);
  287. jtJ2K: dinfo := opj_create_decompress(CODEC_J2K);
  288. jtJPT: dinfo := opj_create_decompress(CODEC_JPT);
  289. else
  290. Exit;
  291. end;
  292. // Set event manager to nil to avoid getting messages
  293. dinfo.event_mgr := nil;
  294. // Currently OpenJPEG can load images only from memory so we have to
  295. // preload whole input to mem buffer. Not good but no other way now.
  296. // At least we set stream pos to end of JP2 data after loading (we will now
  297. // the exact size by then).
  298. StartPos := GetIO.Tell(Handle);
  299. BufferSize := ImagingIO.GetInputSize(GetIO, Handle);
  300. GetMem(Buffer, BufferSize);
  301. SetLength(Images, 1);
  302. with GetIO, Images[0] do
  303. try
  304. Read(Handle, Buffer, BufferSize);
  305. cio := opj_cio_open(opj_common_ptr(dinfo), Buffer, BufferSize);
  306. opj_setup_decoder(dinfo, @parameters);
  307. // Decode image
  308. image := opj_decode(dinfo, cio);
  309. if image = nil then
  310. Exit;
  311. // Determine which Imaging data format to use accorsing to
  312. // decoded image components
  313. case image.numcomps of
  314. 2: case image.comps[0].prec of
  315. 1..8: Format := ifA8Gray8;
  316. 9..16: Format := ifA16Gray16;
  317. end;
  318. 3: case image.comps[0].prec of
  319. 1..8: Format := ifR8G8B8;
  320. 9..16: Format := ifR16G16B16;
  321. end;
  322. 4: case image.comps[0].prec of
  323. 1..8: Format := ifA8R8G8B8;
  324. 9..16: Format := ifA16R16G16B16;
  325. end;
  326. else
  327. // There is only one component or there is more than four =>
  328. // just load the first one as gray
  329. case image.comps[0].prec of
  330. 1..8: Format := ifGray8;
  331. 9..16: Format := ifGray16;
  332. 17..32: Format := ifGray32;
  333. end;
  334. end;
  335. // Exit if no compatible format was found
  336. if Format = ifUnknown then
  337. Exit;
  338. NewImage(image.x1 - image.x0, image.y1 - image.y0, Format, Images[0]);
  339. Info := GetFormatInfo(Format);
  340. ChannelSize := Info.BytesPerPixel div Info.ChannelCount;
  341. SetLength(Channels, Info.ChannelCount);
  342. // Get information about all channels/components of JP2 file
  343. for I := 0 to Info.ChannelCount - 1 do
  344. begin
  345. // Get component type for this channel and based on this
  346. // determine where in dest image bits write this channel's data
  347. Channels[I].CompType := image.comps[I].comp_type;
  348. case Channels[I].CompType of
  349. COMPTYPE_UNKNOWN:
  350. begin
  351. if Info.ChannelCount <> 4 then
  352. begin
  353. // Missing CDEF box in file - usually BGR order
  354. Channels[I].DestOffset := image.numcomps - I - 1
  355. end
  356. else
  357. begin
  358. // Missing CDEF box in file - usually ABGR order
  359. if I = 3 then
  360. Channels[I].DestOffset := 3
  361. else
  362. Channels[I].DestOffset := image.numcomps - I - 2
  363. end;
  364. end;
  365. COMPTYPE_R: Channels[I].DestOffset := 2;
  366. COMPTYPE_G: Channels[I].DestOffset := 1;
  367. COMPTYPE_B: Channels[I].DestOffset := 0;
  368. COMPTYPE_CB: Channels[I].DestOffset := 1;
  369. COMPTYPE_CR: Channels[I].DestOffset := 0;
  370. COMPTYPE_OPACITY: Channels[I].DestOffset := 3;
  371. COMPTYPE_Y:
  372. case image.color_space of
  373. CLRSPC_SYCC: Channels[I].DestOffset := 2; // Y is intensity part of YCC
  374. CLRSPC_GRAY: Channels[I].DestOffset := 0; // Y is independent gray channel
  375. end;
  376. end;
  377. // Scale channel offset
  378. Channels[I].DestOffset := Channels[I].DestOffset * ChannelSize;
  379. // Signed componets must be scaled to [0, 1] interval (depends on precision)
  380. if image.comps[I].sgnd = 1 then
  381. Channels[I].Shift := 1 shl (image.comps[I].prec - 1);
  382. // Max channel values used to easier scaling of precisions
  383. // not supported by Imaging to supported ones (like 12bits etc.).
  384. Channels[I].SrcMaxValue := 1 shl image.comps[I].prec - 1;
  385. Channels[I].DestMaxValue := 1 shl (ChannelSize * 8) - 1;
  386. end;
  387. // Images components are stored separately in JP2, each can have
  388. // different dimensions, bitdepth, ...
  389. for I := 0 to Info.ChannelCount - 1 do
  390. ReadChannel(Images[0], Channels[I], image.comps[I], Info.BytesPerPixel);
  391. // If we have YCbCr image we need to convert it to RGB
  392. if (image.color_space = CLRSPC_SYCC) and (Info.ChannelCount in [3, 4]) then
  393. ConvertYCbCrToRGB(Bits, Width * Height, Info.BytesPerPixel);
  394. // Set the input position just after end of image
  395. Seek(Handle, StartPos + Cardinal(cio.bp) - Cardinal(cio.start), smFromBeginning);
  396. Result := True;
  397. finally
  398. opj_image_destroy(image);
  399. opj_destroy_decompress(dinfo);
  400. opj_cio_close(cio);
  401. FreeMem(Buffer);
  402. end;
  403. end;
  404. function TJpeg2000FileFormat.SaveData(Handle: TImagingHandle;
  405. const Images: TDynImageDataArray; Index: LongInt): Boolean;
  406. var
  407. TargetSize, Rate: Single;
  408. ImageToSave: TImageData;
  409. MustBeFreed: Boolean;
  410. Info: TImageFormatInfo;
  411. I, Z, InvZ, Channel, ChannelSize, NumPixels: Integer;
  412. Pix: PByte;
  413. image: popj_image_t;
  414. cio: popj_cio_t;
  415. cinfo: popj_cinfo_t;
  416. parameters: opj_cparameters_t;
  417. compparams: popj_image_cmptparm_array;
  418. ColorSpace: OPJ_COLOR_SPACE;
  419. function GetComponentType(Comp: Integer): OPJ_COMPONENT_TYPE;
  420. begin
  421. if Info.HasAlphaChannel and (Comp = Info.ChannelCount - 1) then
  422. Result := COMPTYPE_OPACITY
  423. else if Info.HasGrayChannel then
  424. Result := COMPTYPE_Y
  425. else if Comp = 2 then
  426. Result := COMPTYPE_B
  427. else if Comp = 1 then
  428. Result := COMPTYPE_G
  429. else if Comp = 0 then
  430. Result := COMPTYPE_R
  431. else
  432. Result := COMPTYPE_UNKNOWN;
  433. end;
  434. begin
  435. Result := False;
  436. image := nil;
  437. compparams := nil;
  438. cinfo := nil;
  439. cio := nil;
  440. // Makes image to save compatible with Jpeg 2000 saving capabilities
  441. if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
  442. with GetIO, ImageToSave do
  443. try
  444. Info := GetFormatInfo(Format);
  445. ChannelSize := Info.BytesPerPixel div Info.ChannelCount;
  446. // Fill component info structures and then create OpenJPEG image
  447. GetMem(compparams, Info.ChannelCount * SizeOf(opj_image_comptparm));
  448. for I := 0 to Info.ChannelCount - 1 do
  449. with compparams[I] do
  450. begin
  451. dx := 1;
  452. dy := 1;
  453. w := Width;
  454. h := Height;
  455. prec := (Info.BytesPerPixel div Info.ChannelCount) * 8;
  456. bpp := prec;
  457. sgnd := 0;
  458. comp_type := GetComponentType(I);
  459. x0 := 0;
  460. y0 := 0;
  461. end;
  462. if Info.HasGrayChannel then
  463. ColorSpace := CLRSPC_GRAY
  464. else
  465. ColorSpace := CLRSPC_SRGB;
  466. image := opj_image_create(Info.ChannelCount, @compparams[0], ColorSpace);
  467. if image = nil then Exit;
  468. image.x1 := Width;
  469. image.y1 := Height;
  470. if FCodeStreamOnly then
  471. cinfo := opj_create_compress(CODEC_J2K)
  472. else
  473. cinfo := opj_create_compress(CODEC_JP2);
  474. // Set event manager to nil to avoid getting messages
  475. cinfo.event_mgr := nil;
  476. // Set compression parameters based current file format properties
  477. opj_set_default_encoder_parameters(@parameters);
  478. parameters.cod_format := Iff(FCodeStreamOnly, 0, 1);
  479. parameters.numresolution := 6;
  480. parameters.tcp_numlayers := 1;
  481. parameters.cp_disto_alloc := 1;
  482. if FLosslessCompression then
  483. begin
  484. // Set rate to 0 -> lossless
  485. parameters.tcp_rates[0] := 0;
  486. end
  487. else
  488. begin
  489. // Quality -> Rate computation taken from ImageMagick
  490. Rate := 100.0 / Sqr(115 - FQuality);
  491. NumPixels := Width * Height * Info.BytesPerPixel;
  492. TargetSize := (NumPixels * Rate) + 550 + (Info.ChannelCount - 1) * 142;
  493. parameters.tcp_rates[0] := 1.0 / (TargetSize / NumPixels);
  494. end;
  495. // Setup encoder
  496. opj_setup_encoder(cinfo, @parameters, image);
  497. // Fill component samples in data with values taken from
  498. // image pixels.
  499. // Components should be ordered like this: RGBA, YA, RGB, etc.
  500. for Channel := 0 to Info.ChannelCount - 1 do
  501. begin
  502. Z := Channel;
  503. InvZ := Info.ChannelCount - 1 - Z;
  504. if Info.HasAlphaChannel then
  505. begin
  506. if Channel = Info.ChannelCount - 1 then
  507. InvZ := Z
  508. else
  509. InvZ := Info.ChannelCount - 2 - Z;
  510. end;
  511. Pix := @PByteArray(Bits)[InvZ * ChannelSize];
  512. for I := 0 to Width * Height - 1 do
  513. begin
  514. case ChannelSize of
  515. 1: image.comps[Z].data[I] := Pix^;
  516. 2: image.comps[Z].data[I] := PWord(Pix)^;
  517. 4: UInt32(image.comps[Z].data[I]) := PUInt32(Pix)^;
  518. end;
  519. Inc(Pix, Info.BytesPerPixel);
  520. end;
  521. end;
  522. // Open OpenJPEG output
  523. cio := opj_cio_open(opj_common_ptr(cinfo), nil, 0);
  524. // Try to encode the image
  525. if not opj_encode(cinfo, cio, image, nil) then
  526. Exit;
  527. // Finally write buffer with encoded image to output
  528. Write(Handle, cio.buffer, cio_tell(cio));
  529. Result := True;
  530. finally
  531. if MustBeFreed then
  532. FreeImage(ImageToSave);
  533. opj_destroy_compress(cinfo);
  534. opj_image_destroy(image);
  535. opj_cio_close(cio);
  536. FreeMem(compparams);
  537. end;
  538. end;
  539. procedure TJpeg2000FileFormat.ConvertToSupported(var Image: TImageData;
  540. const Info: TImageFormatInfo);
  541. var
  542. ConvFormat: TImageFormat;
  543. begin
  544. if Info.IsFloatingPoint then
  545. ConvFormat := IffFormat(Info.ChannelCount = 1, ifGray16, ifA16R16G16B16)
  546. else if Info.HasGrayChannel then
  547. ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16Gray16, ifGray16)
  548. else if Info.IsIndexed then
  549. ConvFormat := ifA8R8G8B8
  550. else if Info.BytesPerPixel div Info.ChannelCount > 1 then
  551. ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16R16G16B16, ifR16G16B16)
  552. else
  553. ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8);
  554. ConvertImage(Image, ConvFormat);
  555. end;
  556. function TJpeg2000FileFormat.TestFormat(Handle: TImagingHandle): Boolean;
  557. begin
  558. Result := False;
  559. if Handle <> nil then
  560. Result := GetFileType(Handle) <> jtInvalid;
  561. end;
  562. initialization
  563. RegisterImageFileFormat(TJpeg2000FileFormat);
  564. {
  565. File Notes:
  566. -- TODOS ----------------------------------------------------
  567. - nothing now
  568. -- 0.27 Changes ---------------------------------------------
  569. - by Hanno Hugenberg <[email protected]>
  570. - introduced the ImagingJpeg2000ScaleOutput parameter for keeping
  571. the original decoded images by avoiding upscaling of output images
  572. -- 0.26.3 Changes/Bug Fixes -----------------------------------
  573. - Rewritten JP2 loading part (based on PasJpeg2000) to be
  574. more readable (it's a bit faster too) and handled more JP2 files better:
  575. components with precisions like 12bit (not direct Imaging equivalent)
  576. are properly scaled, images/components with offsets are loaded ok.
  577. -- 0.24.3 Changes/Bug Fixes -----------------------------------
  578. - Alpha channels are now saved properly in FPC (GCC optimization issue),
  579. FPC lossy compression enabled again!
  580. - Added handling of component types (CDEF Box), JP2 images with alpha
  581. are now properly recognized by other applications.
  582. - Fixed wrong color space when saving grayscale images
  583. -- 0.21 Changes/Bug Fixes -----------------------------------
  584. - Removed ifGray32 from supported formats, OpenJPEG crashes when saving them.
  585. - Added Seek after loading to set input pos to the end of image.
  586. - Saving added losy/lossless, quality option added.
  587. - Initial loading-only version created.
  588. }
  589. {$IFEND}
  590. end.