[Kaf_Dağı]

MultiMedia kullanimi(wav)

Kod:   Kodu kopyalamak için üzerine çift tıklayın!

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(@[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]er, 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, @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]erLine,
    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, @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]erLine,
      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 := @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]erControl;
  end;
  Rslt := mixerGetLineControls(Mixer, @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]erLineControls,
    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 := @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]erControlDetailsSigned;
  end;
  repeat
    Sleep(10);
    Rslt := mixerGetControlDetails(Mixer, @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]erControlDetails,
      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, @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...], 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, @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...], 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, @[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]) = 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;