Circular spectrum visualizer

[Michael II]

Hoi EWeiss

mit Tests wie beschrieben

Delphi-Quellcode:

  for i := 0 to FFFTSize -1 do
  begin
     Dat[i].r := cos(i/FFFTSize*2*pi);
     Dat[i].i := 0;
  end;

kannst du prüfen, ob deine FFT überhaupt korrekte Resultate zurückmeldet. Du kannst deine FFT direkt mit diesem Test-Dat-Array aufrufen oder den Test-Code wie beschrieben einfügen in deine FFT.

Dann setzt du einen Breakpoint am Ende deiner FFT Prozedur und überprüfst, ob FFT korrekt rechnet (ob korrekte Werte in Dat stehen).

Wenn keine korrekten Werte drin stehen, dann
- musst du deine FFT proc checken.
oder
- du nimmst eine fertige FFT proc hier aus dem Forum.

[Michael II]

und falls du noch daran arbeitest..

Betrifft uSpectrum.pas, TSpectrum.Draw

Im VB Code steht:

Delphi-Quellcode:

q1 = (mGain * Gain + 9)

Im Delphi Code

Delphi-Quellcode:

q1 := (FGain * FGain + 9);

[EWeiss]

Zitat:

@Delphi.Narium

Danke für deine ausführliche Erklärung.

Zitat:

Zitat von Michael II (Beitrag 1428564)

und falls du noch daran arbeitest..

Betrifft uSpectrum.pas, TSpectrum.Draw

Im VB Code steht:

Delphi-Quellcode:

q1 = (mGain * Gain + 9)

Im Delphi Code

Delphi-Quellcode:

q1 := (FGain * FGain + 9);

Jo bin ich noch.
Sehe keinen Widerspruch.

Delphi-Quellcode:

property Gain: Single read GetGain write SetGain;
function TSpectrum.GetGain: Single;
begin

  Result := FGain;
end;

procedure TSpectrum.SetGain(const Value: Single);
begin

  FGain := Value;
end;

Spätestens nach dem ändern des Property über das Knob ist FGain das gleich wie Gain.
Innerhalb der FFT ändere ich den wert nicht er bleibt dort immer gleich.

also ist FGain = 4 dann ist es Gain ebenfalls
Es mag für eine Mikrosekunde ein unterschied sein danach ist es aber ausgeglichen, dreh ja nicht ständig am Knob.

Kurz um FGain ist immer Gain solange ich das Knob nicht betätige.
Warum soll ich mich also des Getter bedienen wenn die Value von FGain von außerhalb gesetzt wird.

Im Anhang 2 Shots in denen man sehen kann was "var" bei FFT bewirkt.
Volllast es wird keine Musik wiedergegeben.

gruss

[Michael II]

Ah gut spielt Gain FGain keine Rolle.

Wegen var oder nicht var:

Es gibt schon einen Unterschied zwischen

procedure A( var x : integer )

und

procedure A( x : integer )

;-)

[EWeiss]

Zitat:

Zitat von Michael II (Beitrag 1428570)

Ah gut spielt Gain FGain keine Rolle.

Wegen var oder nicht var:

Es gibt schon einen Unterschied zwischen

procedure A( var x : integer )

und

procedure A( x : integer )

;-)

100% gebe ich dir recht.
Das sehe ich ja auch wenn ich die beiden Bilder so betrachte.

ohne var wird Rings gar nicht angezeigt mit var in Vollausschlag. (wohlbemerkt ohne Musik) Spectrum müsste eigentlich 0 sein.
Ich glaube dir das es richtig ist habe nur jetzt ein Problem das ich herausfinden muss warum nur das var eine solch immense Veränderung hervorruft.

Das ist mein Problem ;)

Zitat:

Ah gut spielt Gain FGain keine Rolle.

Doch schon nur ich sehe keinen sinn darin den Getter aufzurufen wenn FGain von außen gesetzt wird.
Wenn jetzt im Getter 1 Millionen von Berechnungen stattfinden würden die ich bereits außerhalb von Getter getätigt habe wäre der Code redundant..
So heißt das Wort denke ich mal. ;)
Es wäre unnötige rechen zeit da der wert FGain = Gain schon bekannt ist. Wäre in dem Fall doppelt gemoppelt.

gruss

[EWeiss]

Sorry hier noch zwei shots..
Einmal mit und einmal ohne Sound..

Vielleicht muss ich den Buffer vorher nullen mit FillChar\FillMemory.

gruss

[Delphi.Narium]

Oder kann es doch noch irgendwo zu 'nem Überlauf kommen.

Eigentlich hätte ich nach den bisherigen Analysen immer mit Werte rund um 0 gerechnet (so wie im zweiten Screenshot).

