ForumSevgisi.Com

  ForumSevgisi.Com > ForumSevgisi Webmaster Bölümü > Webmaster Genel

Webmaster Genel Webmasterlıkla ilgili Her şeyin Paylaşıldığı Bölüm.


MultiMedia kullanimi(wav)

Webmasterlıkla ilgili Her şeyin Paylaşıldığı Bölüm.


MultiMedia kullanimi(wav)

ForumSevgisi Webmaster Bölümü Kategorisinde ve Webmaster Genel Forumunda Bulunan MultiMedia kullanimi(wav) Konusunu Görüntülemektesiniz,Konu İçerigi Kısaca ->> MultiMedia kullanimi(wav) MultiMedia kullanimi(wav) Kod: Aynı anda birden fazla müzik dosyasının aynı anda birlikte çalınması: uses MMSystem; procedure SendMCICommand(Cmd: string); ...

Kullanıcı Etiket Listesi

Yeni Konu aç  Cevapla
LinkBack Seçenekler Stil

Okunmamış 09 Nisan 2015, 16:18   #1
Durumu:
Çevrimdışı
Kaf_Dağı - ait Kullanıcı Resmi (Avatar)
Arastirmaci
Üyelik tarihi: 26 Ekim 2014
Şehir: ~~~~~~
Mesajlar: 1.130
Konular: 710
Beğenilen: 168
Beğendiği: 334
www.forumsevgisi.com
Standart MultiMedia kullanimi(wav)

MultiMedia kullanimi(wav)

MultiMedia kullanimi(wav)

Kod:
        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;

________________
.........................
imza
Alıntı ile Cevapla
Yeni Konu aç  Cevapla

Etiketler
kullanimiwav, multimedia, multimedia kullanimi(wav)

Seçenekler
Stil


Saat: 20:22

Forum Yasal Uyarı
vBulletin® ile Oluşturuldu
Copyright © 2016 vBulletin Solutions, Inc. All rights reserved.

ForumSevgisi.Com Her Hakkı Saklıdır
Tema Tasarım:
Kronik Depresif


Sitemiz bir 'paylaşım' sitesidir. Bu yüzden sitemize kayıt olan herkes kontrol edilmeksizin mesaj/konu/resim paylaşabiliyorlar. Bu sebepten ötürü, sitemizdeki mesaj ya da konulardan doğabilecek yasal sorumluluklar o yazıyı paylaşan kullanıcıya aittir ve iletişim adresine mail atıldığı taktirde mesaj ya da konu en fazla 48 saat içerisinde silinecektir.

ankara escort, izmir escort ankara escort, ankara escort bayan, eryaman escort, bursa escort pendik escort, antalya escort,