Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Neuen Beitrag zur Code-Library hinzufügen (https://www.delphipraxis.net/33-neuen-beitrag-zur-code-library-hinzufuegen/)
-   -   Delphi Nachträglich: Bitmap-Blur (https://www.delphipraxis.net/135567-nachtraeglich-bitmap-blur.html)

Aphton 13. Jun 2009 11:15


Nachträglich: Bitmap-Blur
 
Hier meine einfach Blur-Methode - die auch Anwendung in vielen meiner Applikationen findet ...

Delphi-Quellcode:
type
  PRGBScanLine = ^TRGBScanLine;
  TRGBScanLine = Array[0..0] of TRGBTriple;

// --

function BlurBitmap(b: TBitmap; const Radius: Byte=1): Boolean;
var
  S, D: PRGBScanLine;
  x, y,
  k, l,
  dx, dy,
  t: Integer;
  _r, _g, _b,
  cnt: Cardinal;
begin
  S := PRGBScanLine( b.Scanline[b.Height-1] );
  // Sichere den orginalen Speicher:
  GetMem( D, b.Width * b.Height * 3 );
  try
    Move( S^, D^, b.Width * b.Height * 3 );
    t := Radius;
    for x := 0 to b.Width - 1 do
      for y := 0 to b.Height - 1 do
      begin
        _r := 0;
        _g := 0;
        _b := 0;
        cnt := 0;
        // "Umfeld" durchgehen .. (abhängig vom Radius)
        for k := -t to t do
          for l := -t to t do
          begin
            dx := x + k;
            dy := y + l;
            // Falls im Wertebereich {..}
            if (dx >= 0) and (dx < b.Width) and
               (dy >= 0) and (dy < b.Height) then
            // aus dem "orginalen Speicher"
            with D^[dy*b.Width+dx] do
            begin
              inc( _r, rgbtRed   );
              inc( _g, rgbtGreen );
              inc( _b, rgbtBlue  );
              // Anzahl der Additionen .. nachher zum Dividieren
              inc(cnt);
            end;
          end;
        // anwenden ..
        S^[y*b.Width+x].rgbtRed  := _R div cnt;
        S^[y*b.Width+x].rgbtGreen := _G div cnt;
        S^[y*b.Width+x].rgbtBlue := _B div cnt;
      end;
    Result := True;
  finally
    FreeMem( D );
  end;
end;
MfG


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:21 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz