DELPHI怎么实现缩略图?

时间:2021-03-16 20:33:08
现在要做一个窗口,用户选择硬盘上某路径后,在窗口左边显示该文件夹里面图片文件的缩略图列表,用户选择一项后,再在窗口右边放大显示选中的图片。没有做过类似的东西,向各位大峡请教,有控件也行,但有源码最好,谢谢了!

6 个解决方案

#1


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; 

#2


用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文件的缩览图。

#3


From------>>>  Delphi.Super.Documents.2005.Kingron.exe

#4


看 晕了
试验一下

#5


中级代码工:
 可直接把Delphi 的Timage可视控件拖到Form上,用image.picture.bitmap:= LoadThumb(filename) 即可显示PhotoShop JPEG文件的缩览图。

我试了你的方法不行啊,我的图片不一定是PhotoShop做的

#6


我已经用别的方法实现了,谢谢yq3woaini(哈哈镜(中级代码工)

#1


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; 

#2


用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文件的缩览图。

#3


From------>>>  Delphi.Super.Documents.2005.Kingron.exe

#4


看 晕了
试验一下

#5


中级代码工:
 可直接把Delphi 的Timage可视控件拖到Form上,用image.picture.bitmap:= LoadThumb(filename) 即可显示PhotoShop JPEG文件的缩览图。

我试了你的方法不行啊,我的图片不一定是PhotoShop做的

#6


我已经用别的方法实现了,谢谢yq3woaini(哈哈镜(中级代码工)