AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi "Ambilight"- Glow- Effekt um Image
Thema durchsuchen
Ansicht
Themen-Optionen

"Ambilight"- Glow- Effekt um Image

Ein Thema von neo4a · begonnen am 6. Mär 2009 · letzter Beitrag vom 10. Mär 2009
 
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
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:16 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz