Быстрое плавное изменение размеров растровых изображений - PullRequest
1 голос
/ 21 апреля 2020

Я пытаюсь написать свой собственный быстрый ресэмплер, который позволяет уменьшить изображение на 2,3,4 и c. Я сравнил его со StretchBlt и мой ресэмплер примерно в 2 раза медленнее.

Мой код:

 type TRGBA = record
   B,G,R: Byte;
   A: Byte;
 end;

 PRGBAArray = ^TRGBAArray;
 TRGBAArray = array[0..32767] of TRGBA;

procedure DownsampleSys(Src, Dst: TBitmap; Times: Integer);
var ARect: TRect;
    dc:HDC;
    p:TPoint;
begin
  Dst.Width := Src.Width div Times;
  Dst.Height := Src.Height div Times;

  ARect := Rect(0,0, Dst.Width, Dst.Height);

  dc := Dst.Canvas.Handle;
  GetBrushOrgEx(dc,p);
  SetStretchBltMode(dc,HALFTONE);
  SetBrushOrgEx(dc,p.x,p.y,@p);
  StretchBlt(dc,
    ARect.Left, ARect.Top,
    ARect.Right- ARect.Left, ARect.Bottom- ARect.Top,
    Src.Canvas.Handle,0,0,Src.Width,Src.Height,Dst.Canvas.CopyMode);
end;

procedure Downsample2(Src, Dst: TBitmap; Times: Integer);
var x,y: Integer;
    xx,yy: Integer;
    FromP, ToP: PRGBAArray;
    SumR, SumG, SumB: Cardinal;
    Times2: Integer;
    xTimes, yTimes: Integer;
    xxxTimes: Integer;
    MarginL, MarginT: Integer;
begin
  Dst.Width := floor(Src.Width/ Times);
  Dst.Height := floor(Src.Height / Times);
  Times2 := Times * Times;
  MarginL := (Src.Width - (Dst.Width * Times)) div 2;
  MarginT := (Src.Height - (Dst.Height * Times)) div 2;

  for y:=0 to Dst.Height-1 do begin
    ToP := Dst.Scanline[y];

    yTimes := MarginT + y*Times;

    for x:=0 to Dst.Width-1 do begin

      SumR := 0;
      SumG := 0;
      SumB := 0;

      xTimes := MarginL + x*Times;

      for yy:=0 to Times-1 do begin
        FromP := Src.Scanline[yy + yTimes];

        for xx:=0 to Times-1 do begin
          xxxTimes := xx + xTimes;
          SumR := SumR + FromP[xxxTimes].R;
          SumG := SumG + FromP[xxxTimes].G;
          SumB := SumB + FromP[xxxTimes].B;
        end;
      end;

      ToP[x].R := SumR div Times2;
      ToP[x].G := SumG div Times2;
      ToP[x].B := SumB div Times2;
    end;
  end;
end;

Использование:

InB := TBitmap.Create;
OutB := TBitmap.Create;

InB.LoadFromFile('2.bmp');
InB.PixelFormat := pf32bit;

OutB.PixelFormat := pf32bit;

Downsample2(InB, OutB, 4);

Как я могу сделать это еще быстрее

...