Buscar por:

Como tocar sons no auto-falante interno do pc?

Código

Unit Sounds; 

interface 

uses SysUtils, Windows, Classes, StdCtrls; 

procedure Sound(Freq : Word); 

implementation 

procedure SetPort(address, Value:Word); 

var 

  bValue: byte; 

begin 

  bValue := trunc(Value and 255); 

  asm 

  mov dx, address 

  mov al, bValue 

  out dx, al 

  end; 

end;   

function GetPort(address:word):word; 

var 

  bValue: byte; 

begin 

  asm 

  mov dx, address 

  in al, dx 

  mov bValue, al 

  end; 

  GetPort := bValue; 

end;   

procedure Sound(Freq : Word); 

var 

  B : Byte; 

  Value: Word; 

begin 

if Freq > 18 then 

  begin 

  Freq := Word(1193181 div LongInt(Freq)); 

  B := Byte(GetPort($61)); 

  if (B and 3) = 0 then 

  begin 

  SetPort($61, Word(B or 3)); 

  SetPort($43, $B6); 

  end; 

  SetPort($42, Freq); 

  SetPort($42, Freq shr 8); 

  end 

else 

  begin 

  Value := GetPort($61) and $FC; 

  SetPort($61, Value); 

  end; 

end; 

end.