Die Werte im ersten Screenshot liegen irgendwie alle weit außerhalb des Bereiches, den man in 'nem Integer unterbringen kann.

Solange es sich nur um positive Werte handeln sollte, also > 0, würden sie so gerade eben in 'nen Cardinal passen.

Da es aber (wie mir scheint) auch negative Werte geben kann, muss es wohl Int64 werden.

[Michael II]

Hoi EWeiss

die von dir genutzte uSpectrum.FFT Funktion rechnet falsch.

Nimm doch eine hier aus dem Forum, zum Beispiel diese hier


Ich habe die Unit aus dem Forum etwas gekürzt (Code hier unten). Diese Unit fügst du zu deinem Projekt hinzu:

Delphi-Quellcode:

unit uDFT;

interface

uses Math;

//
// Autor Matze - siehe: https://www.delphipraxis.net/597828-post1.html
//


type
  TComplex = record
    re, im: Extended;
  end;

  TComplexArray = array of TComplex;

procedure DFT(var a: TComplexArray);

implementation

function AddC(a, b: TComplex): TComplex;
begin
  Result.re := a.re + b.re;
  Result.im := a.im + b.im;
end;


function SubC(a, b: TComplex): TComplex;
begin
  Result.re := a.re - b.re;
  Result.im := a.im - b.im;
end;


function MulC(a, b: TComplex): TComplex;
begin
  Result.re := a.re * b.re - a.im * b.im;
  Result.im := a.re * b.im + a.im * b.re;
end;

function MakeC(re, im: extended): TComplex;
begin
  Result.re := re;
  Result.im := im;
end;


procedure shuffle(var a: TComplexArray; n, lo: Integer);
var I, m: Integer;
    b: TComplexArray;
begin
  m := n shr 1;
  setlength(b, m);
  for I := 0 to m - 1 do
    b[i] := a[lo + i];
  for I := 0 to m - 1 do
    a[lo + i + i + 1] := a[lo + i + m];
  for I := 0 to m - 1 do
    a[lo + i + i] := b[i];
end;


procedure DoFFT(var a: TComplexArray; n, lo: Integer; w: TComplex);
var I, m: Integer;
    z, v, h: TComplex;
begin
  if n and (n - 1) = 0 then
  begin
    if n > 1 then
    begin
        m := n shr 1;
        z := MakeC(1, 0);
        for I := lo to lo + m - 1 do
        begin
            h := SubC(a[i], a[i + m]);
            a[i] := AddC(a[i], a[i + m]);
            a[i + m] := MulC(h, z);
            z:=MulC(z,w);
        end;
        v := MulC(w, w);
        DoFFT(a, m, lo, v);
        DoFFT(a, m, lo + m, v);
        shuffle(a, n, lo);
    end;
  end;
end;

procedure DFT(var a: TComplexArray);
begin
    DoFFT(a, length(a), 0, MakeC(cos(2 * Pi / length(a)),
        sin(2 * Pi / length(a))));
end;
end.

Wenn du die verwendeten Dateitypen (dein TComplex und Matzes TComplex) nicht anpassen magst, dann ersetze in uSpectrum.pas die FFT Funktion durch diese hier (Code unten). (uDFT unter uses hinzuzufügen.)

Delphi-Quellcode:

uses ….uDFT; 

…
…


procedure TSpectrum.FFT( var Dat : array of TComplex );
var a : uDFT.TComplexArray;
    i, n : integer;
begin
  n := length( Dat );
  setlength( a, n );

  for i := 0 to n-1 do
  begin
    a[i].re := Dat[i].r;
    a[i].im := Dat[i].i;
  end;

  DFT( a );

  for i := 0 to n-1 do
  begin
    Dat[i].r := a[i].re/n;
    Dat[i].i := a[i].im/n;
  end;
end;

Ich verwende für meine Programme eine iterative Version von Cooley und Tukey. Ich speichere dabei sämtliche Einheitswurzeln einmal in einer Tabelle ab und greife dann auf diese zu. Eine solche iterative Lösung ist bei der von dir gewählten Problemgrösse FFFTSize=2048 aber nur ca. 6 Mal schneller.

Selbst auf meinem langsamen Notebook benötigt obige Lösung nur ca. 2/1000 Sekunden.


Viel Spass beim Codieren.

[EWeiss]

@Michael Danke werde es mal testen.
Ich habe jetzt aber das Problem Gain wird in der FFT nicht berücksichtigt.

Delphi-Quellcode:

  if FView = 0 then
    sr := (4096 * FGain) / FFFTSize
  else
  sr := 1 / FFFTSize;

  for i := 0 to (FFFTSize div 2) - 1 do
  begin
    Dat[i].r := LimitedSingleValue(Dat[i].r * sr);
    Dat[i].i := LimitedSingleValue(Dat[i].i * sr);
  end;

