Узнать/установить JPG resolution?

Материал из DRKB


procedure GetResJpg(JPGFile: string);
const
  BufferSize = 50;
var
  Buffer: string;
  Index: Integer;
  FileStream: TFileStream;
  HorzRes, VertRes: Word;
  DP: Byte;
  Measure: string;
begin
  FileStream := TFileStream.Create(JPGFile, fmOpenReadWrite);
  try
    SetLength(Buffer, BufferSize);
    FileStream.Read(buffer[1], BufferSize);
    Index := Pos('JFIF' + #$00, buffer);
    if Index > 0 then
    begin
      FileStream.Seek(Index + 6, soFromBeginning);
      FileStream.Read(DP, 1);
      case DP of
        1: Measure := 'DPI'; // Dots Per Inch
        2: Measure := 'DPC'; // Dots Per Cm.
      end;
      FileStream.Read(HorzRes, 2); // x axis
      HorzRes := Swap(HorzRes);
      FileStream.Read(VertRes, 2); // y axis
      VertRes := Swap(VertRes);
    end
  finally
    FileStream.Free;
  end;
end;

procedure SetResJpg(name: string; dpix, dpiy: Integer);
const
  BufferSize = 50;
  DPI = 1; // inch
  DPC = 2; // cm
var
  Buffer: string;
  index: Integer;
  FileStream: TFileStream;
  xResolution: Word;
  yResolution: Word;
  _type: Byte;
begin
  FileStream := TFileStream.Create(name, fmOpenReadWrite);
  try
    SetLength(Buffer, BufferSize);
    FileStream.Read(buffer[1], BufferSize);
    index := Pos('JFIF' + #$00, buffer);
    if index > 0 then
    begin
      FileStream.Seek(index + 6, soFromBeginning);
      _type := DPI;
      FileStream.Write(_type, 1);
      xResolution:= Swap(dpix);
      FileStream.Write(xResolution, 2);
      yResolution := Swap(dpiy);
      FileStream.Write(yResolution, 2);
    end
  finally
    FileStream.Free;
  end;
end;


Source: http://www.swissdelphicenter.ch/en/tipsindex.php
ID: 03790