MultiMedia Player

Tampilan Projectnya.

Lantaran Saya Tak Sanggup Ngetik Lagi, Anda Lihat Aja Sendiri Source Codenya, Ne Saya Kasih Source Code Secara Cuma Cuma Download

read more »»  

Animasi Form Vertikal Dan Horizontal

Component Yang Di Gunakan :
- 3 Button

Tanpa Basa Basi Anda Bisa Download Source Code nya Di Sini

read more »»  

Splash Screen

 

Component Yang di Pakai :

- Timer

- Image

- Progressbar

Tanpa Basa Basi Download Aja Di Sini

read more »»  

Game Snack Dengan Delphi

Project aplikasi Snack dengan menggunakan delphi 7

{ description: a simple snake game (note: using static array, in later versions
               of delphi dynamic array can be used for snake.
  language:    delphi 1 (code chould work with any version of delphi)
  author:      Joakim Skoglund
  email:       mmiskim@hotmail.com

  freeware with open source code - please do whatever you want with this code

  disclaimer: use on your own risk!
    i can not be held responsible for any damage in software and/or
    hardware or any other kind of problem caused by the use of this source code
    and/or exe file. }
unit Unit1;

interface

uses
  SysUtils, WinTypes, graphics, Controls, Forms, Dialogs, Classes, ExtCtrls;

type
  TForm1 = class(TForm)
    snakeTimer: TTimer;
    procedure snakeTimerTimer(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1 : TForm1;
  score : integer;

Procedure ResetGame;        {// Resets the snake and score}
Function HitWall : Boolean; {// returns true if snake hits the wall}
Function HitFood : boolean; {// Returns true if snake hits food}
function HitSelf : boolean; {// Returns true if the snake hits itself}
procedure DrawSnake;        {// Draws the snake, increase points if
                             // snake hit food,
                             // ends game if snake hit a wall or itself.}
Procedure PlaceFood;
procedure DrawPlayfield;    {// Draws the playfield
                             // (the area which the snake navigates on)}
implementation

{$R *.DFM}

const
  snakewidth      = 10;                       {// specify how wide the snake is}
  snakegrow       : integer = 2;              {// specify how fast snake grows}
  snakecolor      : tcolor = clBlack;
  foodcolor       : tcolor = clRed;
  pfcolor         : tcolor = clWhite;         {// playfield color           }
  pfdimention     : tpoint = (x:200; y:200);  {// playfield width and hight }
  pfposition      : tpoint = (x:5; y:5);      {// playfield position on form}
  dup             = 0;
  ddown           = 1;
  dleft           = 2;
  dright          = 3;
  dnone           = 4;
  speed           : integer = 100;           { // snake speed higher value}
                                             { // equals slower snake     }

var
  snake           : array[0..9099] of tpoint;{ // array holding snake}
                                             { // coordinates    }
  snakelength     : integer;                 { // length of snake}
  food            : tpoint;                  { // food position  }
  direction       : dup..dnone;
  olddirection    : dup..dnone;

{// HitWall: returns true if snake hits the wall}
Function HitWall : Boolean;
var
  i : integer;

Begin
  For i := 0 to snakelength - 1 do
  begin
    if (snake[i].x < pfposition.X) or
      (snake[i].x + snakewidth > pfposition.X + pfdimention.X) or
      (snake[i].y < pfposition.y) or
      (snake[i].y + snakewidth > pfposition.y + pfdimention.y) then
    begin
      hitwall := true;
      exit;
    end;
  end;
  hitwall := false;
End;

{// HitFood: Returns true if snake hits food}
Function HitFood : boolean;
var
  i : integer;

Begin
  for i := 0 to snakelength - 1 do
  begin
    if (snake[i].x = food.x) and (snake[i].y = food.y) then
    begin
      hitfood := true;
      exit;
    end;
  end;
  hitfood := false;
End;

{ PlaceFood: Draws the food on the playfield on a random location}
Procedure PlaceFood;
Begin
  food.x := random(pfdimention.x - snakewidth - pfposition.x) + pfposition.x;
  food.y := random(pfdimention.y - snakewidth - pfposition.y) + pfposition.y;
  while (pfdimention.x - (food.x - pfposition.x)) mod snakewidth <> 0 do
    inc(food.x);
  while (pfdimention.y - (food.y - pfposition.y)) mod snakewidth <> 0 do
    inc(food.y);
  if HitFood then
    PlaceFood;
  Form1.Canvas.Brush.Color := foodcolor;
  Form1.Canvas.Pen.Color := snakecolor;
  Form1.Canvas.Ellipse(food.x + 1, food.y + 1,
    food.x + snakewidth - 2, food.y + snakewidth - 2);
End;

{// HitSelf: Returns true if the snake hits itself}
function HitSelf : boolean;
var
  i : integer;

begin
  for i := 1 to snakelength - 1 do
    if (snake[0].x = snake[i].x) and (snake[0].y = snake[i].y) then
    begin
      hitself := true;
      exit;
    end;
  hitself := false;
end;

{// DrawSnake: Draws the snake, increase points if snake hit food,
 // ends game if snake hit a wall or itself.}
procedure DrawSnake;
var
  i : integer;

Begin
  if direction = dnone then
    exit;
  Form1.Canvas.Brush.Color := pfcolor;
  Form1.Canvas.Pen.Color := pfcolor;
  Form1.Canvas.Rectangle(snake[snakelength - 1].X, snake[snakelength - 1].Y,
    snake[snakelength - 1].X + snakewidth, snake[snakelength - 1].Y + snakewidth);
  For i := snakelength - 1 downto 1 do
    snake[i] := snake[i - 1];
  snake[0]:= snake[1];
  case direction of
    dup    : dec(snake[0].y, snakewidth);
    ddown  : inc(snake[0].y, snakewidth);
    dleft  : dec(snake[0].x, snakewidth);
    dright : inc(snake[0].x, snakewidth);
  end;
  if HitFood then
  begin
    inc(score, 5);
    inc(snakelength, snakegrow);
    for i := 1 to snakegrow do
      snake[snakelength - i] := snake[(snakelength - snakegrow) - 1];
    PlaceFood;
  end;
  if HitWall or HitSelf then
  begin
    form1.snaketimer.enabled := false;
    showmessage(#10 + '               simple snake game version 1.0 beta              ' + #10#10 +
      ' Stear the snake with the arrow keys or w,a,d,s,' + #10 +
      ' pause game with space.' + #10 +
      ' Collect points eating food.' + #10 +
      ' Avoid hitting the walls and yourself.' + #10#10 +
      ' OK to start, end by Alt-F4x2.' + #10#10 +
      ' Score: ' + inttostr(score));
    ResetGame;
  end;
  Form1.Canvas.Brush.Color := snakecolor;
  Form1.Canvas.Pen.Color := snakecolor;
  case direction of
    dup    : Form1.Canvas.Rectangle(snake[0].X+1, snake[0].Y+1,
               snake[0].X + snakewidth-1, snake[0].Y + snakewidth+1);
    ddown  : Form1.Canvas.Rectangle(snake[0].X+1, snake[0].Y-1,
               snake[0].X + snakewidth-1, snake[0].Y + snakewidth-1);
    dleft  : Form1.Canvas.Rectangle(snake[0].X+1, snake[0].Y+1,
               snake[0].X + snakewidth+1, snake[0].Y + snakewidth-1);
    dright : Form1.Canvas.Rectangle(snake[0].X-1, snake[0].Y+1,
               snake[0].X + snakewidth-1, snake[0].Y + snakewidth-1);
  end;
End;

{// DrawPlayField: Draws the playfield (the area where the snake navigates on)}
procedure DrawPlayfield;
begin
  Form1.Canvas.Brush.Color := pfcolor;
  Form1.Canvas.Pen.Color := pfcolor;
  Form1.Canvas.Rectangle(pfposition.x, pfposition.y,
    pfdimention.x + pfposition.x, pfdimention.y + pfposition.y);
end;

{// ResetGame: Resets the game; resets the snake and score}
Procedure ResetGame;
var
 i : integer;

Begin
  form1.snaketimer.enabled := false;
  randomize;
  snakelength := 10;
  snake[0].x := pfposition.x + (pfdimention.x div 2) - (snakewidth div 2);
  snake[0].y := pfposition.y + (pfdimention.y div 2) - (snakewidth div 2);
  while ((pfdimention.x-(snake[0].x-pfposition.x)) mod snakewidth <> 0) do
    inc(snake[0].x);
  while ((pfdimention.y-(snake[0].y-pfposition.y)) mod snakewidth <> 0) do
    inc(snake[0].y);
  for i := 1 to snakelength - 1 do
    snake[i] := snake[0];
  score := 0;
  food.x := 0;
  food.y := 0;
  direction := dright;
  olddirection := direction;
  DrawPlayfield;
  DrawSnake;
  PlaceFood;
  form1.snaketimer.Interval := speed;
  form1.snaketimer.enabled := true;
End;

procedure TForm1.snakeTimerTimer(Sender: TObject);
begin
  olddirection := direction;
  DrawSnake;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  form1.ClientWidth := pfdimention.x + (pfposition.x * 2);
  form1.ClientHeight := pfdimention.y + (pfposition.y * 2);
  form1.Color := clBlack;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case chr(key) of
    chr(38),'w', 'W': if olddirection <> ddown then direction := dup;
    chr(40),'s', 'S': if olddirection <> dup then direction := ddown;
    chr(37),'a', 'A': if olddirection <> dright then direction := dleft;
    chr(39),'d', 'D': if olddirection <> dleft then direction := dright;
    #32: direction := dnone;
  end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  ResetGame;
end;

end.

Download  Snack

read more »»  

Sejarah dan Perkembangan Bahasa Pemrograman Delphi

Seharusnya ini menjadi postingan pertama dalam kategori Delphi. Tapi tak apalah. Bagi anda yang sedang dan ingin belajar atau sekedar ingin mengetahui tentang sejarah delphi, semoga tulisan ini bisa memberikan informasi yang berguna bagi anda.

Apa itu Delphi?

Borland Delphi adalah bahasa tingkat tinggi dan terkompilasi yang mendukung bahasa terstruktur serta Perancangan Berorientasi Object (OOD). Delphi menggunakan bahasa Pascal, sebuah bahasa terstruktur generasi ketiga. Delphi menawarkan gaya pemrograman yang bersih dan konsisten dan yang terpenting menghasilkan aplikasi yang lebih dapat diandalkan.

Pascal dan Sejarahnya

Asal usul Pascal bermula dari rancangan Algol, bahasa tingkat tinggi pertama yang mudah dibaca, terstruktur dan mendefinisikan sintax secara sistematis. Pada akhir tahun 1960-an (196x), beberapa usulan evolusi penerus algol dikembangkan. Salah satu yang paling sukses adalah Pascal, ditemukan oleh Prof Niklaus Wirth. Wirth mempublikasikan temuan asli Pascal pada tahun 1971. Mulai diimplementasikan di tahun 1973 dengan beberapa modifikasi.   Banyak fitur pascal yang berasal dari bahasa sebelumnya. Pernyataan Case dan parameter value-result berasal dari Algol, dan catatan struktur yang mirip dengan Cobol dan PL 1. Pascal menambahkan kemampuan untuk mendefinsikan tipe data baru secara lebih sederhana dari yang pernah ada. Pascal juga mendukung struktur data dinamis, contohnya : struktur data yang dapat tumbuh dan menyusut saat program berjalan. Bahasa ini dirancang untuk menjadi alat pembelajaran bagi siswa pada kelas pemrograman.

Pada tahun 1975, Wirth dan Jensen memproduksi buku referensi Pascal terakhir “Pascal User Manual and Report”. Wirth berhenti bekerja pada Pascal pada tahun 1977 untuk menciptakan sebuah bahasa baru, Modula – penerus Pascal.

Borland Pascal

Dengan dirilisnya Turbo Pascal 1.0 pada November 1983, Borland mulai perjalanannya dengan lingkungan pengembangan dan perangkatnya. Untuk menciptakan Turbo Pascal 1.0 Borland melisensikan kompilator inti pascal yang cepat dan murah, yang ditulis oleh Anders Hejlsberg. Turbo Pascal memperkenalkan  suatu Lingkungan pengembangan terintegrasi / Integrated Development Environment (IDE) dimana anda dapat mengedit code, menjalankan compiler, melihat kesalahan dan melompat kembali ke baris yang mengalami kesalahan. Kompiler turbo pascal telah menjadi salah satu compiler terlaris sepanjang waktu, dan membuat bahasa ini sangat popular pada platform PC

Pada tahun 1995 Pascal kembali dengan memperkenalkan lingkungan aplikasi bernama Delphi – mengubah pascal menjadi sebuah bahasa pemrograman visual. Keputusan yang strategis dengan membuat perangkat database dan konektivitas sentral dari produk pascal.

Permulaan Delphi

Setelah merilis Turbo Pascal 1, Anders bergabung dengan perusahaan sebagai seorang karyawan dan arsitek untuk semua versi dari kompiler Turbo Pascal dan tiga versi pertama dari Delphi. Sebagai kepala arsitek di Borland, Hejlsberg diam-diam merubah Turbo Pascal menjadi bahasa pengembangan aplikasi berorientasi obyek, lengkap dengan lingkungan yang benar-benar visual dan fitur akses database yang luar biasa

Mengapa diberi nama “Delphi”

Seperti yang dijelaskan dalam Museum artikel Borland, proyek dengan codename Delphi muncul pada pertengahan 1993. Mengapa Delphi? Sangat sederhana: “Jika Anda ingin berbicara dengan Oracle, pergilah ke Delphi”. Ketika tiba saatnya untuk memilih nama produknya, setelah sebuah artikel di ‘Windows Tech Journal’ tentang sebuah produk yang akan mengubah hidup programmer, nama terakhir yang diusulkan adalah AppBuilder. Sejak Novell merilis Visual AppBuilder, orang-orang Borland perlu mengambil nama lain, tetapi menjadi semacam komedi: semakin keras orang-orang berusaha untuk mengabaikan “Delphi” sebagai nama produk, semakin banyak nama tersebut mendapat dukungan. Setelah disebut-sebut sebagai “pembunuh VB” Delphi tetap menjadi produk landasan untuk Borland.

read more »»  

Input Nilai Rapor

Project aplikasi Input Nilai Rapor Menggunakan Delphi 7

unit Unit1;

interface

uses

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

  Dialogs, ExtCtrls, StdCtrls, XPMan;

type

  TForm1 = class(TForm)

    Label1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    Label4: TLabel;

    Label5: TLabel;

    Label6: TLabel;

    Label7: TLabel;

    Label8: TLabel;

    Label9: TLabel;

    Label10: TLabel;

    Label12: TLabel;

    Label18: TLabel;

    Shape2: TShape;

    edit1: TEdit;

    edit2: TEdit;

    edit3: TEdit;

    edit4: TEdit;

    edit5: TEdit;

    edit6: TEdit;

    edit7: TEdit;

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    ComboBox1: TComboBox;

    Timer1: TTimer;

    Label13: TLabel;

    Panel1: TPanel;

    Label11: TLabel;

    XPManifest1: TXPManifest;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Timer1Timer(Sender: TObject);

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

tugas, quiz, hadir, uts, uas : real;

hasil : real;

nilai : string;

begin

tugas:=(((strtofloat(edit1.Text)+strtofloat(edit2.Text)+strtofloat(edit3.Text))/3)*0.1);

quiz:=(((strtofloat(edit4.Text)+strtofloat(edit5.Text))/2)*0.1);

hadir:=(((strtofloat(ComboBox1.Text))/14)*10);

uts:=((strtofloat(edit6.Text))*0.3);

uas:=((strtofloat(edit7.Text))*0.4);

hasil:=(tugas+quiz+hadir+uts+uas);

str(hasil:0:2,nilai);

label12.caption:=(nilai);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

edit1.Clear;

edit2.Clear;

edit3.Clear;

edit4.Clear;

edit5.Clear;

ComboBox1.Clear;

edit6.Clear;

edit7.Clear;

Label12.Caption:='';

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

Close;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

label11.Left :=  label11.Left - 5;

if  label11.Left <= -100 then

label11.Left := 550;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

if MessageDlg('Apakah anda yakin untuk'+#13+'keluar dari program ini ?',

      mtConfirmation,[mbYes,mbNo],0)=mrNo then

    CanClose:=False;

end;

end.

Download Input Nilai Rapor

read more »»  

Jaringan Syaraf Tiruan

Project Jaringan Syaraf Tiruan dengan menggunakan delphi 7

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, TeEngine, Series, Menus, ExtCtrls, TeeProcs, Chart, ComCtrls,
  StdCtrls, ALBasicAudioOut, ALAudioOut, LPComponent, ALCommonPlayer,
  ALWavePlayer, math, ImgList, acAlphaImageList, sSkinProvider,
  sSkinManager, Buttons, sButton;

type
Twindow=(blackman,hanning,hamming,bartlett);
T1dimensi=array of double;
Tdatabobot=array of T1dimensi;
T3dimensi=array of Tdatabobot;
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    ALWavePlayer1: TALWavePlayer;
    ALAudioOut1: TALAudioOut;
    RichEdit1: TRichEdit;
    RichEdit2: TRichEdit;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    StatusBar1: TStatusBar;
    Chart1: TChart;
    File1: TMenuItem;
    BukaFile1: TMenuItem;
    AutoProcess1: TMenuItem;
    Series1: TLineSeries;
    sSkinManager1: TsSkinManager;
    Exit1: TMenuItem;
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Label8: TLabel;
    Timer1: TTimer;
    BitBtn4: TBitBtn;
    componen1: TMenuItem;
    Hapus1: TMenuItem;
    SinyalSuara1: TMenuItem;
    HeaderFile1: TMenuItem;
    ProcessingSpeech1: TMenuItem;
    FileSpeech1: TMenuItem;
    otalSuara1: TMenuItem;
    JumlahHiddenLayer1: TMenuItem;
    HapusSemua1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    BitBtn5: TBitBtn;
    Help2: TMenuItem;
    Aboutme1: TMenuItem;
    BitBtn6: TBitBtn;
    SaveDialog1: TSaveDialog;
    Exit2: TMenuItem;
    rainingnProcess1: TMenuItem;
    ALLDELETE1: TMenuItem;
    Button1: TsButton;
    Button2: TsButton;
    Button3: TsButton;
    Button4: TsButton;
    procedure BukaFile1Click(Sender: TObject);
    procedure AutoProcess1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox2Change(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure SinyalSuara1Click(Sender: TObject);
    procedure HeaderFile1Click(Sender: TObject);
    procedure ProcessingSpeech1Click(Sender: TObject);
    procedure FileSpeech1Click(Sender: TObject);
    procedure otalSuara1Click(Sender: TObject);
    procedure JumlahHiddenLayer1Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure Aboutme1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure Exit2Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure HapusSemua1Click(Sender: TObject);
    procedure rainingnProcess1Click(Sender: TObject);
    procedure ALLDELETE1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
MATHPHI=3.1415926535897932384626433832795;
MAXDATA=15000;//15000 sample
UKURANFRAME=2048;
FREKUENSI=12000;//12 KHz sample rate
var
  Form1: TForm1;
  maksuji,jumlahuji :word;
PosisiFile :Byte;
JData :integer;
Iterasi :integer;
Alpha:double;
Miu:double;
ErorMax:double;
StrIdentitas:array of string;
HUnit:array of integer;
JumHidden:Byte;
HTemp:array of integer;
RealData:array of double;
PanData:Integer;
Masuk:Tdatabobot;
Cep:Tdatabobot;
IUnit:Integer;
wbobot:Tdatabobot;
vbobot:array of Tdatabobot;

implementation
uses Unit2, Unit3, Unit4, Fourier;

{$R *.dfm}

procedure BukaFileData(const namafile:string);
var
F:File of Smallint;
dumdata:Smallint;
loop:word;
begin
AssignFile(F,namafile);
Reset(F);
Seek(F,0);
SetLength(RealData,MAXDATA);
for loop:=0 to MAXDATA-1 do
begin
Read(F,dumdata);
RealData[loop]:=dumdata;
end;
CloseFile(F);
end;
//--------------------------------
procedure LaporkanKeMemo(const namafile:string);
begin
with Form1, Memo1.Lines do
begin
Clear;
Add('Buka File : '+namafile);
Add('File speech dengan header File :');
Add('- RIFF chunck');
Add('- Mode Mono');
Add('- 12 KHZ sample rate');
Add('- 16 bit signed data');
Add('- 15000 sample data = 1.25 s');
end;
end;
//-------------------------------
procedure GraphikkanKeWave;
var
loop:word;
begin
with Form1, Series1 do
begin
Clear;
for loop:=0 to MAXDATA-1 do
Add(RealData[loop]);
end;
end;
//--------------------------------------
Procedure TampilkanProsess(proses:Byte);
var
loop1:Byte;
loop2:Byte;
begin
with Form1, RichEdit2.Lines do
begin
case proses of
0:begin
Clear;
Add('PreProcessing :');
end;
1:Add('Baca Data Sinyal Speech ...');
2:Add('Framing Data ...');
3:Add('PreEmphasis ...');
4:Add('Windowing ...');
5:Add('FFT ...');
6:Add('LPC ...');
7:Add('Cepstral ...');
100:
begin
Add('SUKSESS ...');
Add('------------------------------');
Add('Jumlah Koefisien Cepstral :'+FloatToStr(high(Cep)+1));
Add('Jumlah Frame :'+FloatToStr(high(Cep[1])+1));
for loop1:=0 to high(Cep) do
begin
Add('==============================');
for loop2:=0 to high(Cep[loop1]) do
Add('Frame['+IntToStr(loop2)+']'+'Coef['+IntToStr(loop1)+']'+
#9+ FloatToStr(Cep[loop1,loop2]));
end;
end;
end;
end;
end;
//--------------------------------
//------------------------------------------
procedure PreProcessing(sinyal:array of double);
var
p:integer;
i:integer;
j:integer;
win:array of double;
aut:array of double;
realtime:Tdatabobot;
imgtime:Tdatabobot;
realfrek:Tdatabobot;
imgfrek:Tdatabobot;
jumframe:integer;
begin
TampilkanProsess(0);
TampilkanProsess(1);
jumframe:=FrameCount(UKURANFRAME,UKURANFRAME div 3,
high(sinyal)+1);
setlength(realtime,jumframe);
setlength(imgtime,jumframe);
setlength(realfrek,jumframe);
setlength(imgfrek,jumframe);
setlength(Cep,jumframe);
TampilkanProsess(2);
pre_emphasis(0.94,sinyal);
setlength(realtime,jumframe);
for i:=0 to jumframe-1 do
begin
setlength(realtime[i],UKURANFRAME);
setlength(imgtime[i],UKURANFRAME);
setlength(realfrek[i],UKURANFRAME);
setlength(imgfrek[i],UKURANFRAME);
end;
TampilkanProsess(3);
framing(UKURANFRAME,UKURANFRAME div 3,sinyal,realtime);
TampilkanProsess(4);
setlength(win,UKURANFRAME);
win_sinyal(0,hanning,win);
TampilkanProsess(5);
for i:=0 to jumframe-1 do
for j:=0 to UKURANFRAME-1 do
realtime[i,j]:=realtime[i,j]*win[j];
for i:=0 to jumframe-1 do
fft(UKURANFRAME,realtime[i],imgtime[i],realfrek[i],imgfrek[i]);
for i:=0 to jumframe-1 do
for j:=0 to UKURANFRAME-1 do
realfrek[i,j]:=sqrt(sqr(realfrek[i,j])+sqr(imgfrek[i,j]));
TampilkanProsess(6);
p:=MakeOrder(FREKUENSI);
setlength(aut,p+1);
for i:=0 to jumframe-1 do
begin
setlength(Cep[i],p+1);
LPCAnalisis(realfrek[i],UKURANFRAME,p,aut);
lpc2cepstral(p,p,aut,Cep[i]);
weightingcepstral(p,Cep[i]);
end;
TampilkanProsess(7);
TampilkanProsess(100);
end;
//---------------------------------
function InitTarget(var target:Tdatabobot):integer;
var
a:integer;
b:integer;
sisa:integer;
ounit:integer;
begin
setlength(target,jdata);
sisa:=jdata mod 3;
if sisa<>0 then
sisa:=1;
ounit:=jdata div 3 +sisa+1;
for a:=0 to jdata-1 do
begin
setlength(target[a],ounit);
for b:=1 to ounit-1 do
target[a,b]:=0.1;
target[a,1+ a div 3]:=0.3+ 0.3*(a mod 3);
end;
result:=ounit;
end;
//-----------------------------------------
function CekBobotAll(hiden_in,hiden:Tdatabobot;
out_in,output:t1dimensi;
target:Tdatabobot;jhiden:integer):boolean;
var
i:integer;
num:integer;
kenal:integer;
sum:double;
begin
result:=false;
kenal:=0;
for num:=0 to high(masuk) do
begin
//---------feedforrward proses---------//
LayerIn(masuk[num],hiden_in[0],vbobot[0]);
FungsiAktivasi(hiden_in[0],hiden[0]);
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
LayerIn(hiden[i],hiden_in[i+1],vbobot[i+1]);
FungsiAktivasi(hiden_in[i+1],hiden[i+1]);
end;
LayerIn(hiden[jhiden-1],out_in,wbobot);
FungsiAktivasi(out_in,output);
sum:=0;
for i:=1 to high(output) do
sum:=sum+abs(output[i]-target[num,i]);
sum:=sum/jdata;
if sum<ErorMax then
inc(kenal);
end;
if kenal=jdata then
result:=true;
end;
//--------------------------------------------
procedure InitTrain(var vbobotold:T3dimensi;var
wbobotold:Tdatabobot;
var hiden,hiden_in,eror_j:Tdatabobot;var
output,out_in,eror_k:T1dimensi;
ounit:integer);
var
i:integer;
j:integer;
jhiden:integer;
begin
setlength(hiden,length(hunit));
setlength(hiden_in,length(hunit));
setlength(eror_j,length(hunit));
for i:=0 to high(hunit) do
begin
setlength(hiden[i],hunit[i]);
setlength(hiden_in[i],hunit[i]);
setlength(eror_j[i],hunit[i]);
hiden[i,0]:=1;
end;
setlength(output,ounit);
setlength(out_in,ounit);
setlength(eror_k,ounit);
setlength(vbobot,length(hunit));
setlength(vbobotold,length(hunit));
setlength(vbobot[0],iunit);
setlength(vbobotold[0],iunit);
for i:=0 to iunit-1 do
begin
setlength(vbobot[0,i],hunit[0]);
setlength(vbobotold[0,i],hunit[0]);
end;
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
setlength(vbobot[i+1],hunit[i]);
setlength(vbobotold[i+1],hunit[i]);
for j:=0 to hunit[i]-1 do
begin
setlength(vbobot[i+1,j],hunit[i+1]);
setlength(vbobotold[i+1,j],hunit[i+1]);
end;
end;
jhiden:=length(hunit);
setlength(wbobot,hunit[jhiden-1]);
setlength(wbobotold,hunit[jhiden-1]);
for i:=0 to hunit[jhiden-1]-1 do
begin
setlength(wbobot[i],ounit);
setlength(wbobotold[i],ounit);
end;
InisialisasiBobot(vbobot,wbobot);
end;
//-----------------------------------------
function DoTrain:integer;
var
vbobotold:T3dimensi;
wbobotold:Tdatabobot;
output:T1dimensi;
out_in:T1dimensi;
eror_k:T1dimensi;
hiden:Tdatabobot;
hiden_in:Tdatabobot;
eror_j:Tdatabobot;
target:Tdatabobot;
loop:integer;
num:integer;
jhiden:integer;
i:integer;
j:integer;
kenal:integer;
ounit:integer;
sum:double;
sumall:double;
begin
jhiden:=length(hunit);
ounit:=InitTarget(target);
InitTrain(vbobotold,wbobotold,hiden,hiden_in,eror_j,
output,out_in,eror_k,ounit);
for loop:=1 to iterasi do
begin
kenal:=0;
sumall:=0;
application.ProcessMessages;
for num:=0 to high(masuk) do
begin
//---------feedforrward proses---------//
LayerIn(masuk[num],hiden_in[0],vbobot[0]);
FungsiAktivasi(hiden_in[0],hiden[0]);
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
LayerIn(hiden[i],hiden_in[i+1],vbobot[i+1]);
FungsiAktivasi(hiden_in[i+1],hiden[i+1]);
end;
LayerIn(hiden[jhiden-1],out_in,wbobot);
FungsiAktivasi(out_in,output);
//----------------cek target yg dicapai-----------
if loop mod 10=0 then
begin
sum:=0;
for i:=1 to high(output) do
sum:=sum+abs(output[i]-target[num,i]);
sum:=sum/jdata;
if sum<ErorMax then
inc(kenal);
sumall:=sumall+sum;
Form1.statusbar1.Panels[1].Text:=' Data identify'+inttostr(kenal)+ ' from '+inttostr(jdata)+ ' at'+inttostr(loop)+' epoch';
if num=high(masuk) then
Form1.statusbar1.Panels[2].Text:=' Error ='+floattostr(sumall/jdata);
if kenal=jdata then if CekBobotAll(hiden_in,hiden,out_in,output,target,jhiden) then
begin
result:=2;
exit;
end;
end;
//------backforward proses----------//
CalculateOutputEror(target[num],output,out_in,eror_k);
CalculateHidenEror(eror_k,hiden_in[jhiden-1],
wbobot,eror_j[jhiden-1]);
if high(hunit)>0 then
for i:=high(hunit) downto 1 do
CalculateHidenEror(eror_j[i],hiden_in[i-1],vbobot[i],
eror_j[i-1]);
//---------update bobot------------//
UpdateBobot(alpha,miu,eror_k,hiden[jhiden-1],wbobot,wbobotold);
UpdateBobot(alpha,miu,eror_j[0],masuk[num],vbobot[0],
vbobotold[0]);
if high(hunit)>0 then
for i:=high(hunit) downto 1 do
UpdateBobot(alpha,miu,eror_j[i],hiden[i-1],vbobot[i],
vbobotold[i]);
end;
end;
result:=1;//-------normal exit
end;
//----------------------------------
procedure InitRead(var hiden_in,hiden:Tdatabobot;
var out_in,output:T1dimensi;ounit:integer);
var
i:integer;
begin
setlength(hiden,length(hunit));
setlength(hiden_in,length(hunit));
for i:=0 to high(hunit) do
begin
setlength(hiden[i],hunit[i]);
setlength(hiden_in[i],hunit[i]);
hiden[i,0]:=1;
end;
setlength(output,ounit);
setlength(out_in,ounit);
end;
//---------------------------------
function
GetDecision(output:t1dimensi;target:Tdatabobot):integer ;
var
i:integer;
j:integer;
sum:double;
min_e:double;
begin
min_e:=1000;
result:=0;
for i:=0 to high(target) do
begin
sum:=0;
for j:=1 to high(target[i]) do
sum:=sum+abs(output[j]-target[i,j]);
if min_e>sum then
begin
result:=i;
min_e:=sum;
end;
end;
end;

procedure TForm1.BukaFile1Click(Sender: TObject);
begin
with OpenDialog1 do
begin
Title:='Buka File Data';
Filter:='data File (*.wav)|*.wav';
DefaultExt:='dat';
FileName:='';
InitialDir:=ExtractFileDir(ParamStr(0))+'\data';
if Execute then
begin
BukaFileData(FileName);
LaporkanKeMemo(FileName);
GraphikkanKeWave;
end;
end;
AutoProcess1.Enabled:=true;
end;

procedure TForm1.AutoProcess1Click(Sender: TObject);
begin
PreProcessing(RealData);
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
jumlahuji:=0;
Button1.enabled:=true;
Button2.enabled:=false;
end;

procedure TForm1.ComboBox2Change(Sender: TObject);
var
a:integer;
temp:string;
begin
JumHidden:=strtoint(ComboBox2.Text);
setlength(HTemp,JumHidden);
for a:=0 to JumHidden-1 do
begin
temp:='25';
inputquery('Jumlah Unit Hiden Ke -'+inttostr(a+1), 'Jumlah Unit :',temp);
HTemp[a]:=strtoint(temp);
end;
end;



procedure TForm1.BitBtn1Click(Sender: TObject);
begin
with OpenDialog1 do
begin
Title:='Buka File Data';
Filter:='data File (*.wav)|*.wav';
DefaultExt:='dat';
FileName:='';
InitialDir:=ExtractFileDir(ParamStr(0))+'\data';
if Execute then
begin
BukaFileData(FileName);
LaporkanKeMemo(FileName);
GraphikkanKeWave;
end;
end;
AutoProcess1.Enabled:=true;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
close
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
PreProcessing(RealData);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
label8.Left :=  label8.Left - 5;
if  label8.Left <= -100 then
label8.Left := 550;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
memo1.Clear;
richedit1.Clear;
richedit2.Clear;
combobox1.ClearSelection;
combobox2.ClearSelection;
Series1.Clear;
statusbar1.Panels[0].Text:='';
statusbar1.Panels[1].Text:='';
statusbar1.Panels[2].Text:='';
label7.Caption:='';
end;
procedure TForm1.SinyalSuara1Click(Sender: TObject);
begin
Series1.Clear;
end;

procedure TForm1.HeaderFile1Click(Sender: TObject);
begin
memo1.Clear;
end;

procedure TForm1.ProcessingSpeech1Click(Sender: TObject);
begin
richedit1.Clear;
end;

procedure TForm1.FileSpeech1Click(Sender: TObject);
begin
richedit2.Clear;
end;

procedure TForm1.otalSuara1Click(Sender: TObject);
begin
combobox1.ClearSelection;
end;

procedure TForm1.JumlahHiddenLayer1Click(Sender: TObject);
begin
combobox2.ClearSelection;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
MessageDlg ('Pengenalan Suara Menggunakan Jaringan Syaraf Tiruan' + #13 +
    'JST adalah suatu teknologi komputasi yg berbasis pada model syaraf biologis dan mencoba mensimulasikan tingkah laku dan kerja model syaraf terhadap berbagai macam masukan ' + #13 +
    '"Mastering Delphi 7" written by Muhammad Ichsan',
    mtInformation, [mbOk], 0);
end;

procedure TForm1.Aboutme1Click(Sender: TObject);
begin
MessageDlg ('Pengenalan Suara Menggunakan Jaringan Syaraf Tiruan' + #13 +
    'JST adalah suatu teknologi komputasi yg berbasis pada model syaraf biologis dan mencoba mensimulasikan tingkah laku dan kerja model syaraf terhadap berbagai macam masukan ' + #13 +
    '"Mastering Delphi 7" written by Muhammad Ichsan',
    mtInformation, [mbOk], 0);
end;

procedure TForm1.About1Click(Sender: TObject);
begin
Panel1.Visible := not Panel1.Visible;
About1.Checked := Panel1.Visible;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
if SaveDialog1.Execute then
  begin
    richedit2.Lines.SaveToFile (SaveDialog1.FileName);
end;
end;


procedure TForm1.Exit2Click(Sender: TObject);
begin
close  ;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
  begin
    Memo1.Lines.SaveToFile (SaveDialog1.FileName);
end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if MessageDlg('Apakah anda yakin untuk'+#13+'keluar dari program ini ?',
      mtConfirmation,[mbYes,mbNo],0)=mrNo then
    CanClose:=False;
end;

procedure TForm1.HapusSemua1Click(Sender: TObject);
begin
label7.Caption:='';
end;

procedure TForm1.rainingnProcess1Click(Sender: TObject);
begin
statusbar1.Panels[0].Text:='';
statusbar1.Panels[1].Text:='';
statusbar1.Panels[2].Text:='';
end;

procedure TForm1.ALLDELETE1Click(Sender: TObject);
begin
memo1.Clear;
richedit1.Clear;
richedit2.Clear;
combobox1.ClearSelection;
combobox2.ClearSelection;
Series1.Clear;
statusbar1.Panels[0].Text:='';
statusbar1.Panels[1].Text:='';
statusbar1.Panels[2].Text:='';
label7.Caption:='';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
maksuji:=strtoint(ComboBox1.text);
with OpenDialog1 do
begin
Title:='Buka File Data';
Filter:='data File (*.wav)|*.wav';
DefaultExt:='wav';
FileName:='';
InitialDir:=ExtractFileDir(ParamStr(0))+'\data';
if Execute then
begin
inc(PosisiFile);
RichEdit1.Lines.Add(FileName);
end;
end;
jumlahuji:=jumlahuji+1;
if jumlahuji=maksuji then
begin
Button1.enabled:=false;
Button2.Enabled:=true;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
a:integer;
i:integer;
j:integer;
temp:TdataBobot;
pan:integer;
curr:integer;
temps:string;
begin
JData:=StrToInt(ComboBox1.Text);
Iterasi:=StrToInt(Edit1.Text);
Alpha:=StrToFloat(trim(Edit2.Text));
Miu:=StrToFloat(trim(Edit3.Text));
ErorMax:=StrToFloat(trim(Edit4.Text));
SetLength(StrIdentitas,JData);
setlength(HUnit,JumHidden);
for a:=0 to JumHidden-1 do
HUnit[a]:=HTemp[a]+1;
setlength(temp,JData);
pan:=0;
for a:=0 to JData-1 do
begin
BukaFileData(RichEdit1.Lines.Strings[a]);
temps:=copy(extractfilename(Form1.opendialog1.FileName),
1,length(extractfilename(Form1.opendialog1.FileName))-
length(extractfileext(Form1.opendialog1.FileName)));
if not inputquery('Data Name','Nama Untuk Data ke'+inttostr(a+1),temps) then
application.MessageBox(pchar('Anda tidak menekan tombol OK'+#13+'Character identified as'+temps),'Confirmation',mb_ok or mb_iconexclamation);
StrIdentitas[a]:=temps;
pan:=max(pan,length(realdata));
setlength(temp[a],length(RealData));
for i:=0 to high(RealData) do
temp[a,i]:=RealData[i];
end;
PanData:=pan;
for a:=0 to JData-1 do
begin
curr:=length(temp[a]);
if curr<pan then
begin
setlength(temp[a],pan);
for i:=curr-1 to pan-1 do
temp[a,i]:=2;
end;
end;
setlength(Masuk,JData);
for a:=0 to JData-1 do
begin
setlength(Cep,0);
PreProcessing(temp[a]);
IUnit:=length(Cep)*length(Cep[0])+1;
setlength(Masuk[a],IUnit);
Masuk[a,0]:=1;
for i:=0 to high(cep) do
for j:=0 to high(cep[i]) do
Masuk[a,i*length(Cep[i])+j+1]:=Cep[i,j];
end;
Button3.Enabled:=true;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
hasil:integer;
begin
statusbar1.Panels[0].Text:=' Training in Process..';
hasil:=DoTrain;
case hasil of
1:MessageDlg('Maximum Iteration reached',
mtInformation,[mbOk],0);
2:MessageDlg('All data can be identified',
mtInformation,[mbOk],0);
end;
Button4.Enabled:=true;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
output:T1dimensi;
out_in:T1dimensi;
hiden:Tdatabobot;
hiden_in:Tdatabobot;
target:Tdatabobot;
i:integer;
j:integer;
jhiden:integer;
curr:integer;
ounit:integer;
begin
BukaFile1.Click;
ALWavePlayer1.FileName:=opendialog1.FileName;
ALWavePlayer1.Enabled:=true;
curr:=length(realdata);
if curr<>pandata then
begin
setlength(realdata,pandata);
if curr<pandata then
for i:=curr to pandata-1 do
realdata[i]:=2;
end;
setlength(masuk,1);
setlength(cep,0);
PreProcessing(RealData);
setlength(masuk[0],iunit);
masuk[0,0]:=1;
for i:=0 to high(cep) do
for j:=0 to high(cep[i]) do
masuk[0,i*length(cep[i])+j+1]:=cep[i,j];
ounit:=InitTarget(target);
InitRead(hiden_in,hiden,out_in,output,ounit);
jhiden:=length(hunit);
LayerIn(masuk[0],hiden_in[0],vbobot[0]);
FungsiAktivasi(hiden_in[0],hiden[0]);
if high(hunit)>0 then
for i:=0 to high(hunit)-1 do
begin
LayerIn(hiden[i],hiden_in[i+1],vbobot[i+1]);
FungsiAktivasi(hiden_in[i+1],hiden[i+1]);
end;
LayerIn(hiden[jhiden-1],out_in,wbobot);
FungsiAktivasi(out_in,output);
i:=GetDecision(output,target);
MessageDlg('Hasil Pengenalan '+StrIdentitas[i],mtInformation,[mbOk],0);
Label7.Caption:=OpenDialog1.FileName+' adalah suara = '+
StrIdentitas[i];
ALWavePlayer1.Enabled:=false;
end;

end.

// Buat Unit 2
{$N+,E+}
(*Allows code to use type 'double', run on any iX86 machine *)
{$R-}
(* Turn off range checking...we violate array bounds rules *)

unit Unit2;

interface
uses Math, Unit1;
function FrameCount(n,m,panjang:integer):integer;
procedure framing(n,m:integer;sinyal:array of double; var
hasil:Tdatabobot);
procedure pre_emphasis(koefisien:double; var sinyal:array of
double);
procedure win_sinyal(nflg:integer;kode:twindow; var win:array
of double);
const M_2PI:double=2 * 3.14159265358979323846;

implementation

function FrameCount(n,m,panjang:integer):integer;
var
a:integer;
jum:integer;
begin
a:=0;
jum:=0;
repeat
inc(jum);
inc(a,n-m);
until a>panjang;
result:=jum;
end;
procedure framing(n,m:integer;sinyal:array of double; var
hasil:Tdatabobot);
var
panjang:integer;
posisi:integer;
a:integer;
b:integer;
begin
panjang:=high(sinyal)+1;
posisi:=0;
b:=0;
repeat
for a:=0 to n-1 do
if posisi+a>=panjang then hasil[b,a]:=0
else hasil[b,a]:=sinyal[posisi+a];
inc(posisi,n-m);
inc(b);
until posisi>panjang;
end;
{
prosedur pre emphasis
koefisien -> nilai dari penguatan berkisar antara 0.9 - 1
sinyal -> sinyal yang akan dilakukan proses pre emhasis
}
procedure pre_emphasis(koefisien:double;var sinyal:array of
double);
var
temp:array of double;
a:integer;
begin
setlength(temp,high(sinyal));
for a:=1 to high(sinyal) do
temp[a]:=sinyal[a]-koefisien*sinyal[a-1];
for a:=1 to high(sinyal) do sinyal[a]:=temp[a];
end;
procedure hanning_win(var win:array of double);
var
arg:double;
a:integer;
panjang:integer;
begin
panjang:=high(win);
arg:= M_2PI/panjang;
for a:=0 to panjang do
win[a]:=0.5*(1-cos(a*arg));
end;
procedure hamming_win(var win:array of double);
var
arg:double;
a:integer;
panjang:integer;
begin
panjang:=high(win);
arg:= M_2PI /panjang;
for a:=0 to panjang do
win[a]:=0.54-0.46*cos(a*arg);
end;
procedure blackman_win(var win:array of double);
var
arg:double;
x:double;
a:integer;
panjang:integer;
begin
panjang:=high(win);
arg:=M_2PI/panjang;
for a:=0 to panjang do
begin
x:=a*arg;
win[a]:=0.42-0.5*cos(x)+0.08*cos(x+x);
end;
end;
procedure bartlett_win(var win:array of double);
var
a:integer;
pan:integer;
panjang:integer;
begin
panjang:=high(win);
pan:=panjang div 2;
for a:=0 to pan-1 do
win[a]:=2*a/pan;
for a:=pan to panjang do
win[a]:=2-2*a/pan;
end;
{
prosedur windowing sinyal
panjang -> panjang dari daerah yang akan di window
nflg -> normalisasi flag
0 -> tidak dinormalisasi
1 -> normalisasi oleh power
2 -> normalisasi oleh magnitude
kode -> kode tipe window yang dipakai
win -> koefisien hasil windowing;
}
procedure win_sinyal(nflg:integer;kode:twindow;var win:array of
double);
var
a:integer;
g:double;
panjang:integer;
begin
g:=1;
panjang:=high(win);
for a:=0 to panjang do
win[a]:=0;
case kode of
blackman:blackman_win(win);
hanning:hanning_win(win);
hamming:hamming_win(win);
bartlett:bartlett_win(win);
end;
case nflg of
0:g:=1;
1:begin
g:=0;
for a:=0 to panjang do
g:=g+sqr(win[a]);
g:=sqrt(g);
end;
2:begin
g:=0;
for a:=0 to panjang do
g:=g+win[a];
end;
end;
for a:=0 to panjang do
win[a]:=win[a]/g;
end;

end.


// Buat Unit 3

{$N+,E+}
(* Allows code to use type 'double' run on any iX86 machine *)
{$R-}
(* Turn off range checking...we violate array bounds rules *)

unit Unit3;

interface

uses math,Unit1;
function LPCAnalisis(sinyal:array of
double;framelength,p:integer;var a:array of double):integer;
function MakeOrder(BandWith:integer):integer;
procedure lpc2cepstral(p1,p2:integer;a:array of double;var
c:array of double);
procedure weightingcepstral(p:integer;var c:array of double);
const M_PI:double=3.14159265358979323846;

implementation

function MakeOrder(BandWith:integer):integer;
begin
result:=2*(BandWith div 1000+1);
end;
//-----------------------------------------//
{
fungsi autokorelasi untuk meminimalisasi mse dari LPC
p -> order dari prediksi
r -> koefisien autokorelasi
frame_length -> panjang frame
sinyal -> data sinyal
hasil procedure adalah :
koefisien autokorelasi
}
//-----------------------------------------//
procedure autocorelation(sinyal:array of
double;frame_length,p:integer;var r:array of double);
var a,b:integer;
temp :double;
begin
for a:=0 to p do
begin
temp:=0;
for b:=0 to frame_length-1-a do
temp:=temp+sinyal[b]*sinyal[b+a];
r[a]:=temp;
end;
end;
//-----------------------------------------//
{
fungsi untuk mencari koefisien prediksi dari LPC
r -> koefisien autokorelasi
p -> order dari prediksi
eps -> singular check
kp -> koefisien prediksi
hasil fungsi adalah :
0 -> normaly completed
1 -> abnormaly completed
2 -> unstable LPC
}
//-----------------------------------------//
function CariKoefisienPrediksi(r:array of
double;p:integer;eps:double;var kp:array of double):integer;
var rmd,mue :double;
a,b,flag:integer;
c :array of double;
begin
flag:=0;
setlength(c,p+1);
if eps<0.0 then eps:=1.0e-6;
rmd :=r[0];
kp[0]:=0;
for a:=1 to p do
begin
mue:= -r[a];
for b:=1 to a-1 do
mue:=mue - c[b] * r[a - b];
mue:= mue/rmd;
for b:=1 to a-1 do
kp[b]:= c[b] + mue * c[a - b];
kp[a]:=mue;
rmd:=(1.0 - mue * mue) * rmd;
if rmd<0 then
rmd:=-rmd;
if rmd<=eps then
begin
result:=1;
exit;
end;
if mue<0 then
mue:=-mue;
if mue>=1 then
flag:=2;
for b:= 0 to a do
c[b]:=kp[b];
end;
kp[0]:=sqrt(rmd);
result:=flag;
end;
function Gain(p:integer;a:array of double;r:array of
double):double;
var b:integer;
temp:double;
begin
temp:=0;
for b:=1 to p do
temp:=temp+a[b]*r[b];
temp:=r[0]-temp;
result:=sqrt(temp);
end;
//-----------------------------------------//
{
prosedur untuk menganalisa LPC
frame_length -> panjang frame
sinyal -> data sinyal
p -> order dari lpc
a -> koefisien dari lpc
hasilnya adalah apakah lpc kita stabil atau nggak
}
//-----------------------------------------//
function LPCAnalisis(sinyal:array of
double;framelength,p:integer;var a:array of double):integer;
var r :array of double;
flag,b,c:integer;
temp :double;
sinpred :array of double;
begin
setlength(r,p+1);
setlength(sinpred,framelength);
autocorelation(sinyal,framelength,p,r);
flag:=CariKoefisienPrediksi(r,p,-1,a);
for b:=1 to framelength-1 do
begin
temp:=0;
for c:=1 to p do
if b-c>=0 then
temp:=temp+sinyal[b-c]*a[c];
sinpred[b]:=temp;
end;
result:=flag;
end;
//-----------------------------------------//
{
prosedur untuk mencari koefisien cepstral
p1 -> order dari lpc
p2 -> order dari cepstral
a -> koefisien dari lpc
c -> koefisien dari cepstral
hasilnya adalah koefisien cepstral -> c
}
//-----------------------------------------//
procedure lpc2cepstral(p1,p2:integer;a:array of double;var
c:array of double);
var i,j,k :integer;
temp :double;
begin
c[0]:=log10(a[0]);
c[1]:=-a[1];
for i:=2 to p2 do
begin
j:=i;
if i>p1 then k:=i-p1
else k:=1;
temp:=0;
repeat
temp:=temp+k*c[k]*a[i-k];
inc(k);
until k>=j;
c[i]:=-temp/i;
if i<=p1 then c[i]:=c[i]-a[i];
end;
end;
//-----------------------------------------//
{
prosedur untuk pembobotan koefisien cepstral untuk mengurangi
sensitivitas
p -> order dari cepstral
c -> koefisien dari cepstral
hasilnya adalah koefisien cepstral yang telah di boboti -> c
}
//-----------------------------------------//
procedure weightingcepstral(p:integer;var c:array of double);
var a:integer;
w:array of double;
arg:double;
begin
setlength(w,p+1);
arg:=M_PI/p;
for a:=1 to p do
w[a]:=1+(p/2)*sin(a*arg);
for a:=1 to p do
c[a]:=c[a]*w[a];
end;

end.

// Buat Unit 4

{$N+,E+}

(* Allows code to use type 'double' run on any iX86 machine *)

{$R-}

(* Turn off range checking...we violate array bounds rules *)

unit Unit4;

interface

uses math, Unit1;

procedure InisialisasiBobot(var vbobot:array of Tdatabobot;var

wbobot:Tdatabobot);

procedure LayerIn(prev:array of double;var

next:T1dimensi;bobot:Tdatabobot);

procedure FungsiAktivasi(inp:array of double;var hasil:array of

double);

procedure CalculateOutputEror(target,output,out_in:array of

double;var eror_k:array of double);

procedure CalculateHidenEror(eror_next,hiden_in:array of

double;bobot:Tdatabobot;var eror_j:array of double);

procedure

UpdateBobot(alpha,miu:double;eror_next,prev_data:array of

double;var bobot,oldbobot:Tdatabobot);

implementation

procedure RandomBobot(var bobot:Tdatabobot);

var a,b:integer;

begin

for a:=0 to high(bobot) do

for b:=0 to high(bobot[a]) do

bobot[a,b]:=random-0.5;

end;

procedure NguyenWidrow(var bobot:tdatabobot);

var beta:double;

a,b :integer;

old :double;

UnitInput,UnitHiden:integer;

begin

UnitInput:=high(bobot);

UnitHiden:=high(bobot[0]);

beta:=0.7*(power(UnitHiden,1/UnitInput));

for a:=1 to UnitHiden do

begin

old:=0;

for b:=1 to UnitInput-1 do

old:=old+sqr(bobot[b,a]);

old:=sqrt(old);

for b:=1 to UnitInput-1 do

bobot[b,a]:=beta*bobot[b,a]/old;

bobot[0,a]:=beta*(1-2*random);

end;

end;

function sigmoid(nilai:real):real ;

begin

result:=1/(1+(exp(-nilai)));

end;

function TurunanSigmoid(nilai:real):real ;

begin

result:= sigmoid(nilai)*(1-sigmoid(nilai));

end;

procedure InisialisasiBobot(var vbobot:array of Tdatabobot;var

wbobot:Tdatabobot);

var a:integer;

begin

RandomBobot(vbobot[0]);

NguyenWidrow(vbobot[0]);

if high(vbobot)>0 then

for a:=1 to high(vbobot) do

RandomBobot(vbobot[a]);

RandomBobot(wbobot);

end;

procedure LayerIn(prev:array of double;var

next:T1dimensi;bobot:Tdatabobot);

var a,b:integer;

begin

for a:=1 to high(next) do

begin

next[a]:=bobot[0,a];

for b:=1 to high(prev) do

next[a]:=next[a]+bobot[b,a]*prev[b];

end;

end;

procedure FungsiAktivasi(inp:array of double;var hasil:array of

double);

var a:integer;

begin

for a:=1 to high(hasil) do

hasil[a]:=sigmoid(inp[a]);

end;

procedure CalculateOutputEror(target,output,out_in:array of

double;var eror_k:array of double);

var a:integer;

begin

for a:=1 to high(target) do

eror_k[a]:=(target[a]-output[a])*TurunanSigmoid(out_in[a]);

end;

procedure CalculateHidenEror(eror_next,hiden_in:array of

double;bobot:Tdatabobot;var eror_j:array of double);

var a,b:integer;

eror_in:double;

begin

for a:=1 to high(bobot) do

begin

eror_in:=0;

for b:=1 to high(bobot[a]) do

eror_in:=eror_in+eror_next[b]*bobot[a,b];

eror_j[a]:=eror_in*TurunanSigmoid(hiden_in[a]);

end;

end;

procedure

UpdateBobot(alpha,miu:double;eror_next,prev_data:array of

double;var bobot,oldbobot:Tdatabobot);

var a,b:integer;

temp:Tdatabobot;

begin

setlength(temp,high(bobot)+1);

for a:=0 to high(bobot) do

begin

setlength(temp[a],high(bobot[a])+1);

for b:=0 to high(bobot[a]) do

temp[a,b]:=bobot[a,b];

end;

for a:=0 to high(bobot) do

for b:=0 to high(bobot[a]) do

bobot[a,b]:=bobot[a,b]+alpha*eror_next[b]*prev_data[a]+miu*(bobot[a,b]-oldbobot[a,b]);

for a:=0 to high(bobot) do

for b:=0 to high(bobot[a]) do

oldbobot[a,b]:=temp[a,b];

end;

end.

// Buat Unit Fourier

{$N+,E+} (* Allows code to use type 'double' and run on any

iX86 machine *)

{$R-} (* Turn off range checking...we violate array bounds

rules *)

unit Fourier;

interface

procedure fft (

NumSamples: word; // positiF integer pgkt 2

var RealIn: array of double;

var ImagIn: array of double;

var RealOut: array of double;

var ImagOut: array of double );

procedure ifft (

NumSamples: word; // positiF integer pgkt 2

var RealIn: array of double;

var ImagIn: array of double;

var RealOut: array of double;

var ImagOut: array of double );

procedure fft_integer (

NumSamples: word;

var RealIn: array of integer;

var ImagIn: array of integer;

var RealOut: array of double;

var ImagOut: array of double );

procedure fft_integer_cleanup;

procedure CalcFrequency (

NumSamples: word; // positif integer

FrequencyIndex: word; // 0 .. NumSamples-1

var RealIn: array of double;

var ImagIn: array of double;

var RealOut: double;

var ImagOut: double );

function MakePowerOfTwo(nilai:integer ):integer;

procedure fftlain(dir,m:integer;var x,y:array of double);

implementation

function IsPowerOfTwo ( x: word ): boolean;

var i, y: word;

begin

y := 2;

for i := 1 to 15 do begin

if x = y then begin

IsPowerOfTwo := TRUE;

exit;

end;

y := y SHL 1;

end;

IsPowerOfTwo := FALSE;

end;

function NumberOfBitsNeeded ( PowerOfTwo: word ): word;

var i: word;

begin

for i := 0 to 16 do begin

if (PowerOfTwo AND (1 SHL i)) <> 0 then begin

NumberOfBitsNeeded := i;

exit;

end;

end;

end;

function ReverseBits ( index, NumBits: word ): word;

var i, rev: word;

begin

rev := 0;

for i := 0 to NumBits-1 do begin

rev := (rev SHL 1) OR (index AND 1);

index := index SHR 1;

end;

ReverseBits := rev;

end;

function MakePowerOfTwo(nilai:integer ):integer;

var val,a:integer;

begin

if val<=2 then

result:=2;

val:=2;

repeat

val:= val shl 1;

until val>=nilai;

result:=val;

end;

procedure FourierTransform (

AngleNumerator: double;

NumSamples: word;

var RealIn: array of double;

var ImagIn: array of double;

var RealOut: array of double;

var ImagOut: array of double );

var

NumBits, i, j, k, n, BlockSize, BlockEnd: word;

delta_angle, delta_ar: double;

alpha, beta: double;

tr, ti, ar, ai: double;

begin

if not IsPowerOfTwo(NumSamples) or (NumSamples<2) then

begin

write ( 'Error in procedure Fourier: NumSamples=',

NumSamples );

writeln ( ' is not a positive integer power of 2.' );

halt;

end;

NumBits := NumberOfBitsNeeded (NumSamples);

for i := 0 to NumSamples-1 do begin

j := ReverseBits ( i, NumBits );

RealOut[j] := RealIn[i];

ImagOut[j] := ImagIn[i];

end;

BlockEnd := 1;

BlockSize := 2;

while BlockSize <= NumSamples do begin

delta_angle := AngleNumerator / BlockSize;

alpha := sin ( 0.5 * delta_angle );

alpha := 2.0 * alpha * alpha;

beta := sin ( delta_angle );

i := 0;

while i < NumSamples do begin

ar := 1.0; (* cos(0) *)

ai := 0.0; (* sin(0) *)

j := i;

for n := 0 to BlockEnd-1 do begin

k := j + BlockEnd;

tr := ar*RealOut[k] - ai*ImagOut[k];

ti := ar*ImagOut[k] + ai*RealOut[k];

RealOut[k] := RealOut[j] - tr;

ImagOut[k] := ImagOut[j] - ti;

RealOut[j] := RealOut[j] + tr;

ImagOut[j] := ImagOut[j] + ti;

delta_ar := alpha*ar + beta*ai;

ai := ai - (alpha*ai - beta*ar);

ar := ar - delta_ar;

INC(j);

end;

i := i + BlockSize;

end;

BlockEnd := BlockSize;

BlockSize := BlockSize SHL 1;

end;

end;

procedure fft (

NumSamples: word;

var RealIn: array of double;

var ImagIn: array of double;

var RealOut: array of double;

var ImagOut: array of double );

begin

FourierTransform ( 2*PI, NumSamples, RealIn, ImagIn,

RealOut, ImagOut );

end;

procedure ifft (

NumSamples: word;

var RealIn: array of double;

var ImagIn: array of double;

var RealOut: array of double;

var ImagOut: array of double );

var

i: word;

begin

FourierTransform ( -2*PI, NumSamples, RealIn, ImagIn,

RealOut, ImagOut );

(* Normalize the resulting time samples... *)

for i := 0 to NumSamples-1 do begin

RealOut[i] := RealOut[i] / NumSamples;

ImagOut[i] := ImagOut[i] / NumSamples;

end;

end;

type

doubleArray = array [0..0] of double;

var

RealTemp, ImagTemp: ^doubleArray;

TempArraySize: word;

procedure fft_integer (

NumSamples: word;

var RealIn: array of integer;

var ImagIn: array of integer;

var RealOut: array of double;

var ImagOut: array of double );

var

i: word;

begin

if NumSamples > TempArraySize then begin

fft_integer_cleanup; { free up memory in case we

already have some. }

GetMem ( RealTemp, NumSamples * sizeof(double) );

GetMem ( ImagTemp, NumSamples * sizeof(double) );

TempArraySize := NumSamples;

end;

for i := 0 to NumSamples-1 do begin

RealTemp^[i] := RealIn[i];

ImagTemp^[i] := ImagIn[i];

end;

FourierTransform (

2*PI,

NumSamples,

RealTemp^, ImagTemp^,

RealOut, ImagOut );

end;

procedure fft_integer_cleanup;

begin

if TempArraySize > 0 then begin

if RealTemp <> NIL then begin

FreeMem ( RealTemp, TempArraySize * sizeof(double) );

RealTemp := NIL;

end;

if ImagTemp <> NIL then begin

FreeMem ( ImagTemp, TempArraySize * sizeof(double) );

ImagTemp := NIL;

end;

TempArraySize := 0;

end;

end;

procedure CalcFrequency (

NumSamples: word; { must be integer power of 2 }

FrequencyIndex: word; { must be in the range 0 ..

NumSamples-1 }

var RealIn: array of double;

var ImagIn: array of double;

var RealOut: double;

var ImagOut: double );

var

k: word;

cos1, cos2, cos3, theta, beta: double;

sin1, sin2, sin3: double;

begin

RealOut := 0.0;

ImagOut := 0.0;

theta := 2*PI * FrequencyIndex / NumSamples;

sin1 := sin ( -2 * theta );

sin2 := sin ( -theta );

cos1 := cos ( -2 * theta );

cos2 := cos ( -theta );

beta := 2 * cos2;

for k := 0 to NumSamples-1 do begin

{ Update trig values }

sin3 := beta*sin2 - sin1;

sin1 := sin2;

sin2 := sin3;

cos3 := beta*cos2 - cos1;

cos1 := cos2;

cos2 := cos3;

RealOut := RealOut + RealIn[k]*cos3 - ImagIn[k]*sin3;

ImagOut := ImagOut + ImagIn[k]*cos3 + RealIn[k]*sin3;

end;

end;

procedure fftlain(dir,m:integer;var x,y:array of double);

var nn,i,i1,j,k,i2,l,l1,l2:longint;

c1,c2,tx,ty,t1,t2,u1,u2,z:double;

begin

nn:=1;

for i:=0 to m do

nn:=nn*2;

i2:=nn shr 1;

j:=0;

for i:=0 to nn-1 do

begin

if i<j then

begin

tx:=x[i];

ty:=y[i];

x[i]:=x[j];

y[i]:=y[j];

x[j]:=tx;

y[j]:=ty;

end;

k:=i2;

while k<=j do

begin

j:=j-k;

k:=k shr 1;

end;

j:=j+k;

end;

c1:=-1.0;

c2:=0.0;

l2:=1;

for l:=0 to m do

begin

l1:=l2;

l2:=l2 shl 1;

u1:=1.0;

u2:=0.0;

for j:=0 to 11 do

begin

i:=j;

repeat

i1:=i+l1;

t1:=u1*x[i1]-u2*y[i1];

t2:=u1*y[i1]+u2*x[i1];

x[i1]:=x[i]-t1;

y[i1]:=y[i]-t2;

x[i]:=x[i]+t1;

y[i]:=y[i]+t2;

inc(i,l2);

until i>=nn;

z:=u1*c1-u2*c2;

u2:=u1*c2+u2*c1;

u1:=z;

end;

c2:=sqrt((1.0-c1)/2.0);

if dir=1 then

c2:=-c2;

c1:=sqrt((1.0+c1)/2.0);

end;

if dir=1 then

for i:=0 to nn do

begin

x[i]:=x[i]/nn;

y[i]:=y[i]/nn;

end;

end;

end.

Download Jaringan Syaraf Tiruan

read more »»  

Pengertian Delphi

     Delphi adalah Suatu bahasa pemrograman yang menggunakan visualisasi sama seperti bahasa pemrograman Visual Basic ( VB ) . Namun Delphi menggunakan bahasa yang hampir sama dengan pascal (sering disebut objeck pascal ) . Sehingga lebih mudah untuk digunakan . Bahasa pemrograman Delphi dikembangkan oleh CodeGear sebagai divisi pengembangan perangkat lunak milik embarcadero . Divisi tersebut awalnya milik borland , sehingga bahasa ini memiliki versi Borland Delphi .

     Delphi juga menggunakan konsep yang berorientasi objek ( OOP ) , maksudnya pemrograman dengan membantu sebuah aplikasi yang mendekati keadaan dunia yang sesungguhnya . Hal itu bisa dilakukan dengan cara mendesign objek untuk menyelesaikan masalah . OOP ini memiliki beberapa unsur yaitu ; Encapsulation ( pemodelan ) , Inheritance ( Penurunan ) , Polymorphism ( Polimorfisme ) .

     Awalnya bahasa pemrograman delphi hanya dapat digunakan di Microsoft Windows, namun saat ini telah dikembangkan sehingga dapat digunakan juga di Linux dan di Microsoft .NET . Dengan menggunakan free pascal yang merupakan proyek OpenSource, bahasa pemrograman ini dapat membuat program di sistem operasi Mac OS X dan Windows CE .

     Umumnya delphi hanya digunakan untuk pengembangan aplikasi dekstop, enterprise berbasis database dan program - program kecil . Namun karena pengembangan delphi yang semakin pesat dan bersifat general purpose bahasa pemrograman ini mampu digunakan untuk berbagai jenis pengembangan software . Dan Delphi juga disebut sebagai pelopor perkembangan RadTool ( Rapid Apllication Development ) tahun 1995 . Sehinnga banyak orang yang mulai mengenal dan menyukai bahasa pemrograman yang bersifat VCL ( Visual Component Library ) ini .

read more »»