Wo muss ich eine vergleichbare Berechnung zur FFT hinzufügen?
Mit deinen neuen FFT habe ich vielleicht 10 Pixel bei normaler Visualisierung.

Mit der von Matze wird die Visualisierung fast korrekt angezeigt aber mit einer Auslastung von 80% eines CPU Kerns.

gruss

[EWeiss]

Der FFT von Matze ist leider auch nicht korrekt aber destotrotz mein Ergebnis ist jetzt zu 98% richtig. Einen Tick zu wenig! CPU last 2%
Den Rest bekomme ich auch noch hin.
Bin also doch nicht ganz so blöd wie ich hier hingestellt werde brauche lediglich etwas mehr zeit!
Benötigte nur einen Funktionierenden FFT! Weil meine Mathe Kenntnisse dafür nicht ausreichen (niemand ist perfekt)

Ich habe jetzt Zeit investiert aber was zählt das schon die wird mit unter für weniger sinnvolles verplempert.

gruss

[Michael II]

Hoi EWeiss

schön klappt's.

DFT sollte funktionieren, ich habe die Funktion anhand einiger Beispiele durchgerechnet und bei weniger plausiblen Argumenten mit den Werten meiner eigenen Funktion verglichen.

Zum View=0 Fall. Ich hatte übersehen, dass der Autor für diesen Fall die Funktion FFT "missbraucht". Sowas gehört eigentlich (wie er es beim Fall View=1 getan hat) in die Prozedur, welche die Werte grafisch darstellt.

Wenn du den View=0 Fall dennoch (wie im Original) in die FFT() einbauen willst, dann so:

Delphi-Quellcode:

procedure TSpectrum.FFT( var Dat : array of TComplex );
var a : uDFT.TComplexArray;
    i, n : integer;
    sr : single;
begin
  n := length( Dat );
  setlength( a, n );

  for i := 0 to n-1 do
  begin
    a[i].re := Dat[i].r;
    a[i].im := Dat[i].i;
  end;

  DFT( a );

  if FView = 0 then
  sr := FGain/50
  else
  sr := 1/n;

  for i := 0 to n-1 do
  begin
    Dat[i].r := a[i].re * sr;
    Dat[i].i := a[i].im * sr;
  end;
end;

Und falls du View nicht in FFT einbaust, dann musst du für View=0 die Spektren mit dem Faktor scale (Code unten) skalieren:

Delphi-Quellcode:

    0:
      begin
        scale := FFFTSize/FGain*50;

        for o := 0 to FOctaveCount - 1 do
        begin
          fl := True;
          q2 := q2 + OctAreaSize;

          i2 := i1 * 2;
          while i1 < i2 do
          begin
            b := scale*Sqr(Spectrum[i1].r * Spectrum[i1].r + Spectrum[i1].i * Spectrum[i1].i);

[EWeiss]

Danke dir erstmal wie immer ;)

Ich habe es so gemacht.. mit einer anderen FFT die funktioniert sorry.

Delphi-Quellcode:

procedure TSpectrum.FFT(var Dat: array of TComplex);
var
  tp: array of TComplex;
  i: integer;
  sr: Extended;

begin

  SetLength(tp, FFFTSize);

  for i := 0 to FFFTSize - 1 do
  begin
    tp[i].re := Dat[i].re;
    tp[i].im := Dat[i].im;
  end;

  ForwardFFT(Dat, tp, FFFTSize);

  if FView = 0 then
    sr := (4096 * FGain) / FFFTSize
  else
  sr := 1 / FFFTSize;

  for i := 0 to (FFFTSize div 2) - 1 do
  begin
    Dat[i].re := tp[i].re * sr;
    Dat[i].im := tp[i].im * sr;
  end;

end;

Zitat:

Und falls du View nicht in FFT einbaust, dann musst du für View=0 die Spektren mit dem Faktor scale (Code unten) skalieren:

View ist nötig weil ich hier den Effekt umschalte zwischen Ring und Sector. Ohne funktioniert Rings nicht.

Ich kann deine FFT gerne nochmal gegentesten mit deiner Änderung.

gruss

[Michael II]

Ist klar, dass du View benötigst.

Ich würde es entweder wie im Code 2 gezeigt nachbessern; oder du kannst die angepasste FFT verwenden.

[EWeiss]

Zitat:

Zitat von Michael II (Beitrag 1428733)

Ist klar, dass du View benötigst.

Ich würde es entweder wie im Code 2 gezeigt nachbessern; oder du kannst die angepasste FFT verwenden.

Werde ich tun.. Danke
PN ist unterwegs.

gruss

[EWeiss]

