Repo for the search and displace ingest module that takes odf, docx and pdf and transforms it into .md to be used with search and displace operations
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

769 lines
22 KiB

3 years ago
  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 images.}
  24. unit ImagingJpeg;
  25. {$I ImagingOptions.inc}
  26. { You can choose which Pascal JpegLib implementation will be used.
  27. IMJPEGLIB is version bundled with Imaging which works with all supported
  28. compilers and platforms.
  29. PASJPEG is original JpegLib translation or version modified for FPC
  30. (and shipped with it). You can use PASJPEG if this version is already
  31. linked with another part of your program and you don't want to have
  32. two quite large almost the same libraries linked to your exe.
  33. This is the case with Lazarus applications for example.}
  34. {$DEFINE IMJPEGLIB}
  35. { $DEFINE PASJPEG}
  36. { Automatically use FPC's PasJpeg when compiling with Lazarus. But not when
  37. WINDOWS is defined. See http://galfar.vevb.net/imaging/smf/index.php/topic,90.0.html.
  38. Fixed in FPC revision 13963: http://bugs.freepascal.org/view.php?id=14928 }
  39. {$IF Defined(LCL) and not Defined(WINDOWS)}
  40. {$UNDEF IMJPEGLIB}
  41. {$DEFINE PASJPEG}
  42. {$IFEND}
  43. { We usually want to skip the rest of the corrupted file when loading JEPG files
  44. instead of getting exception. JpegLib's error handler can only be
  45. exited using setjmp/longjmp ("non-local goto") functions to get error
  46. recovery when loading corrupted JPEG files. This is implemented in assembler
  47. and currently available only for 32bit Delphi targets and FPC.}
  48. {$DEFINE ErrorJmpRecovery}
  49. {$IF Defined(DCC) and not Defined(CPUX86)}
  50. {$UNDEF ErrorJmpRecovery}
  51. {$IFEND}
  52. interface
  53. uses
  54. SysUtils, ImagingTypes, Imaging, ImagingColors,
  55. {$IF Defined(IMJPEGLIB)}
  56. imjpeglib, imjmorecfg, imjcomapi, imjdapimin, imjdeferr, imjerror,
  57. imjdapistd, imjcapimin, imjcapistd, imjdmarker, imjcparam,
  58. {$ELSEIF Defined(PASJPEG)}
  59. jpeglib, jmorecfg, jcomapi, jdapimin, jdeferr, jerror,
  60. jdapistd, jcapimin, jcapistd, jdmarker, jcparam,
  61. {$IFEND}
  62. ImagingUtility;
  63. {$IF Defined(FPC) and Defined(PASJPEG)}
  64. { When using FPC's pasjpeg in FPC the channel order is BGR instead of RGB}
  65. {$DEFINE RGBSWAPPED}
  66. {$IFEND}
  67. type
  68. { Class for loading/saving Jpeg images. Supports load/save of
  69. 8 bit grayscale and 24 bit RGB images. Jpegs can be saved with optional
  70. progressive encoding.
  71. Based on IJG's JpegLib so doesn't support alpha channels and lossless
  72. coding.}
  73. TJpegFileFormat = class(TImageFileFormat)
  74. private
  75. FGrayScale: Boolean;
  76. protected
  77. FQuality: LongInt;
  78. FProgressive: LongBool;
  79. procedure SetJpegIO(const JpegIO: TIOFunctions); virtual;
  80. procedure Define; override;
  81. function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
  82. OnlyFirstLevel: Boolean): Boolean; override;
  83. function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
  84. Index: LongInt): Boolean; override;
  85. procedure ConvertToSupported(var Image: TImageData;
  86. const Info: TImageFormatInfo); override;
  87. public
  88. function TestFormat(Handle: TImagingHandle): Boolean; override;
  89. procedure CheckOptionsValidity; override;
  90. published
  91. { Controls Jpeg save compression quality. It is number in range 1..100.
  92. 1 means small/ugly file, 100 means large/nice file. Accessible trough
  93. ImagingJpegQuality option.}
  94. property Quality: LongInt read FQuality write FQuality;
  95. { If True Jpeg images are saved in progressive format. Accessible trough
  96. ImagingJpegProgressive option.}
  97. property Progressive: LongBool read FProgressive write FProgressive;
  98. end;
  99. implementation
  100. const
  101. SJpegFormatName = 'Joint Photographic Experts Group Image';
  102. SJpegMasks = '*.jpg,*.jpeg,*.jfif,*.jpe,*.jif';
  103. JpegSupportedFormats: TImageFormats = [ifR8G8B8, ifGray8];
  104. JpegDefaultQuality = 90;
  105. JpegDefaultProgressive = False;
  106. const
  107. { Jpeg file identifiers.}
  108. JpegMagic: TChar2 = #$FF#$D8;
  109. BufferSize = 16384;
  110. resourcestring
  111. SJpegError = 'JPEG Error';
  112. type
  113. TJpegContext = record
  114. case Byte of
  115. 0: (common: jpeg_common_struct);
  116. 1: (d: jpeg_decompress_struct);
  117. 2: (c: jpeg_compress_struct);
  118. end;
  119. TSourceMgr = record
  120. Pub: jpeg_source_mgr;
  121. Input: TImagingHandle;
  122. Buffer: JOCTETPTR;
  123. StartOfFile: Boolean;
  124. end;
  125. PSourceMgr = ^TSourceMgr;
  126. TDestMgr = record
  127. Pub: jpeg_destination_mgr;
  128. Output: TImagingHandle;
  129. Buffer: JOCTETPTR;
  130. end;
  131. PDestMgr = ^TDestMgr;
  132. var
  133. JIO: TIOFunctions;
  134. JpegErrorMgr: jpeg_error_mgr;
  135. { Intenal unit jpeglib support functions }
  136. {$IFDEF ErrorJmpRecovery}
  137. {$IFDEF DCC}
  138. type
  139. jmp_buf = record
  140. EBX,
  141. ESI,
  142. EDI,
  143. ESP,
  144. EBP,
  145. EIP: LongWord;
  146. end;
  147. pjmp_buf = ^jmp_buf;
  148. { JmpLib SetJmp/LongJmp Library
  149. (C)Copyright 2003, 2004 Will DeWitt Jr. <edge@boink.net> }
  150. function SetJmp(out jmpb: jmp_buf): Integer;
  151. asm
  152. { -> EAX jmpb }
  153. { <- EAX Result }
  154. MOV EDX, [ESP] // Fetch return address (EIP)
  155. // Save task state
  156. MOV [EAX+jmp_buf.&EBX], EBX
  157. MOV [EAX+jmp_buf.&ESI], ESI
  158. MOV [EAX+jmp_buf.&EDI], EDI
  159. MOV [EAX+jmp_buf.&ESP], ESP
  160. MOV [EAX+jmp_buf.&EBP], EBP
  161. MOV [EAX+jmp_buf.&EIP], EDX
  162. SUB EAX, EAX
  163. @@1:
  164. end;
  165. procedure LongJmp(const jmpb: jmp_buf; retval: Integer);
  166. asm
  167. { -> EAX jmpb }
  168. { EDX retval }
  169. { <- EAX Result }
  170. XCHG EDX, EAX
  171. MOV ECX, [EDX+jmp_buf.&EIP]
  172. // Restore task state
  173. MOV EBX, [EDX+jmp_buf.&EBX]
  174. MOV ESI, [EDX+jmp_buf.&ESI]
  175. MOV EDI, [EDX+jmp_buf.&EDI]
  176. MOV ESP, [EDX+jmp_buf.&ESP]
  177. MOV EBP, [EDX+jmp_buf.&EBP]
  178. MOV [ESP], ECX // Restore return address (EIP)
  179. TEST EAX, EAX // Ensure retval is <> 0
  180. JNZ @@1
  181. MOV EAX, 1
  182. @@1:
  183. end;
  184. {$ENDIF}
  185. type
  186. TJmpBuf = jmp_buf;
  187. TErrorClientData = record
  188. JmpBuf: TJmpBuf;
  189. ScanlineReadReached: Boolean;
  190. end;
  191. PErrorClientData = ^TErrorClientData;
  192. {$ENDIF}
  193. procedure JpegError(CInfo: j_common_ptr);
  194. procedure RaiseError;
  195. var
  196. Buffer: AnsiString;
  197. begin
  198. // Create the message and raise exception
  199. CInfo.err.format_message(CInfo, Buffer);
  200. // Warning: you can get "Invalid argument index in format" exception when
  201. // using FPC (see http://bugs.freepascal.org/view.php?id=21229).
  202. // Fixed in FPC 2.7.1
  203. {$IF Defined(FPC) and (FPC_FULLVERSION <= 20701)}
  204. raise EImagingError.CreateFmt(SJPEGError + ' %d', [CInfo.err.msg_code]);
  205. {$ELSE}
  206. raise EImagingError.CreateFmt(SJPEGError + ' %d: ' + string(Buffer), [CInfo.err.msg_code]);
  207. {$IFEND}
  208. end;
  209. begin
  210. {$IFDEF ErrorJmpRecovery}
  211. // Only recovers on loads and when header is sucessfully loaded
  212. // (error occurs when reading scanlines)
  213. if (CInfo.client_data <> nil) and
  214. PErrorClientData(CInfo.client_data).ScanlineReadReached then
  215. begin
  216. // Non-local jump to error handler in TJpegFileFormat.LoadData
  217. longjmp(PErrorClientData(CInfo.client_data).JmpBuf, 1)
  218. end
  219. else
  220. RaiseError;
  221. {$ELSE}
  222. RaiseError;
  223. {$ENDIF}
  224. end;
  225. procedure OutputMessage(CurInfo: j_common_ptr);
  226. begin
  227. end;
  228. procedure ReleaseContext(var jc: TJpegContext);
  229. begin
  230. if jc.common.err = nil then
  231. Exit;
  232. jpeg_destroy(@jc.common);
  233. jpeg_destroy_decompress(@jc.d);
  234. jpeg_destroy_compress(@jc.c);
  235. jc.common.err := nil;
  236. end;
  237. procedure InitSource(cinfo: j_decompress_ptr);
  238. begin
  239. PSourceMgr(cinfo.src).StartOfFile := True;
  240. end;
  241. function FillInputBuffer(cinfo: j_decompress_ptr): Boolean;
  242. var
  243. NBytes: LongInt;
  244. Src: PSourceMgr;
  245. begin
  246. Src := PSourceMgr(cinfo.src);
  247. NBytes := JIO.Read(Src.Input, Src.Buffer, BufferSize);
  248. if NBytes <= 0 then
  249. begin
  250. PByteArray(Src.Buffer)[0] := $FF;
  251. PByteArray(Src.Buffer)[1] := JPEG_EOI;
  252. NBytes := 2;
  253. end;
  254. Src.Pub.next_input_byte := Src.Buffer;
  255. Src.Pub.bytes_in_buffer := NBytes;
  256. Src.StartOfFile := False;
  257. Result := True;
  258. end;
  259. procedure SkipInputData(cinfo: j_decompress_ptr; num_bytes: LongInt);
  260. var
  261. Src: PSourceMgr;
  262. begin
  263. Src := PSourceMgr(cinfo.src);
  264. if num_bytes > 0 then
  265. begin
  266. while num_bytes > Src.Pub.bytes_in_buffer do
  267. begin
  268. Dec(num_bytes, Src.Pub.bytes_in_buffer);
  269. FillInputBuffer(cinfo);
  270. end;
  271. Src.Pub.next_input_byte := @PByteArray(Src.Pub.next_input_byte)[num_bytes];
  272. //Inc(LongInt(Src.Pub.next_input_byte), num_bytes);
  273. Dec(Src.Pub.bytes_in_buffer, num_bytes);
  274. end;
  275. end;
  276. procedure TermSource(cinfo: j_decompress_ptr);
  277. var
  278. Src: PSourceMgr;
  279. begin
  280. Src := PSourceMgr(cinfo.src);
  281. // Move stream position back just after EOI marker so that more that one
  282. // JPEG images can be loaded from one stream
  283. JIO.Seek(Src.Input, -Src.Pub.bytes_in_buffer, smFromCurrent);
  284. end;
  285. procedure JpegStdioSrc(var cinfo: jpeg_decompress_struct; Handle:
  286. TImagingHandle);
  287. var
  288. Src: PSourceMgr;
  289. begin
  290. if cinfo.src = nil then
  291. begin
  292. cinfo.src := cinfo.mem.alloc_small(j_common_ptr(@cinfo), JPOOL_PERMANENT,
  293. SizeOf(TSourceMgr));
  294. Src := PSourceMgr(cinfo.src);
  295. Src.Buffer := cinfo.mem.alloc_small(j_common_ptr(@cinfo), JPOOL_PERMANENT,
  296. BufferSize * SizeOf(JOCTET));
  297. end;
  298. Src := PSourceMgr(cinfo.src);
  299. Src.Pub.init_source := InitSource;
  300. Src.Pub.fill_input_buffer := FillInputBuffer;
  301. Src.Pub.skip_input_data := SkipInputData;
  302. Src.Pub.resync_to_restart := jpeg_resync_to_restart;
  303. Src.Pub.term_source := TermSource;
  304. Src.Input := Handle;
  305. Src.Pub.bytes_in_buffer := 0;
  306. Src.Pub.next_input_byte := nil;
  307. end;
  308. procedure InitDest(cinfo: j_compress_ptr);
  309. var
  310. Dest: PDestMgr;
  311. begin
  312. Dest := PDestMgr(cinfo.dest);
  313. Dest.Pub.next_output_byte := Dest.Buffer;
  314. Dest.Pub.free_in_buffer := BufferSize;
  315. end;
  316. function EmptyOutput(cinfo: j_compress_ptr): Boolean;
  317. var
  318. Dest: PDestMgr;
  319. begin
  320. Dest := PDestMgr(cinfo.dest);
  321. JIO.Write(Dest.Output, Dest.Buffer, BufferSize);
  322. Dest.Pub.next_output_byte := Dest.Buffer;
  323. Dest.Pub.free_in_buffer := BufferSize;
  324. Result := True;
  325. end;
  326. procedure TermDest(cinfo: j_compress_ptr);
  327. var
  328. Dest: PDestMgr;
  329. DataCount: LongInt;
  330. begin
  331. Dest := PDestMgr(cinfo.dest);
  332. DataCount := BufferSize - Dest.Pub.free_in_buffer;
  333. if DataCount > 0 then
  334. JIO.Write(Dest.Output, Dest.Buffer, DataCount);
  335. end;
  336. procedure JpegStdioDest(var cinfo: jpeg_compress_struct; Handle:
  337. TImagingHandle);
  338. var
  339. Dest: PDestMgr;
  340. begin
  341. if cinfo.dest = nil then
  342. cinfo.dest := cinfo.mem.alloc_small(j_common_ptr(@cinfo),
  343. JPOOL_PERMANENT, SizeOf(TDestMgr));
  344. Dest := PDestMgr(cinfo.dest);
  345. Dest.Buffer := cinfo.mem.alloc_small(j_common_ptr(@cinfo), JPOOL_IMAGE,
  346. BufferSize * SIZEOF(JOCTET));
  347. Dest.Pub.init_destination := InitDest;
  348. Dest.Pub.empty_output_buffer := EmptyOutput;
  349. Dest.Pub.term_destination := TermDest;
  350. Dest.Output := Handle;
  351. end;
  352. procedure SetupErrorMgr(var jc: TJpegContext);
  353. begin
  354. // Set standard error handlers and then override some
  355. jc.common.err := jpeg_std_error(JpegErrorMgr);
  356. jc.common.err.error_exit := JpegError;
  357. jc.common.err.output_message := OutputMessage;
  358. end;
  359. procedure InitDecompressor(Handle: TImagingHandle; var jc: TJpegContext);
  360. begin
  361. jpeg_CreateDecompress(@jc.d, JPEG_LIB_VERSION, sizeof(jc.d));
  362. JpegStdioSrc(jc.d, Handle);
  363. jpeg_read_header(@jc.d, True);
  364. jc.d.scale_num := 1;
  365. jc.d.scale_denom := 1;
  366. jc.d.do_block_smoothing := True;
  367. if jc.d.out_color_space = JCS_GRAYSCALE then
  368. begin
  369. jc.d.quantize_colors := True;
  370. jc.d.desired_number_of_colors := 256;
  371. end;
  372. end;
  373. procedure InitCompressor(Handle: TImagingHandle; var jc: TJpegContext;
  374. Saver: TJpegFileFormat);
  375. begin
  376. jpeg_CreateCompress(@jc.c, JPEG_LIB_VERSION, sizeof(jc.c));
  377. JpegStdioDest(jc.c, Handle);
  378. if Saver.FGrayScale then
  379. jc.c.in_color_space := JCS_GRAYSCALE
  380. else
  381. jc.c.in_color_space := JCS_RGB;
  382. jpeg_set_defaults(@jc.c);
  383. jpeg_set_quality(@jc.c, Saver.FQuality, True);
  384. if Saver.FProgressive then
  385. jpeg_simple_progression(@jc.c);
  386. end;
  387. { TJpegFileFormat class implementation }
  388. procedure TJpegFileFormat.Define;
  389. begin
  390. FName := SJpegFormatName;
  391. FFeatures := [ffLoad, ffSave];
  392. FSupportedFormats := JpegSupportedFormats;
  393. FQuality := JpegDefaultQuality;
  394. FProgressive := JpegDefaultProgressive;
  395. AddMasks(SJpegMasks);
  396. RegisterOption(ImagingJpegQuality, @FQuality);
  397. RegisterOption(ImagingJpegProgressive, @FProgressive);
  398. end;
  399. procedure TJpegFileFormat.CheckOptionsValidity;
  400. begin
  401. // Check if option values are valid
  402. if not (FQuality in [1..100]) then
  403. FQuality := JpegDefaultQuality;
  404. end;
  405. function TJpegFileFormat.LoadData(Handle: TImagingHandle;
  406. var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
  407. var
  408. PtrInc, LinesPerCall, LinesRead, I: Integer;
  409. Dest: PByte;
  410. jc: TJpegContext;
  411. Info: TImageFormatInfo;
  412. Col32: PColor32Rec;
  413. NeedsRedBlueSwap: Boolean;
  414. Pix: PColor24Rec;
  415. {$IFDEF ErrorJmpRecovery}
  416. ErrorClient: TErrorClientData;
  417. {$ENDIF}
  418. procedure LoadMetaData;
  419. var
  420. XDensity, YDensity: Single;
  421. ResUnit: TResolutionUnit;
  422. begin
  423. // Density unit: 0 - undef, 1 - inch, 2 - cm
  424. if jc.d.saw_JFIF_marker and (jc.d.density_unit > 0) and
  425. (jc.d.X_density > 0) and (jc.d.Y_density > 0) then
  426. begin
  427. XDensity := jc.d.X_density;
  428. YDensity := jc.d.Y_density;
  429. ResUnit := ruDpi;
  430. if jc.d.density_unit = 2 then
  431. ResUnit := ruDpcm;
  432. FMetadata.SetPhysicalPixelSize(ResUnit, XDensity, YDensity);
  433. end;
  434. end;
  435. begin
  436. // Copy IO functions to global var used in JpegLib callbacks
  437. Result := False;
  438. SetJpegIO(GetIO);
  439. SetLength(Images, 1);
  440. with JIO, Images[0] do
  441. try
  442. ZeroMemory(@jc, SizeOf(jc));
  443. SetupErrorMgr(jc);
  444. {$IFDEF ErrorJmpRecovery}
  445. ZeroMemory(@ErrorClient, SizeOf(ErrorClient));
  446. jc.common.client_data := @ErrorClient;
  447. if setjmp(ErrorClient.JmpBuf) <> 0 then
  448. begin
  449. Result := True;
  450. Exit;
  451. end;
  452. {$ENDIF}
  453. InitDecompressor(Handle, jc);
  454. case jc.d.out_color_space of
  455. JCS_GRAYSCALE: Format := ifGray8;
  456. JCS_RGB: Format := ifR8G8B8;
  457. JCS_CMYK: Format := ifA8R8G8B8;
  458. else
  459. Exit;
  460. end;
  461. NewImage(jc.d.image_width, jc.d.image_height, Format, Images[0]);
  462. jpeg_start_decompress(@jc.d);
  463. GetImageFormatInfo(Format, Info);
  464. PtrInc := Width * Info.BytesPerPixel;
  465. LinesPerCall := 1;
  466. Dest := Bits;
  467. // If Jpeg's colorspace is RGB and not YCbCr we need to swap
  468. // R and B to get Imaging's native order
  469. NeedsRedBlueSwap := jc.d.jpeg_color_space = JCS_RGB;
  470. {$IFDEF RGBSWAPPED}
  471. // Force R-B swap for FPC's PasJpeg
  472. NeedsRedBlueSwap := True;
  473. {$ENDIF}
  474. {$IFDEF ErrorJmpRecovery}
  475. ErrorClient.ScanlineReadReached := True;
  476. {$ENDIF}
  477. while jc.d.output_scanline < jc.d.output_height do
  478. begin
  479. LinesRead := jpeg_read_scanlines(@jc.d, @Dest, LinesPerCall);
  480. if NeedsRedBlueSwap and (Format = ifR8G8B8) then
  481. begin
  482. Pix := PColor24Rec(Dest);
  483. for I := 0 to Width - 1 do
  484. begin
  485. SwapValues(Pix.R, Pix.B);
  486. Inc(Pix);
  487. end;
  488. end;
  489. Inc(Dest, PtrInc * LinesRead);
  490. end;
  491. if jc.d.out_color_space = JCS_CMYK then
  492. begin
  493. Col32 := Bits;
  494. // Translate from CMYK to RGB
  495. for I := 0 to Width * Height - 1 do
  496. begin
  497. CMYKToRGB(255 - Col32.B, 255 - Col32.G, 255 - Col32.R, 255 - Col32.A,
  498. Col32.R, Col32.G, Col32.B);
  499. Col32.A := 255;
  500. Inc(Col32);
  501. end;
  502. end;
  503. // Store supported metadata
  504. LoadMetaData;
  505. jpeg_finish_output(@jc.d);
  506. jpeg_finish_decompress(@jc.d);
  507. Result := True;
  508. finally
  509. ReleaseContext(jc);
  510. end;
  511. end;
  512. function TJpegFileFormat.SaveData(Handle: TImagingHandle;
  513. const Images: TDynImageDataArray; Index: LongInt): Boolean;
  514. var
  515. PtrInc, LinesWritten: LongInt;
  516. Src, Line: PByte;
  517. jc: TJpegContext;
  518. ImageToSave: TImageData;
  519. Info: TImageFormatInfo;
  520. MustBeFreed: Boolean;
  521. {$IFDEF RGBSWAPPED}
  522. I: LongInt;
  523. Pix: PColor24Rec;
  524. {$ENDIF}
  525. procedure SaveMetaData;
  526. var
  527. XRes, YRes: Single;
  528. begin
  529. if FMetadata.GetPhysicalPixelSize(ruDpcm, XRes, YRes, True) then
  530. begin
  531. jc.c.density_unit := 2; // Dots per cm
  532. jc.c.X_density := Round(XRes);
  533. jc.c.Y_density := Round(YRes)
  534. end;
  535. end;
  536. begin
  537. Result := False;
  538. // Copy IO functions to global var used in JpegLib callbacks
  539. SetJpegIO(GetIO);
  540. // Makes image to save compatible with Jpeg saving capabilities
  541. if MakeCompatible(Images[Index], ImageToSave, MustBeFreed) then
  542. with JIO, ImageToSave do
  543. try
  544. ZeroMemory(@jc, SizeOf(jc));
  545. SetupErrorMgr(jc);
  546. GetImageFormatInfo(Format, Info);
  547. FGrayScale := Format = ifGray8;
  548. InitCompressor(Handle, jc, Self);
  549. jc.c.image_width := Width;
  550. jc.c.image_height := Height;
  551. if FGrayScale then
  552. begin
  553. jc.c.input_components := 1;
  554. jc.c.in_color_space := JCS_GRAYSCALE;
  555. end
  556. else
  557. begin
  558. jc.c.input_components := 3;
  559. jc.c.in_color_space := JCS_RGB;
  560. end;
  561. PtrInc := Width * Info.BytesPerPixel;
  562. Src := Bits;
  563. {$IFDEF RGBSWAPPED}
  564. GetMem(Line, PtrInc);
  565. {$ENDIF}
  566. // Save supported metadata
  567. SaveMetaData;
  568. jpeg_start_compress(@jc.c, True);
  569. while (jc.c.next_scanline < jc.c.image_height) do
  570. begin
  571. {$IFDEF RGBSWAPPED}
  572. if Format = ifR8G8B8 then
  573. begin
  574. Move(Src^, Line^, PtrInc);
  575. Pix := PColor24Rec(Line);
  576. for I := 0 to Width - 1 do
  577. begin
  578. SwapValues(Pix.R, Pix.B);
  579. Inc(Pix, 1);
  580. end;
  581. end;
  582. {$ELSE}
  583. Line := Src;
  584. {$ENDIF}
  585. LinesWritten := jpeg_write_scanlines(@jc.c, @Line, 1);
  586. Inc(Src, PtrInc * LinesWritten);
  587. end;
  588. jpeg_finish_compress(@jc.c);
  589. Result := True;
  590. finally
  591. ReleaseContext(jc);
  592. if MustBeFreed then
  593. FreeImage(ImageToSave);
  594. {$IFDEF RGBSWAPPED}
  595. FreeMem(Line);
  596. {$ENDIF}
  597. end;
  598. end;
  599. procedure TJpegFileFormat.ConvertToSupported(var Image: TImageData;
  600. const Info: TImageFormatInfo);
  601. begin
  602. if Info.HasGrayChannel then
  603. ConvertImage(Image, ifGray8)
  604. else
  605. ConvertImage(Image, ifR8G8B8);
  606. end;
  607. function TJpegFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
  608. var
  609. ReadCount: LongInt;
  610. ID: array[0..9] of AnsiChar;
  611. begin
  612. Result := False;
  613. if Handle <> nil then
  614. with GetIO do
  615. begin
  616. FillChar(ID, SizeOf(ID), 0);
  617. ReadCount := Read(Handle, @ID, SizeOf(ID));
  618. Seek(Handle, -ReadCount, smFromCurrent);
  619. Result := (ReadCount = SizeOf(ID)) and
  620. CompareMem(@ID, @JpegMagic, SizeOf(JpegMagic));
  621. end;
  622. end;
  623. procedure TJpegFileFormat.SetJpegIO(const JpegIO: TIOFunctions);
  624. begin
  625. JIO := JpegIO;
  626. end;
  627. initialization
  628. RegisterImageFileFormat(TJpegFileFormat);
  629. {
  630. File Notes:
  631. -- TODOS ----------------------------------------------------
  632. - nothing now
  633. -- 0.77.1 ---------------------------------------------------
  634. - Able to read corrupted JPEG files - loads partial image
  635. and skips the corrupted parts (FPC and x86 Delphi).
  636. - Fixed reading of physical resolution metadata, could cause
  637. "divided by zero" later on for some files.
  638. -- 0.26.5 Changes/Bug Fixes ---------------------------------
  639. - Fixed loading of some JPEGs with certain APPN markers (bug in JpegLib).
  640. - Fixed swapped Red-Blue order when loading Jpegs with
  641. jc.d.jpeg_color_space = JCS_RGB.
  642. - Added loading and saving of physical pixel size metadata.
  643. -- 0.26.3 Changes/Bug Fixes ---------------------------------
  644. - Changed the Jpeg error manager, messages were not properly formated.
  645. -- 0.26.1 Changes/Bug Fixes ---------------------------------
  646. - Fixed wrong color space setting in InitCompressor.
  647. - Fixed problem with progressive Jpegs in FPC (modified JpegLib,
  648. can't use FPC's PasJpeg in Windows).
  649. -- 0.25.0 Changes/Bug Fixes ---------------------------------
  650. - FPC's PasJpeg wasn't really used in last version, fixed.
  651. -- 0.24.1 Changes/Bug Fixes ---------------------------------
  652. - Fixed loading of CMYK jpeg images. Could cause heap corruption
  653. and loaded image looked wrong.
  654. -- 0.23 Changes/Bug Fixes -----------------------------------
  655. - Removed JFIF/EXIF detection from TestFormat. Found JPEGs
  656. with different headers (Lavc) which weren't recognized.
  657. -- 0.21 Changes/Bug Fixes -----------------------------------
  658. - MakeCompatible method moved to base class, put ConvertToSupported here.
  659. GetSupportedFormats removed, it is now set in constructor.
  660. - Made public properties for options registered to SetOption/GetOption
  661. functions.
  662. - Changed extensions to filename masks.
  663. - Changed SaveData, LoadData, and MakeCompatible methods according
  664. to changes in base class in Imaging unit.
  665. - Changes in TestFormat, now reads JFIF and EXIF signatures too.
  666. -- 0.19 Changes/Bug Fixes -----------------------------------
  667. - input position is now set correctly to the end of the image
  668. after loading is done. Loading of sequence of JPEG files stored in
  669. single stream works now
  670. - when loading and saving images in FPC with PASJPEG read and
  671. blue channels are swapped to have the same chanel order as IMJPEGLIB
  672. - you can now choose between IMJPEGLIB and PASJPEG implementations
  673. -- 0.17 Changes/Bug Fixes -----------------------------------
  674. - added SetJpegIO method which is used by JNG image format
  675. }
  676. end.