JPEG Thumbnails darstellen

[toms]

Vielleicht hilft dir das weiter:

Delphi-Quellcode:

const 
 FThumbSize = 150; 

//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;

(vom SDC)