Habe es versucht aber deine Version funktioniert leider nicht.
Mit meiner FFT.

nur das hier von mir geändert.

Delphi-Quellcode:

  if FView = 0 then
     sr := (4096 * FGain) / FFFTSize
   else
   sr := 1 / FFFTSize;

   for i := 0 to (FFFTSize div 2) - 1 do
   begin
     Dat[i].re := tp[i].re * sr;
     Dat[i].im := tp[i].im * sr;
   end;

anbei noch ein shot der Ringe..

gruss

[EWeiss]

Neue Version oben danke an @Michael II für seine Hilfe (Mitarbeit an der FFT) Ich verwende seine ;)
sowie an @Neutral General für die Lösung des 2D Arrays in eins zu verschieben.

Source include.

In D2010 geschrieben ihr müsst leider VCL.. selbst zu Grapics usw.. addieren in neueren Delphi Versionen.

gruss

[EWeiss]

Neue Version.
Wollte schon aufgeben wegen der Farben aber gut habe es gefixt!


- remove grWindow
- Add DoubleBuffer (Danke Michael II für die Idee)
- fix FarbSpectrum
- remove alte ARGB Function

fehlt noch Fade, Blur, Fire muss sehen was da noch falsch läuft.
Eventuell muss ich die Funktion direkt in die Draw Routine integrieren. (Mal sehn)

Habe die ARGB Funktion entfernt..
1. Kombination von Unsigned + Signed DateiType
2. Overflow konnte es nicht fixen (verwende jetzt meine eigene).

War Fehlerhaft bzw.. zu anfällig für Fehler

Delphi-Quellcode:

function ARGB(Alpha: Byte; Col: ColorRef): ColorRef;
begin

  if Alpha > 127 then
    Result := ColorRef(Int64(Col and $FFFFFF or (Int64(Alpha) - 256) * $1000000))
  else
  Result := Col and $FFFFFF or (Alpha * $1000000);
end;
{$ENDREGION}

Die alte Version habe ich mal oben gelassen zum vergleich.

gruss

[EWeiss]

Aktualisierte Version hochgeladen.
Änderungen siehe oben.

gruss

[Klaus01]

Hallo Emil,

Delphi-Quellcode:

            a := (((SpectrumData2D[x, y] and $FF000000) div $1000000) and $FF);
            a := a - d;

            c := SpectrumData2D[x, y] and $FFFFFF;

            if a > 127 then
              SpectrumData2D[x, y] := LongWord(c or ((a - 256) * $1000000))
            else
            SpectrumData2D[x, y] := LongWord(c or (a * $1000000));

a ist bei Dir als Byte definiert

Was passiert wenn d > a ist?

Es gibt ein wahrscheinlich nicht erwartetes Ergebnis.
Michael II hatte Dir dazu schon eine Lösung gepostet.

Grüße
Klaus

[EWeiss]

Zitat:

Zitat von Klaus01 (Beitrag 1429327)

Hallo Emil,

Delphi-Quellcode:

            a := (((SpectrumData2D[x, y] and $FF000000) div $1000000) and $FF);
            a := a - d;

            c := SpectrumData2D[x, y] and $FFFFFF;

            if a > 127 then
              SpectrumData2D[x, y] := LongWord(c or ((a - 256) * $1000000))
            else
            SpectrumData2D[x, y] := LongWord(c or (a * $1000000));

a ist bei Dir als Byte definiert

Was passiert wenn d > a ist?

Es gibt ein wahrscheinlich nicht erwartetes Ergebnis.
Michael II hatte Dir dazu schon eine Lösung gepostet.

Grüße
Klaus

Danke ;)

Es ging mir erst einmal darum den Original Quelltext einzubinden.
Weil wie gesagt alle anderen aus was für gründen auch immer nicht funktioniert haben.
Die Lösung vom Michael gibt auch überall 0 zurück auch mit geänderten DatenTyp zu LongWord.

Michael II verwendet auch Byte.
Sorry nein DWORD.

gruss

[EWeiss]

Nehme ich DWord dann habe ich hier

Delphi-Quellcode:

SpectrumData2D[x, y] := LongWord(c or ((a - 256) * $1000000))

einen Integerüberlauf.
Und schon sind wir wieder beim Thema das es nicht funktioniert.

PS:
Als Byte definiert habe ich Daten im Array.
Ob sie richtig sind? Keine Ahnung. Ich sagte ja schon bekomme das nicht gebacken.

gruss

[Michael II]

Zitat:

SpectrumData2D[x, y] := LongWord(c or ((a - 256) * $1000000))

Du mischst hier Datentypen wild durcheinander. Ich hatte dir vor einigen Tagen per PN eine 'Release' gesendet, welche funktionieren sollte. [Wenn dort noch was klemmen sollte, dann schreibe mir eine PN.]

