sounds32.pas

来自「Motorola 集群通信系统中SDTS车载台PEI端测试程序」· PAS 代码 · 共 134 行

unit Sounds32;

interface

uses
  Windows;

type
  TPlatForm = (WinUnknown, Win31, Win95, WinNT, Win32s);

var
  WinVersion : TPlatForm;

//procedure Delay(ms : LongInt);
procedure PlayBeep; overload;
procedure PlayBeep(freq : LongInt); overload;
procedure PlayBeep(freq, ms : LongInt); overload;

implementation

procedure SetPort(address : word; value : byte);
var
  bvalue : byte;
begin
  bvalue := value;
  asm
    mov dx,address
    mov al,bvalue
    out dx,al
  end;
end;

function GetPort(address : Word) : byte;
var
  bvalue : byte;
begin
  asm
    mov dx,address
    in al,dx
    mov bvalue,al
  end;
  result := bvalue;
end;

procedure Sound(Freq: Word);
var
  B : Byte;
begin
  if Freq > 18 then begin
    Freq := Word(1193181 div LongInt(Freq));
    B := GetPort($61);
    if (B and 3) = 0 then begin
      SetPort($61,B or 3);
      SetPort($43,$B6);
    end;
    SetPort($42,Byte(Freq));
    SetPort($42,Byte(Freq shr 8));
  end;
end;

procedure NoSound;
begin
   SetPort($61,GetPort($61) and $FC);
end;


procedure Delay(ms : LongInt);
var
  t : longInt;
begin
  if ms < 0 then
    ms := 0;
  if ms > 32767 then
    ms := 32767;
  t := GetTickCount;
  repeat
  until GetTickCount > (t + ms);
end;

function GetWinVersion : TPlatForm;
var
  OSVersionInfo : TOSVersionInfo;
begin
  OSVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
  GetVersionEx ( OSVersionInfo );
  case OSVersionInfo.dwPlatformId of
    VER_PLATFORM_WIN32_WINDOWS : Result := Win95;
    VER_PLATFORM_WIN32_NT      : Result := WinNT;
    VER_PLATFORM_WIN32s        : Result := Win32s;
    else
      Result := WinUnKnown;
  end;
end;

procedure PlayBeep;
begin
  if WinVersion = WinNT then begin
    Windows.Beep(440,100);
  end
  else begin
    Sound(440);
    Delay(100);
    NoSound;
  end;
end;

procedure PlayBeep(freq : LongInt);
begin
  if WinVersion = WinNT then begin
    Windows.Beep(freq,100);
  end
  else begin
    Sound(freq);
    Delay(100);
    NoSound;
  end;
end;

procedure PlayBeep(freq, ms : LongInt);
begin
  if WinVersion = WinNT then begin
    Windows.Beep(freq,ms);
  end
  else begin
    Sound(freq);
    Delay(ms);
    NoSound;
  end;
end;

initialization
  WinVersion := GetWinVersion;
end.