"Ambilight"- Glow- Effekt um Image

[Pfoto]

Schaumal, diesen FastBlur-Algo. hatte ich noch bei mir gefunden
(wahrscheinlich aus dem Forum von GR32).

Damit wird, so wie es aussieht, sogar der Alphakanal direkt mit
entsprechend aufbereitet.

Delphi-Quellcode:

procedure FastBlur(aBitmap32: TBitmap32; aRadius: Integer; aPasses: Integer = 3);
// Quick box blur algoritm

// aPasses:
// 1: Blur quality too low
// 2: Best speed / quality compromise
// 3: Good quality but impossible to have a small blur radius. Even
// radius 1 gives a large blur.

var
  iPass:        integer;
  lBoxSize:     cardinal;
  lColor32:     TColor32;
  lHeight1:     integer;
  lSumArray:    array of TSumRecord;
  lWidth1:      integer;
  x:            integer;
  xBitmap:      integer;
  y:            integer;
  yBitmap:      integer;

begin
  if aRadius <= 0 then
  begin
    Exit;
  end;
  lBoxSize := (aRadius * 2) + 1;
  lWidth1  := aBitmap32.Width  - 1;
  lHeight1 := aBitmap32.Height - 1;
  // Process horizontally
  SetLength(lSumArray, aBitmap32.Width + 2 * aRadius + 1);
  for yBitmap := 0 to lHeight1 do
  begin
    for iPass := 1 to aPasses do
    begin
      // First element is zero
      lSumArray[0].A := 0;
      lSumArray[0].R := 0;
      lSumArray[0].G := 0;
      lSumArray[0].B := 0;
      for x := Low(lSumArray) + 1 to High(lSumArray) do
      begin
        xBitmap := x - aRadius - 1;
        if xBitmap < 0 then
        begin
          xBitmap := 0;
        end else
          if xBitmap > lWidth1 then
          begin
            xBitmap := lWidth1;
          end;
        lColor32 := PColor32(aBitmap32.PixelPtr[xBitmap, yBitmap])^;
        lSumArray[x].A := lSumArray[x - 1].A + lColor32 shr 24;
        lSumArray[x].R := lSumArray[x - 1].R + lColor32 shr 16 and $FF;
        lSumArray[x].G := lSumArray[x - 1].G + lColor32 shr 8  and $FF;
        lSumArray[x].B := lSumArray[x - 1].B + lColor32        and $FF;
      end;
      for xBitmap := 0 to lWidth1 do
      begin
        x := xBitmap + aRadius + 1;
        PColor32(aBitmap32.PixelPtr[xBitmap, yBitmap])^ :=
          ((lSumArray[x + aRadius].A - lSumArray[x - aRadius - 1].A)
        div lBoxSize) shl 24 or
          ((lSumArray[x + aRadius].R - lSumArray[x - aRadius - 1].R)
        div lBoxSize) shl 16 or
          ((lSumArray[x + aRadius].G - lSumArray[x - aRadius - 1].G)
        div lBoxSize) shl 8 or
           (lSumArray[x + aRadius].B - lSumArray[x - aRadius - 1].B)
        div lBoxSize;
      end;
    end;
  end;

  // Process vertically
  SetLength(lSumArray, aBitmap32.Height + 2 * aRadius + 1);
  for xBitmap := 0 to lWidth1 do
  begin
    for iPass := 1 to aPasses do
    begin
      // First element is zero
      lSumArray[0].A := 0;
      lSumArray[0].R := 0;
      lSumArray[0].G := 0;
      lSumArray[0].B := 0;
      for y := Low(lSumArray) + 1 to High(lSumArray) do
      begin
        yBitmap := y - aRadius - 1;
        if yBitmap < 0 then
        begin
          yBitmap := 0;
        end
        else if yBitmap > lHeight1 then
        begin
          yBitmap := lHeight1;
        end;
        lColor32 := PColor32(aBitmap32.PixelPtr[xBitmap, yBitmap])^;
        lSumArray[y].A := lSumArray[y - 1].A + lColor32 shr 24;
        lSumArray[y].R := lSumArray[y - 1].R + lColor32 shr 16 and $FF;
        lSumArray[y].G := lSumArray[y - 1].G + lColor32 shr 8  and $FF;
        lSumArray[y].B := lSumArray[y - 1].B + lColor32        and $FF;
      end;
      for yBitmap := 0 to lHeight1 do
      begin
        y := yBitmap + aRadius + 1;
        PColor32(aBitmap32.PixelPtr[xBitmap, yBitmap])^ :=
          ((lSumArray[y + aRadius].A - lSumArray[y - aRadius - 1].A)
        div lBoxSize) shl 24 or
          ((lSumArray[y + aRadius].R - lSumArray[y - aRadius - 1].R)
        div lBoxSize) shl 16 or
          ((lSumArray[y + aRadius].G - lSumArray[y - aRadius - 1].G)
        div lBoxSize) shl 8  or
           (lSumArray[y + aRadius].B - lSumArray[y - aRadius - 1].B)
        div lBoxSize;
      end;
    end;
  end;
end;

Gruß
Jürgen