On 2/6/2018 7:22 PM, loki loki wrote:

Will be an huge task if you want the be in pair with the performance

better to use the system api (every system have such api, windows, ios,

android, macos)

i have this in alcinoe also, but was made (not by me) 10 years ago

TALResamplingFilter = (sfBox, sfTriangle, sfHermite, sfBell,

sfSpline, sfLanczos3, sfMitchell);

{*******************************************************************************************************}

// This is the actual scaling routine. Target must be allocated already

with sufficient size. Source must

// contain valid data, Radius must not be 0 and Filter must not be nil.

procedure ALDoStretch(Filter: TALFilterFunction; Radius: Single; Source,

Target: TBitmap);

var

ScaleX,

ScaleY: Single; // Zoom scale factors

I, J,

K, N: Integer; // Loop variables

Center: Single; // Filter calculation variables

Width: Single;

Weight: Integer; // Filter calculation variables

Left,

Right: Integer; // Filter calculation variables

Work: TBitmap;

ContributorList: TALContributorList;

SourceLine,

DestLine: PALPixelArray;

DestPixel: PALBGR;

Delta,

DestDelta: Integer;

SourceHeight,

SourceWidth,

TargetHeight,

TargetWidth: Integer;

CurrentLineR: array of Integer;

CurrentLineG: array of Integer;

CurrentLineB: array of Integer;

begin

// shortcut variables

SourceHeight := Source.Height;

SourceWidth := Source.Width;

TargetHeight := Target.Height;

TargetWidth := Target.Width;

if (SourceHeight = 0) or (SourceWidth = 0) or

(TargetHeight = 0) or (TargetWidth = 0) then Exit;

// create intermediate image to hold horizontal zoom

Work := TBitmap.Create;

try

Work.PixelFormat := pf24Bit;

Work.Height := SourceHeight;

Work.Width := TargetWidth;

if SourceWidth = 1 then ScaleX := TargetWidth / SourceWidth

else ScaleX := (TargetWidth - 1) / (SourceWidth

- 1);

if (SourceHeight = 1) or (TargetHeight = 1) then ScaleY :=

TargetHeight / SourceHeight

else ScaleY :=

(TargetHeight - 1) / (SourceHeight - 1);

// pre-calculate filter contributions for a row

SetLength(ContributorList, TargetWidth);

// horizontal sub-sampling

if ScaleX < 1 then

begin

// scales from bigger to smaller Width

Width := Radius / ScaleX;

for I := 0 to TargetWidth - 1 do

begin

ContributorList[I].N := 0;

SetLength(ContributorList[I].Contributors, Trunc(2 * Width + 1));

Center := I / ScaleX;

Left := Floor(Center - Width);

Right := Ceil(Center + Width);

for J := Left to Right do

begin

Weight := Round(Filter((Center - J) * ScaleX) * ScaleX * 256);

if Weight <> 0 then

begin

if J < 0 then N := -J

else

if J >= SourceWidth then N := SourceWidth - J +

SourceWidth - 1

else N := J;

K := ContributorList[I].N;

Inc(ContributorList[I].N);

ContributorList[I].Contributors[K].Pixel := N;

ContributorList[I].Contributors[K].Weight := Weight;

end;

end;

end;

end

else

begin

// horizontal super-sampling

// scales from smaller to bigger Width

for I := 0 to TargetWidth - 1 do

begin

ContributorList[I].N := 0;

SetLength(ContributorList[I].Contributors, Trunc(2 * Radius + 1));

Center := I / ScaleX;

Left := Floor(Center - Radius);

Right := Ceil(Center + Radius);

for J := Left to Right do

begin

Weight := Round(Filter(Center - J) * 256);

if Weight <> 0 then

begin

if J < 0 then N := -J

else

if J >= SourceWidth then N := SourceWidth - J +

SourceWidth - 1

else N := J;

K := ContributorList[I].N;

Inc(ContributorList[I].N);

ContributorList[I].Contributors[K].Pixel := N;

ContributorList[I].Contributors[K].Weight := Weight;

end;

end;

end;

end;

// now apply filter to sample horizontally from Src to Work

