tJPEGImage - set image resolution (dpi)

[Vandrovnik 222]

Hello,

 

I would like to set the resolution of tJPEGImage, such as 300 dpi. Is it possible, or the only way is to save jpg and then directly overwrite corresponding bytes in the file/stream?

[Vandrovnik 222]

I have found no official way, but created this, which seems to work (after calling JPEGNeeded):

 

type tJpegImageClassHelper = class helper for tJpegImage
      public
       procedure SetResolution(aDpiX, aDpiY: word);
     end;

     tJpegDataClassHelper = class helper for tJpegData
      public
       procedure SetResolution(aDpiX, aDpiY: word);
     end;

procedure tJpegImageClassHelper.SetResolution(aDpiX, aDpiY: word);
 begin
 with self do if fImage<>nil then fImage.SetResolution(aDpiX, aDpiY);
end;

procedure tJpegDataClassHelper.SetResolution(aDpiX, aDpiY: word);
 type tJpegApp0Rec = packed record // 18 B including the marker; starts on position 2 in the file
       APP0Marker: word; // 2, FF E0
       Length: word; // 2, Length of segment excluding APP0 marker
       Identifier: array[1..5] of AnsiChar; // 5, 4A 46 49 46 00 = 'JFIF' in ASCII, terminated by a null byte
       JFIFVersion: word; // 2,  First byte for major version, second byte for minor version (01 02 for 1.02)
       DensityUnits: byte; // 1, Units for the following pixel density fields; 00 : No units, 01 : Pixels per inch (2.54 cm), 02 : Pixels per centimeter
       XDensity: word; // 2, Horizontal pixel density. Must not be zero
       YDensity: word; // 2, Vertical pixel density. Must not be zero
       XThumbnail: byte; // 1, Horizontal pixel count of the following embedded RGB thumbnail. May be zero
       YThumbnail: byte; // 1, Vertical pixel count of the following embedded RGB thumbnail. May be zero
       // ThumbnailData... // 3 × n, Uncompressed 24 bit RGB (8 bits per color channel) raster thumbnail data in the order R0, G0, B0, ... Rn-1, Gn-1, Bn-1; with n = Xthumbnail × Ythumbnail
      end;
      pJpegApp0Rec = ^tJpegApp0Rec;
 var App0: pJpegApp0Rec;
 function Swap(Value: word): word;
  begin
  result := (Value shr 8) or ((Value and $FF) shl 8);
 end;
 begin
 with self do begin
  if fData = nil then exit;
  if fData.Size < 20 then exit;
  App0:=pointer(NativeUInt(fData.Memory) + 2);
  if App0^.Identifier = 'JFIF'#0 then begin
   App0^.DensityUnits := 1;
   App0^.XDensity := Swap(aDpiX);
   App0^.YDensity := Swap(aDpiY);
  end;
 end;
end;