"Ambilight"- Glow- Effekt um Image

[neo4a]

Hallo Jürgen,

vielen Dank für diese Funktion, die ich so mit eingebaut habe:

Delphi-Quellcode:

procedure TForm1.sButton2Click(Sender: TObject);
var img1,img2:TBitmap32; r:TRect;
begin
  img1:=TBitmap32.Create;
  img2:=TBitmap32.Create;

  //Hole das Bild aus der TImage32-Komponente
  img2.Assign(image321.Bitmap);
  //Platz schaffen für's Überstrahlen
  img1.SetSize(img2.Width+80,img2.Height+80);
  //Zoomen mit ein wenig Platz
  img1.Draw(rect(20,20,img1.Width-20,img1.Height-20),
              rect(0,0,img2.Width,img2.Height),img2);
  //aus gr_fastfx
  ApplySaturationLut(img1,SaturationLut(680));
  GaussianBlur(img1,8);
  //intern
  FastBlur(img1,2,15);
  //aus gr_graphutils
  DrawSides(img2,img2.ClipRect,clWhite,clWhite,ALLFRAME_SIDES,200,2);
  r:=img1.BoundsRect;
  r.Right:=r.Right-1;
  r.Bottom:=r.Bottom-1;
  DrawSides(img1,r,clWhite,clWhite,ALLFRAME_SIDES,200,2);
  //Und zurück in die Komponente
  image321.Bitmap.SetSize(img1.Width+1,img1.Height+1);
  image321.Bitmap.Draw(0,0,img1);
  image321.Bitmap.Draw(40,40,img2);
end;

Die zusätzlichen Routinen kommen von einer Bibliothek gr32exv0.9 eines chinesischen Programmierers. Dort gibt es auch einen Ansatz, wie man den Background der TImage32-Komponente transparent bekommt. Leider gab es beim "mergen" mit meiner D2009-Version von Graphics32 eine Reihe von Problemen, die bis ich jetzt nicht lösen konnte.

Als Skinning-Lösung benutze ich die AlphaControl-Lib. Der erste Schritt passt (mir) schon ganz gut. Das mit der Transparenz bekomme ich auch noch hin. Vielen Dank nochmals für Deinen Ansatz.

--
Andreas

[Pfoto]

Hallo Andreas,

Das sieht ja richtig gut aus!

Unterscheidt sich der GaussianBlur eigentlich vom
Ergebnis viel vom FastBlur-Algo? Oder warum hast du
beide hintereinander eingebaut?

Wirkt denn der Effekt noch, wenn weniger farbige
Stellen im Bild sind, oder wirst du dann etwas nachhelfen?


Gruß
Jürgen

[neo4a]

Hallo Jürgen,

sie unterscheiden sich nicht wirklich im Ergebnis und ich habe FastBlur zunächst drin gelassen, damit ... weil ich damit halt angefangen habe. Allerdings musste ich später feststellen, dass die oben vorgestellte Lösung ein Performance-Problem hat. Die Ursache war die FastBlur-Routine. Ich habe sie entfernt, nun klappt's auch mit BilleniumEffects (Smooth Alphablending OnMouseEnter/Leave). Das kommt richtig gut.

Zufrieden werde ich aber erst sein, wenn das Transparenz-Problem gelöst ist und der Effekt auf "realem" Hintergrund funktioniert.

Du hast Recht: Wenn das Bild z.B. einen breiten schwarzen Rand hat, verschwindet derzeit der Glow- Effekt noch. Ich experimentiere hier damit, vor dem GaussianBlur die Kontur des Bildes mit einer Neon- Farbe dick nachzuzeichnen. Damit glüht dann immer was. Hierzu müsste ich allerdings in der Lage sein, programmtechnisch die Farben des Bild- Randbereiches gewichtet zu bestimmen. Das bin ich derzeit nicht.

--
Andreas

