Sumber Kode

Create Symphony With Midi Sound

  • anonymous
  • Oct 25' 13
  • Delphi
  • 939
  • 17
  • United States

Make short symphony with midi tones, the following is an example of making the tone with midi and you can create your own as well as modify.

image for nada pasarkode.com

image for nada pasarkode

For a while yet attached code, you can get by Subscribe to PK by Email or sending feedback to the subject of the request source code. You can download the sample program on the download page or click this link download this.


I hate wait - so check this out .ha ha ha

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls,ShellApi;

type
  TForm1 = class(TForm)
    Button1: TButton;
    TrackBar1: TTrackBar;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses
MMSystem,ComObj;

type
TVolumeLevel = 0..127;


procedure MakeSound(Frequency{Hz}, Duration{mSec}: Integer; Volume: TVolumeLevel);
{writes tone to memory and plays it}
var
WaveFormatEx: TWaveFormatEx;
MS: TMemoryStream;
i, TempInt, DataCount, RiffCount: integer;
SoundValue: byte;
w: double; // omega ( 2 * pi * frequency)
const
Mono: Word = $0001;
SampleRate: Integer = 11025; // 8000, 11025, 22050, or 44100
RiffId: string = 'RIFF';
WaveId: string = 'WAVE';
FmtId: string = 'fmt ';
DataId: string = 'data';
begin
if Frequency > (0.6 * SampleRate) then
begin
ShowMessage(Format('Sample rate of %d is too Low to play a tone of %dHz',
[SampleRate, Frequency]));
Exit;
end;
with WaveFormatEx do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := Mono;
nSamplesPerSec := SampleRate;
wBitsPerSample := $0008;
nBlockAlign := (nChannels * wBitsPerSample) div 8;
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0;
end;
MS := TMemoryStream.Create;
with MS do
begin
{Calculate length of sound data and of file data}
DataCount := (Duration * SampleRate) div 1000; // sound data
RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) +
SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount; // file data
{write out the wave header}
Write(RiffId[1], 4); // 'RIFF'
Write(RiffCount, SizeOf(DWORD)); // file data size
Write(WaveId[1], Length(WaveId)); // 'WAVE'
Write(FmtId[1], Length(FmtId)); // 'fmt '
TempInt := SizeOf(TWaveFormatEx);
Write(TempInt, SizeOf(DWORD)); // TWaveFormat data size
Write(WaveFormatEx, SizeOf(TWaveFormatEx)); // WaveFormatEx record
Write(DataId[1], Length(DataId)); // 'data'
Write(DataCount, SizeOf(DWORD)); // sound data size
{calculate and write out the tone signal} // now the data values
w := 2 * Pi * Frequency; // omega
for i := 0 to DataCount - 1 do
begin
SoundValue := 127 + trunc(Volume * sin(i * w / SampleRate)); // wt = w * i / SampleRate
Write(SoundValue, SizeOf(Byte));
end;
{now play the sound}
sndPlaySound(MS.Memory, SND_MEMORY or SND_SYNC);
MS.Free;
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
MakeSound(strtoint(edit1.Text)+80, 250,trackbar1.Position*10);
MakeSound(strtoint(edit2.Text)+80, 250,trackbar1.Position*10);
MakeSound(strtoint(edit3.Text)+80, 250,trackbar1.Position*10);
MakeSound(strtoint(edit4.Text)+80, 250,trackbar1.Position*10);
MakeSound(strtoint(edit5.Text)+80, 250,trackbar1.Position*10);
end;
procedure Speak(const sText : String);
const
SVSFDefault = $00000000;
SVSFlagsAsync = $00000001;
var
oVoice: OLEVariant;
begin
oVoice := CreateOLEObject('SAPI.SpVoice');
oVoice.Speak(sText, SVSFDefault);
oVoice := Unassigned;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Speak('100');
end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
shellexecute(0,'open','http://pasarkode.com','','',SW_SHOWNORMAL);
timer1.Enabled:=false;
end;

end.

Share

  • Tags :
comments powered by Disqus

Kode Terkait

Get IP Address

Splash Screen

Border Radius

Session for Keep Values

Solve (LSN) Error 9003 When Attach the Database SQL2000

Zakat Counter

Looking for Date and Time Difference

Send Email Through Console

Program mencari kpk n buah bilangan

Membuat program bilangan n prima



Kategori