Einzelnen Beitrag anzeigen

Pfoto

Registriert seit: 26. Aug 2005
Ort: Daun
541 Beiträge
 
Turbo Delphi für Win32
 
#18

Re: "Ambilight"- Glow- Effekt um Image

  Alt 8. Mär 2009, 13:45
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]roy_m_klever@hotmail.com[/email]
//* [email]dyster_tid@hotmail.com[/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
Jürgen Höfs
  Mit Zitat antworten Zitat