Synthé en Delphi

Coucou,

Troisième et dernier opus de cette série d'articles consacrés à la génération de son bas niveau. Cette fois-ci on remonte un peu dans le temps puisqu'il s'agit de créer une sinusoïde infinie avec Delphi. Dans mon cas, c'était avec Turbo Delphi Explorer Edition, mais le code doit être compatible avec les versions plus anciennes telles que Delphi 6 ou Delphi 7. Bon, en réalité, ce n'est pas le code minimaliste absolu puisqu'il fait référence à un bouton (TButton) et un slider (TScrollBar). Voilà. Mais pour le reste, pas de bibliothèque spéciale. Pas de DLL. Pas de composants tiers. Rien. Que du pur son de base bien bourrin.

unit fmain;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
Dialogs, mmsystem, StdCtrls, Math, ExtCtrls;

type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
ScrollBar1: TScrollBar;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
public
end;

var
Form1: TForm1;
Device: HWaveOut;
Format: TWaveFormatEx;
BufferCount: integer;
BufferSize: integer;
Buffer: array of TWaveHdr;
time: longword;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled := True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i: integer;
begin
//reset device
waveOutReset(Device);

for i:=0 To BufferCount-1 Do Begin
//libérer espace réservé
FreeMem(Buffer[i].lpData);

//libérer buffer
waveOutUnPrepareHeader(Device, @Buffer[I], SizeOf(Buffer[I]));
end;

//fermer device
waveOutClose(Device);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
Format.wFormatTag := WAVE_FORMAT_PCM;
Format.nChannels := 1;
Format.nSamplesPerSec := 44100;
Format.nAvgBytesPerSec := 44100;
Format.nBlockAlign := 1;
Format.wBitsPerSample := 8;
Format.cbSize := 0;

waveOutOpen(@Device, WAVE_MAPPER, @Format, 0, 0, 0);

BufferCount := 16;
BufferSize := 1024;
time := 0;

SetLength(Buffer, BufferCount);

for i := 0 to BufferCount - 1 do
begin
//réserver zone mémoire pour buffer
GetMem(Buffer[i].lpData, BufferSize);
//indiquer taille du buffer
Buffer[i].dwBufferLength := BufferSize;
//signaler buffer à mmsystem
waveOutPrepareHeader(Device, @Buffer[I], SizeOf(Buffer[I]));
//marquer buffer comme disponible
Buffer[I].dwFlags := Buffer[I].dwFlags or WHDR_DONE;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
buf, j: integer;
t: double;
begin
Timer1.Enabled := False;

for buf := 0 to BufferCount - 1 do
begin
//vérifier si buffer dispo
if Buffer[buf].dwFlags and WHDR_DONE <> 0 then
begin
//remplir les données
for j := 0 to BufferSize - 1 do
begin
inc(time);
t := (time * trunc(ScrollBar1.Position) / 44100);
Buffer[buf].lpData[j] := char(trunc(127 + 127 * sin(2 * pi * t)));
end;

//envoyer buffer
waveOutWrite(Device, @Buffer[buf], SizeOf(Buffer[buf]));
end;
end;

Timer1.Enabled := True;
end;

end.

A+

GhisMart