Bei deinem obigen Problem: a-256 kann - wenn du a als BYTE definiert - problematisch sein, wenn a=0.

Mein Tipp: Mische nicht BYTEs und WORDs und DWORDs. Nimm DWORD; dann wird der Code übersichtlicher, lesbarer und tut dann auch eher das, was du erwartest ;-).

[EWeiss]

Zitat:

Wenn dort noch was klemmen sollte, dann schreibe mir eine PN.

PN ist unterwegs.

gruss

[EWeiss]

Meine einfache Lösung..

Delphi-Quellcode:

  case FEffect of
    0:
      begin
        d := round(FFade * 255);

        for y := 0 to 239 do
        begin
          for x := 0 to 239 do
          begin
            GDIP_BitmapGetPixel(imgSpectrum, x, y, Color);
            SKAERO_SplitColorARGB(Color, _a, _r, _g, _b);

            a := _a;

            if a >= d then
              a := a - d
            else
            a := 0;

            c := Color and $ffffff;
            GDIP_BitmapSetPixel(imgSpectrum, x, y, (a shl 24) or c);
          end;
        end;
      end;

Wie man sich vorstellen kann ist Get\SetPixel nicht die allerbeste Methode weil zu langsam und geht extrem auf die CPU.
Also neue Methode.

Delphi-Quellcode:

  case FEffect of
    0:
      begin
        d := round(FFade * 255);

        if GDIP_BitmapLockBits(imgSpectrum, nil, ImageLockModeRead or ImageLockModeWrite,
          PixelFormat32bppARGB, @BitmapData) = OK then
        begin
          GDIP_BitmapUnlockBits(imgSpectrum, @BitmapData);

          for Row := 0 to BitmapData.Height - 1 do
          begin
            RGBQuad := Scanline(BitmapData, Row);

            for Col := 0 to BitmapData.Width - 1 do
            begin
              Pixel := RGBQuad^;
              alpha := Pixel.rgbReserved;

              if alpha >= d then
                alpha := alpha - d
              else
              alpha := 0;

              Color := Byte(@Pixel) and $ffffff;
              GDIP_BitmapSetPixel(imgSpectrum, Col, Row, (alpha shl 24) or Color);
              inc(RGBQuad);
            end;
          end;
      end;

GDIP_BitmapGetPixel ist Vergangenheit..
GDIP_BitmapSetPixel aber leider nicht da ich nicht weis wie ich die gesamt Farbe des Pixel an das Bitmap übergeben soll.

Wo ist mein Denkfehler, oder was verstehe ich nicht.

gruss

[Neutral General]

Was soll

Delphi-Quellcode:

//
Color := Byte(@Pixel) and $ffffff;

genau bewirken?
Zum einen tut ein "and $ffffff" rein gar nichts mit einem Byte und zum anderen castest du die (Adresse des (Pointers auf den Pixel)) auf ein Byte.
Das hat ziemlich wenig mit irgendeiner Farbe zu tun. Da hast du nur die untersten 8-Bit von irgendeiner Stackadresse.

[EWeiss]

Zitat:

Zitat von Neutral General (Beitrag 1429499)

Was soll

Delphi-Quellcode:

//
Color := Byte(@Pixel) and $ffffff;

genau bewirken?
Zum einen tut ein "and $ffffff" rein gar nichts mit einem Byte und zum anderen castest du die (Adresse des (Pointers auf den Pixel)) auf ein Byte. Das hat ziemlich wenig mit irgendeiner Farbe zu tun.

Hmmm…
Wenn das Pixel keinen Alpha wert hat soll das Pixel den Wert 0 erhalten also schwarz.
So verstehe ich das.

Delphi-Quellcode:

(alpha shl 24) or Color

PS:
Dann die Berichtigung..

Delphi-Quellcode:

Color := DWORD(@Pixel) and $FFFFFF;
GDIP_BitmapSetPixel(imgSpectrum, Col, Row, (alpha shl 24) or Color);

gruss

[Neutral General]

Ah jetzt verstehe ich was du machen willst.
Mach es einfach so:

Delphi-Quellcode:

if alpha >= d then
  Pixel.rgbReserved := alpha  - d
else
  Pixel.rgbReserved := 0;

GDIP_BitmapSetPixel(imgSpectrum, Col, Row, DWORD(Pixel));

[EWeiss]

Zitat:

Zitat von Neutral General (Beitrag 1429504)

Ah jetzt verstehe ich was du machen willst.
Mach es einfach so:

Delphi-Quellcode:

if alpha >= d then
  Pixel.rgbReserved := alpha  - d
else
  Pixel.rgbReserved := 0;

