Problem mit Oszilloskop-Darstellung

[Nuclear-Ping]

Grüße, liebe Community.

Ich habe das Problem, ein Oszilloskop ordentlich darzustellen.

Die Daten kommen als ein Byte-Strom von einer Audio-Quelle (TAudioIn-Komponente, LineIn / Mikro) und werden in einem BufferFilled-Event verarbeitet. Dabei werden sie (wegen Stereo) in Links / Rechts getrennt und (wegen 16bit) in Words konvertiert und danach in zwei TImages gezeichnet. Soweit die Theorie.

Die Praxis sieht jedoch so aus, dass ein ziemlich Grafik-Salat auf den Bildschirm gezaubert wird, statt einem gewünschten sauberen Oszilloskop. Nur der rechte Kanal (unten) sieht annähernd einem Oszilloskop ähnlich. (Siehe Anhang 1, Bild)

Der Author der "TAudio"-Komponente hat auch ein kleines Oszilloskop-Beispiel als PPT-Präsentation auf seiner HP (http://lbsneu.schule-bw.de/unterrich...elphisound.htm), die funktioniert, ist jedoch Byte-basiert, was mir aber nichts nützt und auch sonst relativ "buggy" ist (Daten werden z.B. nicht immer über die gesamte Fläche gezeichnet).

Hier mal mein Code. Sorry, wenn einige Teile umständlich programmiert sind, aber ich bin nicht unbedingt das Abstraktions- und Mathegenie.

Ich habe das Problem auch mal als kleines Demo-Programm angehängt, inkl. Komponente und .exe-Datei (nat. frei von irgendwelchem "Müll"). (Anhang 2, Zip-Archiv)

Wäre nett, wenn da mal jemand drüber schauen und mich erleuchten könnte, was ich falsch mache.

Delphi-Quellcode:

type
  TDataArray = Array of Byte;
  TWordDataArray = Array of Word;

procedure DrawOscilloscope (Buffer: PChar; Size: Integer;
                            OscRight, OscLeft: TBitmap;
                            LW, LH, RW, RH: Integer);

  // ----------------

  procedure CreateLocalBitmaps (var bmpL, bmpR: TBitmap);
  begin
    bmpL := TBitmap.Create;
    bmpL.Width  := LW;
    bmpL.Height := LH;

    // ****

    bmpL.Canvas.Pen.Width := 1;
    bmpL.Canvas.Pen.Color := clRed;

    bmpL.Canvas.MoveTo (0, round (bmpL.Height / 2));
    bmpL.Canvas.LineTo (bmpL.Width, round (bmpL.Height / 2));

    bmpL.Canvas.Pen.Width := 1;
    bmpL.Canvas.Pen.Color := clGreen;

    // ****

    bmpR := TBitmap.Create;
    bmpR.Width  := RW;
    bmpR.Height := RH;

    // ****

    bmpR.Canvas.Pen.Width := 1;
    bmpR.Canvas.Pen.Color := clRed;

    bmpR.Canvas.MoveTo (0, round (bmpR.Height / 2));
    bmpR.Canvas.LineTo (bmpR.Width, round (bmpR.Height / 2));

    bmpR.Canvas.Pen.Width := 1;
    bmpR.Canvas.Pen.Color := clGreen;
  end;

  // ----------------

  procedure FreeLocalBitmaps (var bmpL, bmpR: TBitmap);
  begin
    FreeAndNil (bmpL);
    FreeAndNil (bmpR);
  end;

  // ----------------

  procedure FillBuffer (Buffer: PChar; StartIndex, BufferSize: Integer;
    out FilledBuffer: TDataArray);
  var
    a, b: Integer;
  begin
    SetLength (FilledBuffer, 0);

    a := StartIndex;
    repeat
      b := Length (FilledBuffer);
      SetLength (FilledBuffer, b + 1);
      FilledBuffer[b] := Byte (Buffer[a]);
      inc (a, 2);
      if (a > BufferSize) then
        break;
    until FALSE;
  end;

  // ----------------

  procedure CheckBufferLengths (var BufferL, BufferR: TDataArray);
  var
    l1, l2: Integer;
  begin
    l1 := Length (BufferL);
    l2 := Length (BufferR);

    if (l1 > l2) then
      begin
        SetLength (BufferL, l2);
        l1 := l2;
      end;

    if (l2 > l1) then
      begin
        SetLength (BufferR, l1);
        l2 := l1;
      end;
  end;

  // ----------------

  procedure MakeWordBuffer (Buffer: TDataArray; var WordBuffer: TWordDataArray);
  var
    a, b, l: Integer;
  begin
    SetLength (WordBuffer, 0);

    // ****

    l := Length (Buffer);
    a := 0;
    repeat
      b := Length (WordBuffer);
      SetLength (WordBuffer, b + 1);

      WordBuffer[b] := MakeWord (Buffer[a + 1], Buffer[a]);

      inc (a, 2);
      if (a > l) then
        break;
    until FALSE;
  end;

  // ----------------

  function SampleToScreen (Buffer: TWordDataArray; SampleIndex: Integer):Integer;
  begin
    Result := Round (Buffer[SampleIndex] * LH / High (Word));
  end;

var
  BufferL, BufferR: TDataArray;

  WordBufferL,
  WordBufferR: TWordDataArray;

  b, a, N: Integer;

  bmpL,
  bmpR: TBitmap;
begin

  // Lokale temp. Bitmaps erstellen
  CreateLocalBitmaps (bmpL, bmpR);

  // ****

  // Puffer nach L & R trennen
  FillBuffer (Buffer, 0, Size, BufferL);
  FillBuffer (Buffer, 1, Size, BufferR);

  // ****

  // Pufferlängen ggf. abgleichen
  CheckBufferLengths (BufferL, BufferR);

  // ****

  // Puffer-Bytes nach Word konvertieren
  MakeWordBuffer (BufferL, WordBufferL);
  MakeWordBuffer (BufferR, WordBufferR);

  // ****

  // In lokale Bitmaps zeichnen ...
  bmpL.Canvas.LineTo (0, SampleToScreen (WordBufferL, 0));
  bmpR.Canvas.LineTo (0, SampleToScreen (WordBufferR, 0));

  N := Size div 4;
  b := LW;
  if N < b then
    b := N;

  for a := 0 to b - 1 do
    begin
      bmpL.Canvas.LineTo (round (a * LW / b), SampleToScreen (WordBufferL, round (a * N / b)));
      bmpR.Canvas.LineTo (round (a * LW / b), SampleToScreen (WordBufferR, round (a * N / b)));
    end;

  // ... und an "öffentliche" Bitmaps übergeben
  OscLeft.Assign (bmpL);
  OscRight.Assign (bmpR);

  // Daten freigeben
  FreeLocalBitmaps (bmpL, bmpR);
end;