A mesterséges hangzást megvalósító program Delphi kódja

F.28.

unit UConvol;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls, ComCtrls, Buttons, ToolWin, Menus ;

type

complex=record            // Komplex szám

re:double;    // Valós rész

im:double;    // Képzetes rész

end;

pcomplex=^complex;        // Mutató komplex értékre

pdouble=^double;          // Mutató double típusú értékre

fvtype=record             // Függvény

n:longint;     // A függvény elemek száma

n0:longint;    // Az első elem valódi indexe

fv:pdouble;    // Mutató a függvény elemekre

ndft:longint;  // A DFT alappontok száma, ill. 0

dft:pcomplex;  // Mutató a DFT értékekre

end;

pfvtype=^fvtype;          // Mutató a függvényre

arrayofdouble=array [0..524287] of double;  // Operandusok tömbje

arrayofres=array    [0..1048575] of double; // Eredmény tömbje

parrayofdouble=^arrayofdouble; // Mutató az operandus tömbre

parrayofres=^arrayofres;       // Mutató az eredmény tömbre

TForm1 = class(TForm)

ScrollBar1: TScrollBar;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

MainMenu1: TMainMenu;

File1: TMenuItem;

Tools1: TMenuItem;

OpenImpulseResponse1: TMenuItem;

OpenSample1: TMenuItem;

SaveResult1: TMenuItem;

Exit1: TMenuItem;

N1: TMenuItem;

N2: TMenuItem;

Convolution1: TMenuItem;

N3: TMenuItem;

FastFourierTransformatin1: TMenuItem;

normal1: TMenuItem;

Inverse1: TMenuItem;

NDFT1: TMenuItem;

n10: TMenuItem;

n14: TMenuItem;

n18: TMenuItem;

Options1: TMenuItem;

n12: TMenuItem;

n16: TMenuItem;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

BitBtn3: TBitBtn;

PaintBox1: TPaintBox;

procedure DrawWaveSam(var arrayin:arrayofdouble);

procedure DrawWaveRes(var arrayin:arrayofres);

procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;

var ScrollPos: Integer);

procedure OpenImpulseResponse1Click(Sender: TObject);

procedure OpenSample1Click(Sender: TObject);

procedure Exit1Click(Sender: TObject);

procedure SaveResult1Click(Sender: TObject);

procedure Convolution1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure normal1Click(Sender: TObject);

procedure Inverse1Click(Sender: TObject);

procedure n10Click(Sender: TObject);

procedure n12Click(Sender: TObject);

procedure n14Click(Sender: TObject);

procedure n16Click(Sender: TObject);

procedure n18Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

fv1,fv2,fv3:fvtype; // A konvolúcióban résztvevő függvények

sam1:arrayofdouble; // Első operandus tömbje

sam2:arrayofdouble; // Második operandus tömbje

res:arrayofres;     // Eredmény tömbje

button:byte;        // Lenyomott gomb sorszáma

lognfft:longint;    // FFT alappontjának logaritmusa

p1:parrayofdouble;  // Mutató az első operandus tömbjére

p2:parrayofdouble;  // Mutató a második operandus tömbjére

pres:parrayofres;   // Mutató az eredmény tömbjére

implementation

{$R *.DFM}

// FFT előkészítése

function ReFftPrepare(log_n:longint):integer;

stdcall; external ‘prjconvoldll.dll’ name ‘refft_prepare’;

// A lefoglalt munkaterületek felszabadítása

procedure ReFftClose;

stdcall; external ‘prjconvoldll.dll’ name ‘refft_close’;

// Valós vektor DFT-jének számolása FFT-vel

procedure ReFft(poi:pdouble);

stdcall; external ‘prjconvoldll.dll’ name ‘refft’;

// Inverz transzformáció

procedure ReiFft(poi:pdouble);

stdcall; external ‘prjconvoldll.dll’ name ‘reifft’;

// Az fvtype inicializálása

procedure InitFvtype(fvt:pfvtype);

stdcall; external ‘prjconvoldll.dll’ name ‘init_fvtype’;

// Az fvtype kitöltése

function FillFvtype(n:longint;n0:longint;data:pdouble;fvt:pfvtype):integer;

stdcall; external ‘prjconvoldll.dll’ name ‘fill_fvtype’;

// Konvolúció

function Convolution(fvta:pfvtype;fvtb:pfvtype;fvtres:pfvtype):integer;

stdcall; external ‘prjconvoldll.dll’ name ‘convol_by_fft’;

// Operandus függvények beolvasása állományból

procedure ReadFromFile;

var f:file of byte;

x:string;

i,n1,n2:longint;

m:byte;

begin

with form1.opendialog1 do

begin

if execute then

x:=form1.OpenDialog1.filename;

end;//with

if x<>” then

begin

screen.cursor:=crHourglass;

try

AssignFile(f,x);

Reset(f);

if button=1 then