GDIP_BitmapSetPixel(imgSpectrum, Col, Row, DWORD(Pixel));

Danke.
Aber mein Problem ist ich möchte BitmapSetPixel nicht mehr verwenden darum geht es denn sonst macht die Funktion eigentlich keinen sinn.
Diese soll ja get\set ersetzen.

Mit Get\Set habe 30% CPU Auslastung das gilt zu minimieren weil Get oder SetPixel zu lastig sind.

gruss

[Neutral General]

Delphi-Quellcode:

RGBQuad^ := Pixel

statt

Delphi-Quellcode:

GDIP_BitmapSetPixel

:

Delphi-Quellcode:

if alpha >= d then
  Pixel.rgbReserved := alpha - d
else
  Pixel.rgbReserved := 0;
RGBQuad^ := Pixel;

Theoretisch geht auch einfach:

Delphi-Quellcode:

for Col := 0 to BitmapData.Width - 1 do
begin
  alpha := RGBQuad^.rgbReserved;

  if alpha >= d then
    RGBQuad^.rgbReserved := alpha - d
  else
    RGBQuad^.rgbReserved := 0;

  inc(RGBQuad);
end;

[EWeiss]

Zitat:

Zitat von Neutral General (Beitrag 1429506)

Delphi-Quellcode:

RGBQuad^ := Pixel

statt

Delphi-Quellcode:

GDIP_BitmapSetPixel

(Kombiniert mit dem Code von mir ohne das GDIP_BitmapSetPixel)

Danke werde ich mal versuchen.

gruss

[Neutral General]

Ach ja: Das GDIP_BitmapUnlockBits solltest du erst aufrufen nachdem du mit den Änderungen am Bild fertig bist.

[EWeiss]

Zitat:

Zitat von Neutral General (Beitrag 1429508)

Ach ja: Das GDIP_BitmapUnlockBits solltest du erst aufrufen nachdem du mit den Änderungen am Bild fertig bist.

Hatte das vorher mal versucht danach hatte er nicht mehr gerendert..
Aber du hast recht habe es geändert so funktioniert es.

So gehts.

Delphi-Quellcode:

  case FEffect of
    0:
      begin
        d := round(FFade * 255);

        if GDIP_BitmapLockBits(imgSpectrum, nil, ImageLockModeRead or ImageLockModeWrite,
          PixelFormat32bppARGB, @BitmapData) = OK then
        begin
          for Row := 0 to BitmapData.Height - 1  do
          begin
            RGBQuad := Scanline(BitmapData, Row);

            for Col := 0 to BitmapData.Width - 1 do
            begin
              Pixel := RGBQuad^;
              alpha := Pixel.rgbReserved;

              if alpha >= d then
                Pixel.rgbReserved := alpha - d
              else
              Pixel.rgbReserved := 0;

              RGBQuad^ := Pixel;
              inc(RGBQuad);
            end;
          end;
          GDIP_BitmapUnlockBits(imgSpectrum, @BitmapData);
        end;
      end;

Das mit dem Array war einfach nichts.

Ich habe versucht aus einen Leeren Bitmap Alpha werte zu extrahieren die nicht vorhanden waren. Wie soll das auch gehen bei einem leeren Array.
Irgendwo wurde das in VB initialisiert aber der Punkt ist nicht auszumachen.
Aber ich denke es geht auch so.

gruss

[EWeiss]

Wie komme ich an die X und y Position von BitmapData? bzw. RGBQuad
Muss ich ersetzen.

Delphi-Quellcode:

GDIP_BitmapGetPixel(imgSpectrum, Integer(Col) + dx, Integer(Row) + dy, Color);

Die Farbe muss ich über die Position erfragen.

Delphi-Quellcode:

    1:
      begin
        d := round(FFade * 10);

        if GDIP_BitmapLockBits(imgSpectrum, nil, ImageLockModeRead or ImageLockModeWrite,
          PixelFormat32bppARGB, @BitmapData) = OK then
        begin
          for Row := 0 to BitmapData.Height - 1 do
          begin
            RGBQuad := Scanline(BitmapData, Row);

            for Col := 0 to BitmapData.Width - 1 do
            begin
              Pixel := RGBQuad^;

              if (Col > 0) and (Row > 0) and (Col < BitmapData.Width - 1) and
                (Row < BitmapData.Height) then
              begin
                red   := 0;
                green := 0;
                blue  := 0;
                alpha := 0;

                for dy := -1 to 1 do
                begin
                  for dx := -1 to 1 do
                  begin
                    GDIP_BitmapGetPixel(imgSpectrum, Integer(Col) + dx, Integer(Row) + dy, Color);

                    alpha := alpha + ( Color and $ff000000 ) shr 24;
                    red   := red   + ( Color and $00ff0000 ) shr 16;
                    green := green + ( Color and $0000ff00 ) shr 8;
                    blue  := blue  + ( Color and $000000ff );
                  end;
                end;

                red   := red   div 9;
                green := green div 9;
                blue  := blue  div 9;
                alpha := alpha div 9;

                if alpha >= d then
                  Pixel.rgbReserved := alpha - d
                else
                Pixel.rgbReserved := 0;

                Color := blue or (green shl 8) or (red shl 16);
                GDIP_BitmapSetPixel(imgSpectrum, Col, Row, Color or (alpha shl 24));
              end else
                GDIP_BitmapSetPixel(imgSpectrum, Col, Row, 0);
            end;
            GDIP_BitmapUnlockBits(imgSpectrum, @BitmapData);
          end;
        end;
      end;

