"Ambilight"- Glow- Effekt um Image

[Larsi]

Zitat von 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

Ich habe in meinem Delphi komischerweise gar kein Bitmap32. Ist das vielleicht erst in einer neuen Version dabei? Welche Uses Units müssen eigentlich eingebunden werden, das es keine Compiler Fehler gibt?