Работа со звуком

        check.gif (991 bytes) Звук через BEEPER

        check.gif (991 bytes) Изменение громкости звуков в Windows


Звук через BEEPER

        Вот пример для доступа к системному динамику: Вначале две процедуры общения с внешними устройствами, таки работающие под WIN95 и NT,несмотря на то, что разработчики софта хотят программеров все дальше и дальше оттодвинуть от железа!


// Вывод в порт внешнего устройства с адресом-ADR, байта-data 
procedure OutPort(adr: word; data: byte); 
begin 
  asm 
    mov dx,adr 
    mov al,data 
    out dx,al 
  end; 
end; 

// Ввод из порта внешнего устройства с адресом-ADR 
function InPort(adr: word):byte; 
begin 
  asm 
    mov dx,adr 
    in al,dx 
    mov @result,al 
  end; 
end; 

// Процедура доступа до системного динамика и организация beep.
// Организуя задержку, независимую от скорости процессора, например 
// через функцию GetTickCount, можно сделать все более корректно.

procedure TForm1.Button1Click(Sender: TObject); 
var b: byte; 
    n,m: word; 
begin 
  b:=Inport($61); 
  for n:=1 to 200 do begin {n:=200 - длительность звучания} 
    {m:=700 - частота звучания} 
    for m:=1 to 700 do Outport($61,b and not(2)); {установить 2-ой бит в 0} 
    for m:=1 to 700 do Outport($61,b or 2); {установить 2-ой бит в 1} 
  end; 
end; 

Изменение громкости звуков в Windows

uses MMSystem;

function GetWaveVolume: DWord;
var Woc : TWaveOutCaps;
    Volume : DWord;
begin
  result:=0;
  if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) =
       MMSYSERR_NOERROR then begin
    if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then begin
      WaveOutGetVolume(WAVE_MAPPER, @Volume);
      Result := Volume;
    end;
  end; 
end;

procedure SetWaveVolume(const AVolume: DWord);
var Woc : TWaveOutCaps;
begin
  if WaveOutGetDevCaps(WAVE_MAPPER, @Woc, sizeof(Woc)) =
       MMSYSERR_NOERROR then begin
    if Woc.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
      WaveOutSetVolume(WAVE_MAPPER, AVolume);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Beep;
end;

procedure TForm1.Button2Click(Sender: TObject);
var LeftVolume: Word;
    RightVolume: Word;
begin
  LeftVolume := StrToInt(Edit1.Text);
  RightVolume := StrToInt(Edit2.Text);
  SetWaveVolume(MakeLong(LeftVolume, RightVolume));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Caption := IntToStr(GetWaveVolume);
end;





Hosted by uCoz