First at all I didn't write this code, I found it on the net but I don’t know who the author is.
I have using this function on large Images 2048x1740 and works fine.
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtDlgs,Jpeg;
type
TForm1 = class(TForm)
OPD: TOpenPictureDialog;
OpenFileBtn: TButton;
FilepathEdt: TEdit;
Label1: TLabel;
procedure GetJPGSize(const sFile: string; var wWidth, wHeight: word);
function ReadMWord(f: TFileStream): word;
procedure OpenFileBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.GetJPGSize(const sFile: string; var wWidth,
wHeight: word);
const
ValidSig : array[0..1] of byte = ($FF, $D8);
Parameterless = [$01, $D0, $D1, $D2, $D3, $D4, $D5, $D6, $D7];
var
Sig: array[0..1] of byte;
f: TFileStream;
x: integer;
Seg: byte;
Dummy: array[0..15] of byte;
Len: word;
ReadLen: LongInt;
begin
FillChar(Sig, SizeOf(Sig), #0);
f := TFileStream.Create(sFile, fmOpenRead);
try
ReadLen := f.Read(Sig[0], SizeOf(Sig));
for x := Low(Sig) to High(Sig) do
if Sig[x] <> ValidSig[x] then ReadLen := 0;
if ReadLen > 0 then
begin
ReadLen := f.Read(Seg, 1);
while (Seg = $FF) and (ReadLen > 0) do
begin
ReadLen := f.Read(Seg, 1);
if Seg <> $FF then
begin
if (Seg = $C0) or (Seg = $C1) then
begin
ReadLen := f.Read(Dummy[0], 3); { don't need these bytes }
wHeight := ReadMWord(f);
wWidth := ReadMWord(f);
end else begin
if not (Seg in Parameterless) then
begin
Len := ReadMWord(f);
f.Seek(Len-2, 1);
f.Read(Seg, 1);
end else
Seg := $FF; { Fake it to keep looping. }
end;
end;
end;
end;
finally
f.Free;
end;
end;
function TForm1.ReadMWord(f: TFileStream): word;
type
TMotorolaWord = record
case byte of
0: (Value: word);
1: (Byte1, Byte2: byte);
end;
var
MW: TMotorolaWord;
begin
{ It would probably be better to just read these two bytes in normally }
{ and then do a small ASM routine to swap them. But we aren't talking }
{ about reading entire files, so I doubt the performance gain would be }
{ worth the trouble. }
f.Read(MW.Byte2, SizeOf(Byte));
f.Read(MW.Byte1, SizeOf(Byte));
Result := MW.Value;
end;
procedure TForm1.OpenFileBtnClick(Sender: TObject);
var
aWidth,aHeigth:Word;
begin
if OPD.Execute then begin
FilepathEdt.Text:=OPD.FileName;
GetJPGSize(opd.FileName,aWidth,aHeigth);
Label1.Caption:=Format('JPEG Size is %d x %d',[aWidth,aHeigth]);
end;
end;
end.
Sign Up