SetLength(CurrentLineR, SourceWidth);

SetLength(CurrentLineG, SourceWidth);

SetLength(CurrentLineB, SourceWidth);

for K := 0 to SourceHeight - 1 do

begin

SourceLine := Source.ScanLine[K];

ALFillLineChache(SourceWidth, 3, SourceLine, CurrentLineR,

CurrentLineG, CurrentLineB);

DestPixel := Work.ScanLine[K];

for I := 0 to TargetWidth - 1 do

with ContributorList[I] do

begin

DestPixel^ := ALApplyContributors(N,

ContributorList[I].Contributors, CurrentLineR, CurrentLineG, CurrentLineB);

// move on to next column

Inc(DestPixel);

end;

end;

// free the memory allocated for horizontal filter weights, since

we need the stucture again

for I := 0 to TargetWidth - 1 do ContributorList[I].Contributors :=

nil;

ContributorList := nil;

// pre-calculate filter contributions for a column

SetLength(ContributorList, TargetHeight);

// vertical sub-sampling

if ScaleY < 1 then

begin

// scales from bigger to smaller height

Width := Radius / ScaleY;

for I := 0 to TargetHeight - 1 do

begin

ContributorList[I].N := 0;

SetLength(ContributorList[I].Contributors, Trunc(2 * Width + 1));

Center := I / ScaleY;

Left := Floor(Center - Width);

Right := Ceil(Center + Width);

for J := Left to Right do

begin

Weight := Round(Filter((Center - J) * ScaleY) * ScaleY * 256);

if Weight <> 0 then

begin

if J < 0 then N := -J

else

if J >= SourceHeight then N := SourceHeight - J +

SourceHeight - 1

else N := J;

K := ContributorList[I].N;

Inc(ContributorList[I].N);

ContributorList[I].Contributors[K].Pixel := N;

ContributorList[I].Contributors[K].Weight := Weight;

end;

end;

end

end

else

begin

// vertical super-sampling

// scales from smaller to bigger height

for I := 0 to TargetHeight - 1 do

begin

ContributorList[I].N := 0;

SetLength(ContributorList[I].Contributors, Trunc(2 * Radius + 1));

Center := I / ScaleY;

Left := Floor(Center - Radius);

Right := Ceil(Center + Radius);

for J := Left to Right do

begin

Weight := Round(Filter(Center - J) * 256);

if Weight <> 0 then

begin

if J < 0 then N := -J

else

if J >= SourceHeight then N := SourceHeight - J +

SourceHeight - 1

else N := J;

K := ContributorList[I].N;

Inc(ContributorList[I].N);

ContributorList[I].Contributors[K].Pixel := N;

ContributorList[I].Contributors[K].Weight := Weight;

end;

end;

end;

end;

// apply filter to sample vertically from Work to Target

SetLength(CurrentLineR, SourceHeight);

SetLength(CurrentLineG, SourceHeight);

SetLength(CurrentLineB, SourceHeight);

SourceLine := Work.ScanLine[0];

Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine);

DestLine := Target.ScanLine[0];

DestDelta := Integer(Target.ScanLine[1]) - Integer(DestLine);

for K := 0 to TargetWidth - 1 do

begin

DestPixel := Pointer(DestLine);

ALFillLineChache(SourceHeight, Delta, SourceLine, CurrentLineR,

CurrentLineG, CurrentLineB);

for I := 0 to TargetHeight - 1 do

with ContributorList[I] do

begin

DestPixel^ := ALApplyContributors(N,

ContributorList[I].Contributors, CurrentLineR, CurrentLineG, CurrentLineB);

Inc(NativeInt(DestPixel), DestDelta);

end;

Inc(SourceLine);

Inc(DestLine);

end;

// free the memory allocated for vertical filter weights

for I := 0 to TargetHeight - 1 do ContributorList[I].Contributors

:= nil;

// this one is done automatically on exit, but is here for completeness

ContributorList := nil;

finally

Work.Free;

CurrentLineR := nil;

CurrentLineG := nil;

CurrentLineB := nil;

end;

end;

Connect with Us