Delphi缩略图读取

aaie_ 2012-10-09

展开全文

create Thumbnails?
Author: Roy Magne Klever
{
Here is the routine I use in my thumbnail component and I belive it is quite
fast.
A tip to gain faster loading of jpegs is to use the TJpegScale.Scale
property. You can gain a lot by using this correct.

This routine can only downscale images no upscaling is supported and you
must correctly set the dest image size. The src.image will be scaled to fit
in dest bitmap.
}

//Speed up by Renate Schaaf, Armido, Gary Williams...
procedure MakeThumbNail(src, dest: tBitmap);
type
PRGB24 = ^TRGB24;
TRGB24 = packed record
B: Byte;
G: Byte;
R: Byte;
end;
var
x, y, ix, iy: integer;
x1, x2, x3: integer;

xscale, yscale: single;
iRed, iGrn, iBlu, iRatio: Longword;
p, c1, c2, c3, c4, c5: tRGB24;
pt, pt1: pRGB24;
iSrc, iDst, s1: integer;
i, j, r, g, b, tmpY: integer;

RowDest, RowSource, RowSourceStart: integer;
w, h: integer;
dxmin, dymin: integer;
ny1, ny2, ny3: integer;
dx, dy: integer;
lutX, lutY: array of integer;

begin
if src.PixelFormat <> pf24bit then src.PixelFormat := pf24bit;
if dest.PixelFormat <> pf24bit then dest.PixelFormat := pf24bit;
w := Dest.Width;
h := Dest.Height;

if (src.Width <= FThumbSize) and (src.Height <= FThumbSize) then
begin
dest.Assign(src);
exit;
end;

iDst := (w * 24 + 31) and not 31;
iDst := iDst div 8; //BytesPerScanline
iSrc := (Src.Width * 24 + 31) and not 31;
iSrc := iSrc div 8;

xscale := 1 / (w / src.Width);
yscale := 1 / (h / src.Height);

// X lookup table
SetLength(lutX, w);
x1 := 0;
x2 := trunc(xscale);
for x := 0 to w - 1 do
begin
lutX[x] := x2 - x1;
x1 := x2;
x2 := trunc((x + 2) * xscale);
end;

// Y lookup table
SetLength(lutY, h);
x1 := 0;
x2 := trunc(yscale);
for x := 0 to h - 1 do
begin
lutY[x] := x2 - x1;
x1 := x2;
x2 := trunc((x + 2) * yscale);
end;

dec(w);
dec(h);
RowDest := integer(Dest.Scanline[0]);
RowSourceStart := integer(Src.Scanline[0]);
RowSource := RowSourceStart;
for y := 0 to h do
begin
dy := lutY[y];
x1 := 0;
x3 := 0;
for x := 0 to w do
begin
dx:= lutX[x];
iRed:= 0;
iGrn:= 0;
iBlu:= 0;
RowSource := RowSourceStart;
for iy := 1 to dy do
begin
pt := PRGB24(RowSource + x1);
for ix := 1 to dx do
begin
iRed := iRed + pt.R;
iGrn := iGrn + pt.G;
iBlu := iBlu + pt.B;
inc(pt);
end;
RowSource := RowSource - iSrc;
end;
iRatio := 65535 div (dx * dy);
pt1 := PRGB24(RowDest + x3);
pt1.R := (iRed * iRatio) shr 16;
pt1.G := (iGrn * iRatio) shr 16;
pt1.B := (iBlu * iRatio) shr 16;
x1 := x1 + 3 * dx;
inc(x3,3);
end;
RowDest := RowDest - iDst;
RowSourceStart := RowSource;
end;

if dest.Height < 3 then exit;

// Sharpening...
s1 := integer(dest.ScanLine[0]);
iDst := integer(dest.ScanLine[1]) - s1;
ny1 := Integer(s1);
ny2 := ny1 + iDst;
ny3 := ny2 + iDst;
for y := 1 to dest.Height - 2 do
begin
for x := 0 to dest.Width - 3 do
begin
x1 := x * 3;
x2 := x1 + 3;
x3 := x1 + 6;

c1 := pRGB24(ny1 + x1)^;
c2 := pRGB24(ny1 + x3)^;
c3 := pRGB24(ny2 + x2)^;
c4 := pRGB24(ny3 + x1)^;
c5 := pRGB24(ny3 + x3)^;

r := (c1.R + c2.R + (c3.R * -12) + c4.R + c5.R) div -8;
g := (c1.G + c2.G + (c3.G * -12) + c4.G + c5.G) div -8;
b := (c1.B + c2.B + (c3.B * -12) + c4.B + c5.B) div -8;

