AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Bild weichzeichnen

Ein Thema von BlueStarHH · begonnen am 5. Dez 2005 · letzter Beitrag vom 20. Okt 2014
Antwort Antwort
BlueStarHH

Registriert seit: 28. Mär 2005
Ort: Hamburg
850 Beiträge
 
Delphi 11 Alexandria
 
#1

Bild weichzeichnen

  Alt 5. Dez 2005, 15:11
Hi,

ich möchte ein Bild mit dem "gaussian blur"-Algorithmus (Gaußischer Weichzeichner) weichzeichnen. Kennt jemand eine Seite auf der eine Implementation in Delphi zu finden ist und/oder eine Seite wo die Funktionsweise des Algorithmus vorzugsweise auf Deutsch beschrieben ist? Vielen Dank!
  Mit Zitat antworten Zitat
Benutzerbild von Binärbaum
Binärbaum

Registriert seit: 19. Jan 2005
Ort: Elstra
764 Beiträge
 
Delphi 7 Enterprise
 
#2

Re: Bild weichzeichnen

  Alt 5. Dez 2005, 15:54
Hallo Blue Star,

ein erster Anlaufpunkt wäre sicherlich Bei Google suchenGaußsches Weichzeichnen oder Wikipedia.
Wenn man dann einmal das grundlegende Prinzip bzw. den Algorithmus verstanden hat, sollte ein Implementation mit Delphi auch nicht mehr so schwierig sein.

MfG
Binärbaum
There are exactly 10 kinds of people: those who understand binary, and those who don't.
---
"Software reift beim Kunden. Bei Hardware ist es anders: Hardware fault beim Kunden." - Rainer G. Spallek
  Mit Zitat antworten Zitat
Pfoto

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

Re: Bild weichzeichnen

  Alt 5. Dez 2005, 15:55
Hallo,

ich habe einen Code in Benutzung, der u.a. auch hier erwähnt wird:
http://www.delphi-library.de/viewtop...a5900d&t=19270

(Man darf doch auf Postings eines anderen Delphi-Forums linken, oder?)


Gruß
Pfoto
Jürgen Höfs
  Mit Zitat antworten Zitat
Benutzerbild von Aenogym
Aenogym

Registriert seit: 7. Mär 2004
Ort: Schwerin
1.089 Beiträge
 
Delphi 7 Enterprise
 
#4

Re: Bild weichzeichnen

  Alt 5. Dez 2005, 15:57
Zitat von Pfoto:
(Man darf doch auf Postings eines anderen Delphi-Forums linken, oder?)
natürlich, zumal es sich um ein partnerforum handelt
Steffen Rieke
Was nicht buzzt, wird buzzend gemacht!
http://blog.base-records.de
http://www.base-records.de
  Mit Zitat antworten Zitat
Benutzerbild von Khabarakh
Khabarakh

Registriert seit: 18. Aug 2004
Ort: Brackenheim VS08 Pro
2.876 Beiträge
 
#5

Re: Bild weichzeichnen

  Alt 5. Dez 2005, 16:40
Hier noch eine Routine, die sehr schnell sein sollte.
Delphi-Quellcode:
****************************************************************
* Fastblur routine (c)2005 Roy Magne Klever
* If you improve it send me a copy at [email]roy_m_klever@hotmail.com[/email]
****************************************************************
procedure rkFastBlur(src, dest: TBitmap; radius, rep: integer);
type
  PRGB24 = ^TRGB24;
  TRGB24 = packed record
    B: Byte;
    G: Byte;
    R: Byte;
  end;
  TLine24 = array[0..MaxInt div SizeOf(TRGB24) - 1] of TRGB24;
  PLine24 = ^TLine24;
var
  j, divF, i, w, h, x, y, ny, tx, ty, prg: integer;
  p: pRGB24;
  ptrS, ptrD, pv: integer;
  s0, s1: PLine24;
  saR, saG, saB: array of Integer;