Get und Set Pixel ist noch nicht ersetzt.

Das RGBQuad hole ich mir hier drüber.

Delphi-Quellcode:

  function Scanline(BitmapData : TBitmapData; Stride: integer): PRGBQuad;
  begin
    result := BitmapData.Scan0;
    inc(PByte(result), Stride * bitmapData.stride);
  end;

EDIT:

Argghh..
Ich sehe gerade in der GDIObject.pas, die machen das auch nicht anders wie ich.
Aber genau das will ich nicht.

Delphi-Quellcode:

  function TGPBitmap.GetPixel(x, y: Integer; out color: TGPColor): TStatus;
  begin
    result := SetStatus(GdipBitmapGetPixel(GpBitmap(nativeImage), x, y, color));
  end;

Welchen sinn macht das? Dann kann ich mir GDIP_BitmapLockBits sparen macht so keinen sinn.
Ich hole mir alle Pixel in einem Rutsch und muss dann doch wieder die Position des Pixel mit GdipBitmapGetPixel einholen?
Was für ein Blödsinn. Oder?

EDIT2:
Ok die Lösung ist zurück zum Array.

gruss

[TiGü]

Auch wenn es mir jetzt schon leid tut und ich die Büchse der Pandora öffne:
Warum machst du das so mit Get/SetPixel und dieser for -1 to 1 Schleife?
Du hast doch die Farbe schon durch das RGBQuad.
Je nachdem wie du das definiert hast oder den Typ aus der Windows-Unit nimmst, kannst du doch auf RGBQuad.rgbBlue, RGBQuad.rgbGreen, RGBQuad.rgbRed, RGBQuad.rgbReserved (für Alpha: https://stackoverflow.com/questions/...is-rgbreserved) ganz einfach zugreifen?

Zum Vertiefen:
http://supercomputingblog.com/graphi...ckbits-in-gdi/
https://mfranc.com/programming/opera...mapkach-net-1/
https://delphi.fandom.com/wiki/GDI_Plus (nach LockBits suchen)

[EWeiss]

Zitat:

ganz einfach zugreifen?

Nun wenn man nicht davor sitzt ist es einfach ja da gebe ich dir recht.

Um die Effekte korrekt darzustellen benötige ich die X, Y Position eines jeden Pixel.
Die habe ich aber in der Funktion BitmapData nicht zur Verfügung.

So die originale Funktion der GDIP in der GDIObject.pas holt sich die Daten mit

Delphi-Quellcode:

  function TGPBitmap.GetPixel(x, y: Integer; out color: TGPColor): TStatus;
   begin
     result := SetStatus(GdipBitmapGetPixel(GpBitmap(nativeImage), x, y, color));
   end;

Das ist aber definitiv falsch denn dann macht GDIPBitmapLockBits keinen sinn mehr.
Gerade wegen der NICHT Verwendung von GdipBitmapGetPixel kann man die Schnelligkeit wie die Pixel über BitmapData gelesen werden erst erfassen.

GdipBitmapGetPixel verursacht eine Auslastung der CPU von 30%

Ich habe mir jetzt eine Hilfsfunktion geschrieben die macht folgendes.

Delphi-Quellcode:

function TSpectrum.BitmapLockBits(Img: LONG_PTR): TBitmapData;
var
  X, Y : integer;
  RGBQuad  : PRGBQuad;
  Pixel : TRGBQuad;
  BitmapData : TBitmapData;

function Scanline(BitmapData : TBitmapData; Stride: integer): PRGBQuad;
begin
    result := BitmapData.Scan0;
    inc(PByte(result), Stride * bitmapData.stride);
end;

begin
  if GDIP_BitmapLockBits(Img, nil, ImageLockModeRead or ImageLockModeWrite,
    PixelFormat32bppARGB, @BitmapData) = OK then
  begin
    for Y := 0 to BitmapData.Height - 1 do
    begin
      RGBQuad := Scanline(BitmapData, Y);
      for X := 0 to BitmapData.Width - 1 do
      begin
        Pixel := RGBQuad^;
        SpectrumData2D[X, Y] := DWord(Pixel);
        inc(RGBQuad);
      end;
    end;
    Result := BitmapData;
  end;
end;

Sie füllt mein leeres Array mit Daten an den benötigten X,Y Positionen.
Jetzt arbeite ich wie bisher mit dem Array und kann mir GdipBitmapGetPixel ersparen.

Die fertige Funktion vom Fire Effekt sieht so aus und ja sie läuft wie sie soll. ;)