if r < 0 then r := 0 else if r > 255 then r := 255;
if g < 0 then g := 0 else if g > 255 then g := 255;
if b < 0 then b := 0 else if b > 255 then b := 255;

pt1 := pRGB24(ny2 + x2);
pt1.R := r;
pt1.G := g;
pt1.B := b;
end;
inc(ny1, iDst);
inc(ny2, iDst);
inc(ny3, iDst);
end;
end;

用Delphi读取JPEG文件的缩览图
--------------------------------------------------------------------------------
　　JPEG图像文件以高压缩比和高图像质量著称，市面上的图库光盘中的图像文件大都是JPEG格式的。怎样从一大堆JPEG文件中查找合适的图像呢？使用JPEG文件的缩览图就是其中方法之一。
　　在PhotoShop 4.0(或以上版本)的打开文件对话框中，当打开JPEG文件时，PhotoShop很快把它的缩览图显示出来。为什么PhotoShop能这么快地显示出JPEG文件的缩览图呢？
　　原来PhotoShop在保存JPEG文件时把它的缩览图也保存在文件里。PhotoShop定义了新的段FF ED，这个段保存了一个JPEG文件格式的缩览图，大图中有小图。FF ED段后两个字节是这个段的长度，在这个段里有缩览图的开始标志FF D8和结束标志FF D9，将这个段拷贝出来即可获得该图的缩览图。值得注意的是PhotoShop 4.0解出的缩览图，像素格式不是常规的RGB,而是BGR格式,所以还得加入BGR转为RGB的代码，转化过程是在内存里把B和R的位置交换。
　　下面是Delphi编写的快速读取PhotoShop 4.0(或以上版本)JPEG文件的缩览图的程序,程序用TFileStream读取JPEG文件的FF ED段，结合TmemoryStream、TJPEGimage, 返回BMP格式的缩览图。
　　function LoadThumb(filename:shortstring):TBitmap;
　　procedure BGR2RGB(var bmp:TBitmap);
　　var
　　x,y:integer; t:char; data:pchar;
　　begin
　　for y:=bmp.Height-1 downto 0 do
　　begin
　　data:=bmp.ScanLine[y];
　　for x:=0 to bmp.Width-1 do
　　begin
　　t:=data[x*3];
　　data[x*3]:=data[x*3+2];
　　data[x*3+2]:=t;
　　end;
　　end;
　　end;
　　var
　　fstream:Tfilestream; mstream:Tmemorystream;
　　j,i:word;data:pchar; buf:array [0..3] of byte;
　　filesize:DWORD; fjpg:Tjpegimage;bmp:Tbitmap;
　　begin
　　result:=nil;
　　fstream:=Tfilestream.create(filename,fmOpenRead);
　　//建立文件流，读JPEG文件
　　fstream.Seek(20,soFromBeginning); //FF ED段在文件的第20个字节处
　　fstream.Read(buf,sizeof(buf));
　　if PWORD(@buf[0])^=$EDFF then
　　begin
　　j:=buf[2]*256+buf[3]; //FF ED的大小，高位在前，低位在后
　　if j <1024 then //FF ED段的大小若为1024个字节则文件不包含缩览图，退出程序
　　begin
　　fstream.free;
　　exit;
　　end;
　　mstream:=TMemorystream.Create;//建立内存流
　　mstream.CopyFrom(fstream,j); //把FF ED段拷贝到mstream
　　data:=mstream.Memory;
　　for i:=300 to 700 do //找缩览图的开始标志FF D8
　　if PWORD(@data[i])^=$D8FF then break;
　　if i <700 then
　　begin
　　fjpg:=Tjpegimage.Create; //建立TJPEGimage 解出缩览图
　　bmp:=TBitmap.Create;
　　mstream.Position:=i;
　　fjpg.LoadFromStream(mstream);//fjpg读取mstream
　　bmp.Assign(fjpg); //JPEG转BMP
　　if PWORD(@data[i+57])^=$2e34 then //PhotoShop 4.0的缩览图
　　BGR2RGB(bmp); //BMP的像素格式BGR 而不是RGB,要把BGR转化为RGB
　　result:=bmp; //函数返回BMP
　　mstream.Free;
　　fjpg.Free; //释放Object
　　end;end;
　　fstream.free;
　　end;
　　可直接把Delphi 的Timage可视控件拖到Form上，用image.picture.bitmap:= LoadThumb(filename) 即可显示PhotoShop JPEG文件的缩览图。