begin
  dest.Assign(src);
  if radius = 0 then
    Exit;

  divF := (radius * 2) + 1;
  w := dest.Width - 1;
  h := dest.Height - 1;
  SetLength(saR, w + 1 + (radius * 2));
  SetLength(saG, w + 1 + (radius * 2));
  SetLength(saB, w + 1 + (radius * 2));

  s1 := dest.ScanLine[0];
  ptrD := integer(dest.ScanLine[1]) - integer(s1);

  ny := Integer(s1);
  for y := 0 to h do
  begin
    for j := 1 to rep do
    begin
      i := -radius;
      while i <= w + radius do
      begin
        tx := i;
        if tx < 0 then
          tx := 0
        else if tx >= w then
          tx := w;
        with pRGB24(ny + tx * 3)^ do
        begin
          saR[i + radius] := r + saR[i + radius - 1];
          saG[i + radius] := g + saG[i + radius - 1];
          saB[i + radius] := b + saB[i + radius - 1];
        end;
        inc(i);
      end;
      for x := 0 to w do
      begin
        tx := x + radius;
        with pRGB24(ny + x * 3)^ do
        begin
          r := ((saR[tx + radius] - saR[tx - 1 - radius]) div divF);
          g := ((saG[tx + radius] - saG[tx - 1 - radius]) div divF);
          b := ((saB[tx + radius] - saB[tx - 1 - radius]) div divF);
        end;
      end;
    end;
    inc(ny, PtrD);
  end;

  SetLength(saR, h + 1 + (radius * 2));
  SetLength(saG, h + 1 + (radius * 2));
  SetLength(saB, h + 1 + (radius * 2));
  for x := 0 to w do
  begin
    for j := 1 to rep do
    begin
      ny := Integer(s1);
      i := -radius;
      while i <= h + radius do
      begin
        if (i > 0) and (i < h) then
          inc(ny, PtrD);
        with pRGB24(ny + x * 3)^ do
        begin
          saR[i + radius] := r + saR[i + radius - 1];
          saG[i + radius] := g + saG[i + radius - 1];
          saB[i + radius] := b + saB[i + radius - 1];
        end;
        inc(i);
      end;
      ny := Integer(s1);
      for y := 0 to h do
      begin
        ty := y + radius;
        with pRGB24(ny + x * 3)^ do
        begin
          r := ((saR[ty + radius] - saR[ty - 1 - radius]) div divF);
          g := ((saG[ty + radius] - saG[ty - 1 - radius]) div divF);
          b := ((saB[ty + radius] - saB[ty - 1 - radius]) div divF);
        end;
        inc(ny, PtrD);
      end;
    end;
  end;
  SetLength(saR, 0);
  SetLength(saG, 0);
  SetLength(saB, 0);
end;
Etwas optimiert, allerdings für die GR32-Lib:
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;
Ein weiterer Algorithmus von dizzy lässt sich in der CodeLib finden.
Sebastian
Moderator in der EE
  Mit Zitat antworten Zitat
BlueStarHH

Registriert seit: 28. Mär 2005
Ort: Hamburg
850 Beiträge
 
Delphi 11 Alexandria
 
#6

Re: Bild weichzeichnen

  Alt 5. Dez 2005, 17:09
Zitat von Binärbaum:
ein erster Anlaufpunkt wäre sicherlich Bei Google suchenGaußsches Weichzeichnen oder Wikipedia.
Wenn man dann einmal das grundlegende Prinzip bzw. den Algorithmus verstanden hat, sollte ein Implementation mit Delphi auch nicht mehr so schwierig sein.
Ersteinmal vielen Dank für die Antworten. Der Text in der Wikipedia und was ich vor dem Posten dieser Frage in Google gefunden habe, hilft mir beim Verständnis des Algorithmus nicht viel weiter. In der Wikipedia steht z.B. nicht, wie die Matrix genau genutzt wird um die Farbe von einem Pixel zu errechnen. Nehmen wir mal an, ich habe folgendes Graustufenbild (jede Zahl gibt die Graufärbung von 0 bis 255 eines Pixels an):

Code:
50  55  60 
45 200 100
10   0   5
Wie würde das Resultat nun aussehen, wenn man die Matrix aus der Wikipedia nutzt? Und wie verrechnet man die Ausgangs-Pixel mit der Matrix nun? Mir geht es hier nicht um eine schnelle optimierte Lösung, sondern um eine einfache, simple zum nachvollziehen. Danke!

Aus der Wikipedia:

Code:
Pixel Gaußwert -> Vorfaktor*Ganzzahl
0     0,16              343*55
1     0,10              343*33
2     0,02              343*7
3     0,00              343*0
 Matrix          
 1  4   7   4   1
 4  20  33  20  4
 7  33  55  33  7    x 343
 4  20  33  20  4
 1  4   7   4   1
Noch eine Frage: Wie kommt man von dem Gaußwert auf Vorfaktor*Ganzzahl?
  Mit Zitat antworten Zitat