begin

for i:=low(p1^) to high(p1^) do

p1^[i]:=0;

if filesize(f)-1<high(p1^) then

n1:=filesize(f)-1

else

n1:=high(p1^);

for i:=low(p1^) to n1 do

begin

seek(f,i);

read(f,m);

p1^[i]:=-(m-128);

end;//for

end

else

if button=2 then

begin

for i:=low(p2^) to high(p2^) do

p2^[i]:=0;

if filesize(f)-1<high(p2^) then

n2:=filesize(f)-1

else

n2:=high(p2^);

for i:=low(p2^) to n2 do

begin

seek(f,i);

read(f,m);

p2^[i]:=-(m-128);

end;//for

end;//if

CloseFile(f);

finally

screen.cursor:=crDefault;

end;//try

end;//if

end;

// Eredmény állományba írása

procedure WriteToFile;

var f:file of byte;

i:longint;

x:string;

m:byte;

begin

with form1.savedialog1 do

begin

if execute then

x:=form1.SaveDialog1.filename;

end;//with

if x<>” then

begin

screen.cursor:=crHourglass;

try

assignfile(f,x);

rewrite(f);

for i:=low(pres^) to high(pres^) do

begin

m:=round(-(pres^[i]/1000)+128);

seek(f,i);

write(f,m);

end;//for

closefile(f);

finally

screen.cursor:=crDefault;

end;

end;//if

end;

// Operandusok grafikus megjelenítése

procedure TForm1.DrawWaveSam(var arrayin:arrayofdouble);

var w,y,j:longint;

begin

repaint;

with canvas do

begin

pen.Color:=clblue;

MoveTo(0,round(paintbox1.height/2));

LineTo(Width,round(paintbox1.height/2));

pen.Color:=clred;

moveto(0,round(paintbox1.height/2)-round(arrayin[0]));

w:=scrollbar1.position+Width;

for j:=ScrollBar1.position to w do

begin

y:=j-scrollbar1.position;

if j>high(arrayin) then

begin

end//if

else

lineto(y,round(paintbox1.height/2)-(round(arrayin[j])));

end; //for

end; //with

end;

// Eredmény grafikus megjelenítése

procedure TForm1.DrawWaveRes(var arrayin:arrayofres);

var w,y,j:longint;

begin

repaint;

with canvas do

begin

pen.Color:=clblue;

MoveTo(0,round(paintbox1.height/2));

LineTo(Width,round(paintbox1.height/2));

pen.Color:=clred;

moveto(0,round(paintbox1.height/2)-round(arrayin[0]));

w:=scrollbar1.position+Width;

for j:=ScrollBar1.position to w do

begin

y:=j-scrollbar1.position;

if j>high(arrayin) then

begin

end

else

lineto(y,round(paintbox1.height/2)-            (round(arrayin[j]/1000)));

end; //for

end; //with

end;

// Függvények görgetése

procedure TForm1.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;

var ScrollPos: Integer);

begin

case button of

1:DrawWaveSam(p1^);

2:DrawWaveSam(p2^);

3:DrawWaveRes(pres^);

end

end;

// Impulzusválasz függvény megnyitása, grafikus megjelenítése

procedure TForm1.OpenImpulseResponse1Click(Sender: TObject);

begin

button:=1;

ReadFromFile;

DrawWaveSam(p1^);

end;

// Tetszőleges gerjesztés függvényének megnyitása, grafikus megjelenítése

procedure TForm1.OpenSample1Click(Sender: TObject);

begin

button:=2;

ReadFromfile;

DrawWaveSam(p2^);

end;

procedure TForm1.Exit1Click(Sender: TObject);

begin

form1.close;

end;

// Eredmény függvény mentése

procedure TForm1.SaveResult1Click(Sender: TObject);

begin

button:=3;

WriteToFile;

end;

// A teljes konvolúciót végző eljárás

procedure TForm1.Convolution1Click(Sender: TObject);

var i:longint;

begin

screen.cursor:=crHourglass;

try

// Függvények inicializálása

InitFvtype(@fv1);

InitFvtype(@fv2);

InitFvtype(@fv3);

// Az operandus függvényeknek megfelelő rekord kitöltése

if(FillFvtype(high(p1^)+1,0,@p1^,@fv1))<>0 then

begin

ShowMessage(‘Allocation error while FillFvtype!’);

exit;

end;

if (FillFvtype(high(p2^)+1,0,@p2^,@fv2))<>0 then

begin

ShowMessage(‘Allocation error while FillFvtype!’);

exit;

end;

// Két függvény konvolúciója

if (Convolution(@fv1,@fv2,@fv3))<>0 then

begin

ShowMessage(‘Allocation error while Convolution!’);

exit;

end;

// Eredmény kiolvasása

for i:=low(pres^) to high(pres^)-1 do

begin

pres^[i]:=fv3.fv^;

inc(fv3.fv);

