1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:

{ 
  Windows NT/2000/XP: 
  Windows.Beep(dwFreq, dwDuration); 

  dwFreq : frequency, in hertz, of the sound. 
  dwDuration : duration, in milliseconds, of the sound. 
} 



// Windows 9x/NT-Platforms: 

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(aFreq, aDelay: Integer); 

  procedure DoSound(Freq: Word); 
  var 
    B: Byte; 
  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; 
  end; 

  procedure Delay(MSecs: Integer); 
  var 
    FirstTickCount: LongInt; 
  begin 
    FirstTickCount := GetTickCount; 
    repeat 
      Sleep(1); 
      //or use Application.ProcessMessages instead of Sleep 
    until ((GetTickCount - FirstTickCount) >= Longint(MSecs)); 
  end; 
   
begin 
  if Win32Platform = VER_PLATFORM_WIN32_NT then 
  begin 
    Windows.Beep(aFreq, aDelay); 
  end 
  else 
  begin 
    DoSound(aFreq); 
    Delay(aDelay); 
  end; 
end; 

procedure NoSound; 
var 
  Value: Word; 
begin 
  if not (Win32Platform = VER_PLATFORM_WIN32_NT) then 
  begin 
    Value := GetPort($61) and $FC; 
    SetPort($61, Value); 
  end; 
end; 


// Example: 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Sound(500, 1000); 
  Sound(700, 1000); 
  Sound(900, 1000); 
  NoSound; 
end;