[es] - (Trajni) resize slike

Voodoo
Novi Beograd

Član broj: 3508
Poruke: 488
*.dial.b92.net.

+1 Profil

^{20.06.2005. u 21:53 - pre 229 meseci}

Radio sam neki program koji, između ostalog, treba da pošalje JPG slike na FTP server, ali pre slanja mora da proveri da li je fajl veći od dozvoljenih dimenzija i, ako jeste, smanji dimenzije na dozvoljene. Naravno, trebala mi je procedura koja radi resize slike. Izvodio sam to na krajnje primitivan način - u praznu formu bez title bara sam ubacivao TImage objekat, postavljao stretch na true i ubacivao sliku, a onda hvatao "screenshot" preko GetFormImage. Sve je to bilo lepo, ali se pojavio ozbiljan problem - forma neće da se risajzuje na veličinu veću od rezolucije ekrana. Probao sam i da crtam po canvasu sa StretchDraw, ali su se opet javljali problemi sa jako velikim slikama.
Onda sam malo brljao po netu i našao vrlo korisnu proceduru koja radi risajz slike, pa reko' da je podelim sa vama, da ne lupate glavu ukoliko naletite na isti problem.
Znači, pre risajza morate namestiti Width i Height odredišne bitmape na željenu veličinu.

Code:
type
  TRGBArray = array[Word] of TRGBTriple;
  pRGBArray = ^TRGBArray;

procedure SmoothResize(Src, Dst: TBitmap);
var
  x, y: Integer;
  xP, yP: Integer;
  xP2, yP2: Integer;
  SrcLine1, SrcLine2: pRGBArray;
  t3: Integer;
  z, z2, iz2: Integer;
  DstLine: pRGBArray;
  DstGap: Integer;
  w1, w2, w3, w4: Integer;
begin
  Src.PixelFormat := pf24Bit;
  Dst.PixelFormat := pf24Bit;

  if (Src.Width = Dst.Width) and (Src.Height = Dst.Height) then
    Dst.Assign(Src)
  else
  begin
    DstLine := Dst.ScanLine[0];
    DstGap  := Integer(Dst.ScanLine[1]) - Integer(DstLine);

    xP2 := MulDiv(pred(Src.Width), $10000, Dst.Width);
    yP2 := MulDiv(pred(Src.Height), $10000, Dst.Height);
    yP  := 0;

    for y := 0 to pred(Dst.Height) do
    begin
      xP := 0;

      SrcLine1 := Src.ScanLine[yP shr 16];

      if (yP shr 16 < pred(Src.Height)) then
        SrcLine2 := Src.ScanLine[succ(yP shr 16)]
      else
        SrcLine2 := Src.ScanLine[yP shr 16];

      z2  := succ(yP and $FFFF);
      iz2 := succ((not yp) and $FFFF);
      for x := 0 to pred(Dst.Width) do
      begin
        t3 := xP shr 16;
        z  := xP and $FFFF;
        w2 := MulDiv(z, iz2, $10000);
        w1 := iz2 - w2;
        w4 := MulDiv(z, z2, $10000);
        w3 := z2 - w4;
        DstLine[x].rgbtRed := (SrcLine1[t3].rgbtRed * w1 +
          SrcLine1[t3 + 1].rgbtRed * w2 +
          SrcLine2[t3].rgbtRed * w3 + SrcLine2[t3 + 1].rgbtRed * w4) shr 16;
        DstLine[x].rgbtGreen :=
          (SrcLine1[t3].rgbtGreen * w1 + SrcLine1[t3 + 1].rgbtGreen * w2 +

          SrcLine2[t3].rgbtGreen * w3 + SrcLine2[t3 + 1].rgbtGreen * w4) shr 16;
        DstLine[x].rgbtBlue := (SrcLine1[t3].rgbtBlue * w1 +
          SrcLine1[t3 + 1].rgbtBlue * w2 +
          SrcLine2[t3].rgbtBlue * w3 +
          SrcLine2[t3 + 1].rgbtBlue * w4) shr 16;
        Inc(xP, xP2);
      end; {for}
      Inc(yP, yP2);
      DstLine := pRGBArray(Integer(DstLine) + DstGap);
    end; {for}
  end; {if}
end; {SmoothResize}

Odgovor na temu