type
TByteArr = array of Byte;
TJFIFSegment = packed record
Fix : Byte;
Kind : Byte;
end;
TSOFData = packed record
SamplePrecision : Byte;
Height : WORD; // Number of lines
Width : WORD; // Number of samples per line
Comp : Byte; // Number of image components in frame
// Data : TByteArr;
end;
PSOFData = ^TSOFData;
function ReverseWord(w: word): word;
begin
Result := ((w shl 8) and $FF00) or ((w shr 8) and $00FF);
end;
function ReadWORD(FS : TFileStream; out AWord : WORD):boolean;
begin
Result := (FS.Read(AWord,SizeOf(AWord)) = SizeOf(AWord));
AWord := ReverseWord(AWord);
end;
function ReadSegmentHeader(FS : TFileStream; out Seg : TJFIFSegment):boolean;
begin
Result := (FS.Read(Seg,SizeOf(Seg)) = SizeOf(Seg));
end;
function ReadData(FS : TFileStream; const ALength:WORD; var Data : TByteArr):boolean;
begin
SetLength(Data, ALength);
Result := (FS.Read(Data[0],ALength) = ALength);
end;
function GetJPEGImageSize(const AFileName : UnicodeString; out AHeight, AWidth : dword):boolean;
var
FS : TFileStream;
SOI : WORD;
SEG : TJFIFSegment;
SegSize : WORD;
C0 : PSOFData;
tmpData : TByteArr;
UTF8FileName: RawByteString;
begin
Result := False;
UTF8FileName := String(AFileName);
FS := TFileStream.Create(UTF8FileName, fmOpenRead or fmShareDenyNone);
try
if ReadWORD(FS, SOI) and (SOI = $FFD8) then begin
While ReadSegmentHeader(FS, SEG) and (SEG.Fix = $FF) do begin
if SEG.Kind = $DA then break;
if ReadWORD(FS, SegSize) then begin
SegSize := SegSize -2;
case SEG.Kind of
$C0, // Baseline DCT
$C1, // Extended sequential DCT, Huffman coding
$C2, // Progressive DCT, Huffman coding
$C3, // Lossless (sequential), Huffman coding
$C9, // Extended sequential DCT, arithmetic coding
$CA, // Progressive DCT, arithmetic coding
$CB : // Lossless (sequential), arithmetic coding
begin
if ReadData(FS, SegSize, tmpData) then begin
C0 := PSOFData(@tmpData[0]);
AHeight := ReverseWord(C0^.Height);
AWidth := ReverseWord(C0^.Width);
Result := True;
Break;
end;
end;
else
FS.Position := FS.Position + SegSize;
end;
end;
end;
end;
finally
FS.Free;
end;
end;
Recent