[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?

[Die Muhkuh]

TBitmap32 kommt von der Graphics32-Bibliothek, die brauchst Du noch.

[Meflin]

Sehr schöner Effekt, das müsste man bei Gelegenheit mal nach PHP portieren

Leider gibts die Graphics32 nicht für PHP, sonst wärs ja einfach

[Larsi]

Ja aber was muss ich in den uses eintragen damit alles vom Compiler erkannt wird.

[Pfoto]

Nachdem du die GR32- Bibliothek installiert hast (zumindest die Pfade eingetragen hast),
musst du GR32 in die Uses-Klausel eintragen.


Edit:
hier ist übrigens die neueste Funktion, nochmals optimiert (gefunden im GR32-Forum):

Delphi-Quellcode:

procedure FastBlur(Dst: TBitmap32; Radius: Integer; Passes: Integer = 3);
//****************************************************************
//*  Fastblur routine (c)2005 Roy Magne Klever
//*  GR32 Conversion and further optimizations by Michael Hansen
//*  If you improve it please send a copies to:
//*  [email][e-mail][/email]
//*  [email][e-mail][/email]
//****************************************************************
type
   PARGB32 = ^TARGB32;
   TARGB32 = packed record
     B: Byte;
     G: Byte;
     R: Byte;
     A: Byte;
   end;
   TLine32 = array[0..MaxInt div SizeOf(TARGB32) - 1] of TARGB32;
   PLine32 = ^TLine32;

   PSumRecord = ^TSumRecord;
   TSumRecord = packed record
     saB, saG, saR, saA: Cardinal;
   end;

var
   J, X, Y, w, h,  ny, tx, ty: integer;
   ptrD: integer;
   s1: PLine32;
   C: TColor32;
   sa: array of TSumRecord;
   sr1, sr2: TSumRecord;
   n : Cardinal;
begin
   if Radius = 0 then Exit;

   n := Fixed(1 / ((radius * 2) + 1));
   w := Dst.Width - 1;
   h := Dst.Height - 1;

   SetLength(sa, w + 1 + (radius * 2));

   s1 := PLine32(Dst.PixelPtr[0,0]);
   ptrD := Integer(Dst.PixelPtr[0,1]) - Integer(s1);

   ny := Integer(s1);
   for Y := 0 to h do
   begin
     for J := 1 to Passes do
     begin
       X := - Radius;
       while X <= w + Radius do
       begin
         tx := X;
         if tx < 0 then tx := 0 else if tx >= w then tx := w;
         sr1 := sa[X + Radius - 1];
         C := PColor32(ny + tx shl 2)^;
         with sa[X + Radius] do
         begin
           saA := sr1.saA + C shr 24;
           saR := sr1.saR + C shr 16 and $FF;
           saG := sr1.saG + C shr 8 and $FF;
           saB := sr1.saB + C and $FF;
         end;
         inc(X);
       end;
       for X := 0 to w do
       begin
         tx  := X + Radius;
         sr1 := sa[tx + Radius];
         sr2 := sa[tx - 1 - Radius];
         PColor32(ny + X shl 2)^ := (sr1.saA - sr2.saA) * n shl 8 and 
$FF000000 or
                                    (sr1.saR - sr2.saR) * n and $FF0000 or
                                    (sr1.saG - sr2.saG) * n shr 8 and $FF00 
or
                                    (sr1.saB - sr2.saB) * n shr 16;
       end;
     end;
     inc(ny, PtrD);
   end;

   SetLength(sa, h + 1 + (Radius * 2));
   for X := 0 to w do
   begin
     for J := 1 to Passes do
     begin
       ny := Integer(s1);
       Y := - Radius;
       while Y <= h + Radius do
       begin
         if (Y > 0) and (Y < h) then inc(ny, PtrD);
         sr1 := sa[Y + Radius - 1];
         C := PColor32(ny + X shl 2)^;
         with sa[Y + Radius] do
         begin
           saA := sr1.saA + C shr 24;
           saR := sr1.saR + C shr 16 and $FF;
           saG := sr1.saG + C shr 8 and $FF;
           saB := sr1.saB + C and $FF;
         end;
         inc(Y);
       end;
       ny := Integer(s1);
       for Y := 0 to h do
       begin
         ty := Y + Radius;
         sr1 := sa[ty + Radius];
         sr2 := sa[ty - 1 - Radius];
         PColor32(ny + X shl 2)^ := (sr1.saA - sr2.saA) * n shl 8 and 
$FF000000 or
                                    (sr1.saR - sr2.saR) * n and $FF0000 or
                                    (sr1.saG - sr2.saG) * n shr 8 and $FF00 
or
                                    (sr1.saB - sr2.saB) * n shr 16;
         inc(ny, PtrD);
       end;
     end;
   end;
   SetLength(sa, 0);
end;

Edit2:

Die von neo4a benutze zusätzliche Library ist übrigens hier:
http://code.google.com/p/gr32ex/

Da müsste dann auch die andere Blur-Funktion zu finden sein.

Gruß
Jürgen

[Larsi]

Kompillieren geht jetzt ohne Fehler aber ich habe keine Komponente mit dem Namen TBitmap32.

[Pfoto]

Wenn du die Komponenten installieren möchtest, muss du dafür erst die erforderlichen Packages installiern

z.B. für Turbo Delphi 2006
GR32_BDS2006.bdsproj (für Runtime)
GR32_DSGN_BDS2006.bdsproj (für Designtime)

Gruß
Jürgen