end;

ShowMessage(‘Convolution ready!’);

finally

screen.cursor:=crDefault;

end;

button:=3;

// Eredmény grafikus megjelenítése

DrawWaveRes(pres^);

end;

// Helyfoglalás a heap-ben

procedure TForm1.FormCreate(Sender: TObject);

begin

New(p1);

p1^:=sam1;

New(p2);

p2^:=sam2;

New(pres);

pres^:=res;

normal1.checked:=false;

inverse1.checked:=true;

n10.checked:=true;

lognfft:=10;

end;

// Heap felszabadítása

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

dispose(pres);

dispose(p2);

dispose(p1);

end;

// Normál FFT

procedure TForm1.normal1Click(Sender: TObject);

begin

normal1.checked:=true;

inverse1.checked:=false;

screen.cursor:=crHourGlass;

try

case button of

1:

begin

// FFT előkészítése

if ReFftPrepare(lognfft)<> 0 then

begin

ShowMessage(‘Allocation error while FFT!’);

exit;

end;//if

// FFT elvégzése

Refft(@p1^);

// Az előkészítés során lefoglalt területek felszabadítása

ReFftClose;

DrawWaveSam(p1^);

end;//1

2:

begin

if ReFftPrepare(lognfft)<> 0 then

begin

ShowMessage(‘Allocation error while FFT!’);

exit;

end;//if

Refft(@p2^);

ReFftClose;

DrawWaveSam(p2^);

end;//2

3:

begin

if ReFftPrepare(lognfft+1)<> 0 then

begin

ShowMessage(‘Allocation error while FFT!’);

exit;

end;//if

Refft(@pres^);

ReFftClose;

DrawWaveRes(pres^);

end;//3

end;//case

finally

screen.cursor:=crDefault;

end;

end;

// Inverz FFT

procedure TForm1.Inverse1Click(Sender: TObject);

begin

normal1.checked:=false;

inverse1.checked:=true;

screen.cursor:=crHourGlass;

try

case button of

1:

begin

if ReFftPrepare(lognfft)<> 0 then

begin

ShowMessage(‘Allocation error while inverse FFT!’);

exit;

end;//if

Reifft(@p1^);

ReFftClose;

DrawWaveSam(p1^);

end;//1

2:

begin

if ReFftPrepare(lognfft)<> 0 then

begin

ShowMessage(‘Allocation error while inverse FFT!’);

exit;

end;//if

Reifft(@p2^);

ReFftClose;

DrawWaveSam(p2^);

end;//2

3:

begin

if ReFftPrepare(lognfft+1)<> 0 then

begin

ShowMessage(‘Allocation error while inverse FFT!’);

exit;

end;//if

Reifft(@pres^);

ReFftClose;

DrawWaveRes(pres^);

end;//3

end;//case

finally

screen.cursor:=crDefault;

end;

end;

procedure TForm1.n10Click(Sender: TObject);

begin

lognfft:=10;

n10.checked:=true;

n12.Checked:=false;

n14.checked:=false;

n16.checked:=false;

n18.checked:=false;

end;

procedure TForm1.n12Click(Sender: TObject);

begin

lognfft:=12;

n10.checked:=false;

n12.Checked:=true;

n14.checked:=false;

n16.checked:=false;

n18.checked:=false;

end;

procedure TForm1.n14Click(Sender: TObject);

begin

lognfft:=14;

n10.checked:=false;

n12.Checked:=false;

n14.checked:=true;

n16.checked:=false;

n18.checked:=false;

end;

procedure TForm1.n16Click(Sender: TObject);

begin

lognfft:=16;

n10.checked:=false;

n12.Checked:=false;

n14.checked:=false;

n16.checked:=true;

n18.checked:=false;

end;

procedure TForm1.n18Click(Sender: TObject);

begin

lognfft:=18;

n10.checked:=false;

n12.Checked:=false;

n14.checked:=false;

n16.checked:=false;

n18.checked:=true;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

button:=1;

DrawWaveSam(p1^);

end;

procedure TForm1.BitBtn2Click(Sender: TObject);

begin

button:=2;

DrawWaveSam(p2^);

end;

procedure TForm1.BitBtn3Click(Sender: TObject);

begin

button:=3;

DrawWaveRes(pres^);

end;

end.

Vélemény, hozzászólás?

Adatok megadása vagy bejelentkezés valamelyik ikonnal:

WordPress.com Logo

Hozzászólhat a WordPress.com felhasználói fiók használatával. Kilépés / Módosítás )

Twitter kép

Hozzászólhat a Twitter felhasználói fiók használatával. Kilépés / Módosítás )

Facebook kép

Hozzászólhat a Facebook felhasználói fiók használatával. Kilépés / Módosítás )

Google+ kép

Hozzászólhat a Google+ felhasználói fiók használatával. Kilépés / Módosítás )

Kapcsolódás: %s