Benutzerbild von Garfield
Garfield

Registriert seit: 9. Jul 2004
Ort: Aken (Anhalt-Bitterfeld)
1.335 Beiträge
 
Delphi XE5 Professional
 
#7

AW: Re: Bild weichzeichnen

  Alt 20. Okt 2014, 07:28
Das Thema ist zwar alt, aber ich habe eine Frage zu diesem Bereich:
Delphi-Quellcode:
****************************************************************
* Fastblur routine (c)2005 Roy Magne Klever
* If you improve it send me a copy at [email]roy_m_klever@hotmail.com[/email]
****************************************************************
procedure rkFastBlur(src, dest: TBitmap; radius, rep: integer);

...

      i := -radius;
      while i <= w + radius do
      begin
        tx := i;
        if tx < 0 then
          tx := 0
        else if tx >= w then
          tx := w;
        with pRGB24(ny + tx * 3)^ do
        begin
          saR[i + radius] := r + saR[i + radius - 1];
          saG[i + radius] := g + saG[i + radius - 1];
          saB[i + radius] := b + saB[i + radius - 1];
        end;
        inc(i);
      end;

...
Der Startwert von i ist -radius. Dann wäre der erste Wert für i + radius - 1 -1. Das Array beginnt doch aber mit Element 0. Warum kommt es da nicht zu einem Fehler? Werden dann für das Element -1 irgendwelche zufälligen Werte genommen?
Gruss Garfield
Ubuntu 22.04: Laz2.2.2/FPC3.2.2 - VirtBox6.1+W10: D7PE, DXE5Prof
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.184 Beiträge
 
Delphi 12 Athens
 
#8

AW: Bild weichzeichnen

  Alt 20. Okt 2014, 09:02
Pixel-Farbfehler am Rand wird es bestimmt geben.

Die Lines liegen direkt hintereinander, also erwischt man da entweder das letzte Pixel Zeile drunterliegenden Zeile. (die Lines gehen von links nach rechts und dann von unten nach oben)
Eventuell liegt noch zwischen den Lines ein Align-Bereich, welcher mit 0 (Schwarz) gefüllt ist
und vor der untersten Line liegt praktisch noch der Bitmap-Header.
Man erwischt also immer irgendeinen Speicher und bekommt keine Zugriffsverletzung.

Und Indexfehler dür die -1 bekommt man auch nicht, da ihr in eurem Code bestimmt die Bereichsprüfung deaktiviert habt.
$2B or not $2B
  Mit Zitat antworten Zitat
Blup

Registriert seit: 7. Aug 2008
Ort: Brandenburg
1.477 Beiträge
 
Delphi 12 Athens
 
#9

AW: Bild weichzeichnen

  Alt 20. Okt 2014, 09:45
Liegt ein Teil der Pixel die für die Berechnung nicht im Bild vor (X außerhalb des Randes), werden diese auch nicht in die Berechnung einbezogen.
Code:
X.X.X
X.E.F
X.H.I

Neu.E := (
0 + 0 + 0 +
0 + E * Faktor.E + F * Faktor.F +
0 + H * Faktor.H + I * Faktor.I)
/ (
1 * 1 * 1 *
1 * Faktor.E * Faktor.F *
1 * Faktor.H * Faktor.I)
Der Divisor muss bei einer 3x3-Matrix also einmal für jeden Eckpunkt und für jeden Rand neu berechnet werden.
  Mit Zitat antworten Zitat
Benutzerbild von Garfield
Garfield

Registriert seit: 9. Jul 2004
Ort: Aken (Anhalt-Bitterfeld)
1.335 Beiträge
 
Delphi XE5 Professional
 
#10

AW: Bild weichzeichnen

  Alt 20. Okt 2014, 11:58
Und Indexfehler dür die -1 bekommt man auch nicht, da ihr in eurem Code bestimmt die Bereichsprüfung deaktiviert habt.
Das ist es. Die Bereichsprüfung ist default = false. Bei true kommt eine Fehlermeldung. Bei mir kommen für Element -1 reproduzierbar Werte von 436 raus.

Danke himi.

@ Blup: Der Gauss ist mir klar. Mir ging es nur um die -1.
Gruss Garfield
Ubuntu 22.04: Laz2.2.2/FPC3.2.2 - VirtBox6.1+W10: D7PE, DXE5Prof

Geändert von Garfield (20. Okt 2014 um 12:02 Uhr)
  Mit Zitat antworten Zitat
Antwort Antwort


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:57 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