- Delphiartiklar, tips, forum, länksamling - 

      

START | DELPHI | LÄNKARGÄSTBOK 




 Forum

Grundkurs
  »Introduktion
  »Snabbguide
  »Komponenter
  »Händelser
  »Strängar
  »Räkna med Delphi   »Egna typer
  »Selektion
  »Iteration
  »Menyer
  »Funktioner
  »Arraystrukturer

Tips & Tricks
  »Nya tips
  »Blandat
  »Databaser
  »Filer
  »Forms
  »Grafik
  »Internet
  »Komponenter
  »Matematik
  »Multimedia
  »Objekt/ActiveX
  »Skrivare
  »Strängar
  »System
  »Mest lästa tips

Artiklar
  »Delphi och ADO
  »Bygga en DLL
  »Skapa en enkel rapport
  »Hantera registret
  »Enheter, units
  »Klassen TCanvas
  »Använd LookUp Controls

 Nya tips
 Lägg till tips
 Delphilänkar
 Gästbok

 

Skapa tumnaglar Kategori: Grafik
Inlagt: 2005-08-09
Läst: 1062
Inlagt av: Staffan Berg
Beskrivning
Här finner du ett bra exempel som demonstrerar hur du skapar s k tumnaglar (thumbnails).
Kod
procedure MakeThumbNail(src, dest: TBitmap; ThumbSize: Word); 
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; 
 dest.Width := ThumbSize; 
 dest.Height := ThumbSize; 
 w := ThumbSize; 
 h := ThumbSize; 
 
 if (src.Width <= ThumbSize) and (src.Height <= ThumbSize) 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; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
 dest: TBitmap; 
begin 
 dest := TBitmap.Create; 
 try 
  MakeThumbNail(Image1.Picture.Bitmap, dest, 100); 
  Image2.Picture.Bitmap.Assign(dest); 
 finally 
  dest.Free; 
 end; 
end; 

 
 
© Copyright 2005 - Staffan Berg
- Alla rättigheter förbehålles -