Delphi-Quellcode:

    2:
      begin
        d := round(FFade * 64);
        BitmapData := BitmapLockBits(imgSpectrum);

        Buf := SpectrumData2D;

        if FSymmetrical then
        begin
          o := 0;
          s := 239 * 2;
        end else
        begin
          o := 0.5;
          s := 239;
        end;

        for Row := 0 to BitmapData.Height - 1 do
        begin
          RGBQuad := Scanline(BitmapData, Row);

          for Col := 0 to BitmapData.Width - 1 do
          begin
            Pixel := RGBQuad^;

            cx := Col / s - o;
            cy := Row / (BitmapData.Height - 1) - 0.5;

            radius := round(Sqrt(cx * cx + cy * cy));

            dx := round((cx + o + 0.01 * cx * ((radius - 1) / 0.5)) * s);
            dy := round((cy + 0.5 + 0.01 * cy * ((radius - 1) / 0.5)) * (BitmapData.Height - 1));

            alpha := Buf[dx, dy] shr 24;

            if alpha >= d then
              Pixel.rgbReserved := alpha - d
            else
            Pixel.rgbReserved := 0;

            Color := Buf[dx, dy] and $00FFFFFF;
            SKAERO_SplitColorARGB((Pixel.rgbReserved shl 24) or Color, _a, _r, _g, _b);

            Pixel.rgbBlue := _b;
            Pixel.rgbGreen := _g;
            Pixel.rgbRed := _r;
            Pixel.rgbReserved := _a;

            RGBQuad^ := Pixel;
            inc(RGBQuad);

          end;
          GDIP_BitmapUnlockBits(imgSpectrum, @BitmapData);
        end;
      end;

gruss

[Neutral General]

Zitat:

Zitat von EWeiss (Beitrag 1429542)

Um die Effekte korrekt darzustellen benötige ich die X, Y Position eines jeden Pixel.
Die habe ich aber in der Funktion BitmapData nicht zur Verfügung.

Du läufst doch mit einer Schleife über alle Pixel in BitmapData.
Die X/Y Position des aktuellen Pixels steht doch dann in den Schleifenvariablen (Row, Col) :gruebel:

[EWeiss]

Zitat:

Zitat von Neutral General (Beitrag 1429544)

Zitat:

Zitat von EWeiss (Beitrag 1429542)

Um die Effekte korrekt darzustellen benötige ich die X, Y Position eines jeden Pixel.
Die habe ich aber in der Funktion BitmapData nicht zur Verfügung.

Du läufst doch mit einer Schleife über alle Pixel in BitmapData.
Die X/Y Position des aktuellen Pixels steht doch dann in den Schleifenvariablen (Row, Col) :gruebel:

Richtig in meiner neuen Funktion.
Ja und deshalb weise ich sie dem Array zu.

Delphi-Quellcode:

      for X := 0 to BitmapData.Width - 1 do
       begin
         Pixel := RGBQuad^;
         SpectrumData2D[X, Y] := DWord(Pixel);
         inc(RGBQuad);
       end;

Ich muss das so machen weil ich nachher dem Buf das Array zuweisen muss..

Delphi-Quellcode:

Buf := SpectrumData2D;

PS:
Wie komme ich sonst an die X, Y Position ohne sie in jedem Durchlauf in der Render Funktion des jeweiligen Effekts durchzulaufen?
Das mache ich einmal in BitmapLockBits(imgSpectrum); und fertig.

gruss

[EWeiss]

Wie kann ich die Pixel direkt auf 0 setzen? Ohne jede Farbe einzeln zuzuweisen.

Delphi-Quellcode:

Pixel.rgbBlue := 0;
Pixel.rgbGreen := 0;
Pixel.rgbRed := 0;
Pixel.rgbReserved := 0;

gruss

[Neutral General]

DWORD(Pixel) := 0;

[EWeiss]

Zitat:

Zitat von Neutral General (Beitrag 1429549)

DWORD(Pixel) := 0;

Danke dann bin ich fertig.
Lade das Projekt gleich hoch.

Danke an alle für ihre Geduld. Schwierige Geburt! :)

gruss