Mega Code Archive
Multimedia kullanimi[wav]
<![CDATA[
Aynı anda birden fazla müzik dosyasının aynı anda birlikte çalınması:
uses
MMSystem;
procedure SendMCICommand(Cmd: string);
var
RetVal: Integer;
ErrMsg: array[0..254] of char;
begin
RetVal := mciSendString(PChar(Cmd), nil, 0, 0);
if RetVal <> 0 then
begin
{get message for returned value}
mciGetErrorString(RetVal, ErrMsg, 255);
MessageDlg(StrPas(ErrMsg), mtError, [mbOK], 0);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMCICommand('open waveaudio shareable');
SendMCICommand('play "C:\xyz\BackgroundMusic.wav"');
SendMCICommand('play "C:\xyz\AnotherMusic.wav"');
SendMCICommand('close waveaudio');
end;
---------------------------------------------------------
Speech Kullan (Hani windowsta ingilazca konuşan sam varya işte onu konuşturuyorsunuz)
// Works on NT, 2k, XP, Win9x with SAPI SDK
// reference & Further examples: See links below!
uses Comobj;
procedure TForm1.Button1Click(Sender: TObject);
var
voice: OLEVariant;
begin
voice := CreateOLEObject('SAPI.SpVoice');
voice.Speak('Hello World!', 0);
end;
----------------------------------------------------------
wav dosyasının boyutunu al (sn)
uses
MPlayer, MMsystem;
type
EMyMCIException = class(Exception);
TWavHeader = record
Marker1: array[0..3] of Char;
BytesFollowing: Longint;
Marker2: array[0..3] of Char;
Marker3: array[0..3] of Char;
Fixed1: Longint;
FormatTag: Word;
Channels: Word;
SampleRate: Longint;
BytesPerSecond: Longint;
BytesPerSample: Word;
BitsPerSample: Word;
Marker4: array[0..3] of Char;
DataBytes: Longint;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Header: TWavHeader;
begin
with TFileStream.Create('C:\SomeFile.wav', fmOpenRead) do
try
ReadBuffer(Header, SizeOf(Header));
finally
Free;
end;
ShowMessage(FloatToStr((Int64(1000) * header.DataBytes div header.BytesPerSecond) / 1000));
end;
----------------------------------------------------
Ses kartından ses çıkart
uses
MMSystem;
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;
// How to call the function:
procedure TForm1.Button1Click(Sender: TObject);
begin
MakeSound(1200, 1000, 60);
end;
--------------------------------------------------------------
ses dalgası gösterici
{
Every line going into and out of the mixer has a number of "controls"
associated with it. Some of those controls are "meters," which give
you a real-time value of the sound level on the corresponding line.
Not all lines have meter controls, and not all sound cards provide
support for meters.
Here's some code that will retrieve a handle to the meter attached to
the WaveOut source of the speaker line, if there is one:
}
uses
MMSystem;
procedure TForm1.Button1Click(Sender: TObject);
var
MixerControl: TMixerControl;
MixerControlDetails: TMixerControlDetails;
MixerControlDetailsSigned: TMixerControlDetailsSigned;
Mixer: THandle;
MixerLine: TMixerLine;
MixerLineControls: TMixerLineControls;
PeakMeter: DWORD;
Rslt: DWORD;
SourceCount: Cardinal;
WaveOut: DWORD;
I: Integer;
X: Integer;
Y: Integer;
begin
Rslt := mixerOpen(@Mixer, 0, 0, 0, 0);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t open mixer (%d)', [Rslt]);
FillChar(MixerLine, SizeOf(MixerLine), 0);
MixerLine.cbStruct := SizeOf(MixerLine);
MixerLine.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Rslt := mixerGetLineInfo(Mixer, @MixerLine,
MIXER_GETLINEINFOF_COMPONENTTYPE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t find speaker line (%d)', [Rslt]);
SourceCount := MixerLine.cConnections;
WaveOut := $FFFFFFFF;
for I := 0 to SourceCount - 1 do
begin
MixerLine.dwSource := I;
Rslt := mixerGetLineInfo(Mixer, @MixerLine,
MIXER_GETLINEINFOF_SOURCE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t get source line (%d)', [Rslt]);
if MixerLine.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT then
begin
WaveOut := MixerLine.dwLineId;
Break;
end;
end;
if WaveOut = $FFFFFFFF then
raise Exception.Create('Can''t find wave out device');
FillChar(MixerLineControls, SizeOf(MixerLineControls), 0);
with MixerLineControls do
begin
cbStruct := SizeOf(MixerLineControls);
dwLineId := WaveOut;
dwControlType := MIXERCONTROL_CONTROLTYPE_PEAKMETER;
cControls := 1;
cbmxctrl := SizeOf(TMixerControl);
pamxctrl := @MixerControl;
end;
Rslt := mixerGetLineControls(Mixer, @MixerLineControls,
MIXER_GETLINECONTROLSF_ONEBYTYPE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t find peak meter control (%d)',
[Rslt]);
PeakMeter := MixerControl.dwControlID;
// at this point, I have the meter control ID, so I can
// repeatedly query its value and plot the resulting data
// on a canvas
X := 0;
FillChar(MixerControlDetails, SizeOf(MixerControlDetails), 0);
with MixerControlDetails do
begin
cbStruct := SizeOf(MixerControlDetails);
dwControlId := PeakMeter;
cChannels := 1;
cbDetails := SizeOf(MixerControlDetailsSigned);
paDetails := @MixerControlDetailsSigned;
end;
repeat
Sleep(10);
Rslt := mixerGetControlDetails(Mixer, @MixerControlDetails,
MIXER_GETCONTROLDETAILSF_VALUE);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t get control details (%d)',
[Rslt]);
Application.ProcessMessages;
Inc(X);
Y := 300 - Round(300 * Abs(MixerControlDetailsSigned.lValue) / 32768);
with Canvas do
begin
MoveTo(X, 0);
Pen.Color := clBtnFace;
LineTo(X, 300);
Pen.Color := clWindowText;
LineTo(X, Y);
end;
until X > 500;
// don't forget to close the mixer handle when you're done
Rslt := mixerClose(Mixer);
if Rslt <> 0 then
raise Exception.CreateFmt('Can''t close mixer (%d)', [Rslt]);
end;
---------------------------------------------------------
Cd-rom da bulunan cd müzik cdsimi
...check if an audio-cd is in the cd drive?
function IsAudioCD(Drive: Char): Boolean;
var
DrivePath: string;
MaximumComponentLength: DWORD;
FileSystemFlags: DWORD;
VolumeName: string;
OldErrorMode: UINT;
DriveType: UINT;
begin
Result := False;
DrivePath := Drive + ':\';
OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try
DriveType := GetDriveType(PChar(DrivePath));
finally
SetErrorMode(OldErrorMode);
end;
if DriveType <> DRIVE_CDROM then
Exit;
SetLength(VolumeName, 64);
GetVolumeInformation(PChar(DrivePath),
PChar(VolumeName),
Length(VolumeName),
nil,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
if lStrCmp(PChar(VolumeName), 'Audio-CD') = 0 then Result := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if IsAudioCD('D') then
ShowMessage('Audio-CD found in drive D.')
else
ShowMessage('No Audio-CD found in drive D.');
end;
----------------------------------------------------
CD sürücünün kapagı açık mı?
uses
mmsystem;
procedure TForm1.Button1Click(Sender: TObject);
var
s: array[0..64] of Char;
error: Cardinal;
Text: array[0..255] of Char;
begin
error := mciSendstring('open cdaudio alias geraet', nil, 0, Handle);
if error <> 0 then
begin
mciGetErrorstring(error, @Text, 255);
ShowMessage(Text);
mciSendstring('close geraet', nil, 0, Handle);
Exit;
end;
error := mciSendstring('status geraet mode', @s, SizeOf(s), Handle);
if error <> 0 then
begin
mciGetErrorstring(error, @Text, 255);
ShowMessage(Text);
mciSendstring('close geraet', nil, 0, Handle);
Exit;
end;
mciSendstring('close geraet', nil, 0, Handle);
ShowMessage('Message: ' + s);
end;
----------------------------------------------------
Wave ses ayarını nasıl yaparım
uses
MMSystem;
function GetWaveVolume(var LVol: DWORD; var RVol: DWORD): Boolean;
var
WaveOutCaps: TWAVEOUTCAPS;
Volume: DWORD;
begin
Result := False;
if WaveOutGetDevCaps(WAVE_MAPPER, @WaveOutCaps, SizeOf(WaveOutCaps)) = MMSYSERR_NOERROR then
if WaveOutCaps.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
begin
Result := WaveOutGetVolume(WAVE_MAPPER, @Volume) = MMSYSERR_NOERROR;
LVol := LoWord(Volume);
RVol := HiWord(Volume);
end;
end;
{
The waveOutGetDevCaps function retrieves the capabilities of
a given waveform-audio output device.
The waveOutGetVolume function retrieves the current volume level
of the specified waveform-audio output device.
}
function SetWaveVolume(const AVolume: DWORD): Boolean;
var
WaveOutCaps: TWAVEOUTCAPS;
begin
Result := False;
if WaveOutGetDevCaps(WAVE_MAPPER, @WaveOutCaps, SizeOf(WaveOutCaps)) = MMSYSERR_NOERROR then
if WaveOutCaps.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
Result := WaveOutSetVolume(WAVE_MAPPER, AVolume) = MMSYSERR_NOERROR;
end;
{
AVolume:
The low-order word contains the left-channel volume setting,
and the high-order word contains the right-channel setting.
A value of 65535 represents full volume, and a value of 0000 is silence.
If a device does not support both left and right volume control,
the low-order word of dwVolume specifies the volume level,
and the high-order word is ignored.
}
{ *** How to Use: ***}
// SetWaveVolume:
procedure TForm1.Button1Click(Sender: TObject);
var
LVol: Word;
RVol: Word;
begin
LVol := SpinEdit1.Value; // max. is 65535
RVol := SpinEdit2.Value; // max. is 65535
SetWaveVolume(MakeLong(LVol, RVol));
end;
// GetWaveVolume:
procedure TForm1.Button2Click(Sender: TObject);
var
LVol: DWORD;
RVol: DWORD;
begin
if GetWaveVolume(LVol, RVol) then
begin
SpinEdit1.Value := LVol;
SpinEdit2.Value := RVol;
end;
end;
]]>