PC Speaker !?

Hej

det er disse to procedurer du skal bruge. Du kan f.eks. køre dem på denne måde som lyder som en alarm:

var
  I: Integer;
begin
  for I := 0 to 20 do
    begin
      Sound(1000);
      sleep(100);
      Sound(500);
      sleep(100);
    end;
  NoSound;
end;

procedure nosound;
{turn off the pc speaker}
  begin
    asm
      mov al,0
      out $61,al
    end;
  end;

 
procedure sound(mhz : integer);
{mhz = the frequency of the pc speaker}
var
  count    : word;
  oldport,
  newport  : byte;

  begin
    count := 1193280 div mhz;
    asm
      mov al,$b6
      out $43,al
      mov ax,count
      out $42,al
      mov al,ah
      out $42,al
      mov al,3
      out $61,al
    end;
  end;


Håber det hjalp.

/SpEeDy

do virker ovenstående ikke på Windows NT eller W2k fordi out er en priviligeret instruktion.

jens B

Prøv den her den virker under alle windows versioner :

Unit Bleeper;

Interface

Procedure ShutUp;
Procedure DoBleep (Freq : Word; MSecs : LongInt); { Duration of -1 means bleep until the next bleep sent, or ShutUp is called }
Procedure BleepPause (MSecs : LongInt);

Implementation

Uses
  {$IFDEF WIN32}Windows{$ELSE}WinProcs{$ENDIF}{$IFNDEF CONSOLE}, Forms{$ENDIF};

{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Assembler Bits for Wind 3.x And \'95 -- --- -- --- -- --- -- --- -- --- }

Procedure AsmShutUp;{$IFDEF WIN32}Pascal;{$ENDIF}
  Asm
    In AL, $61
    And AL, $FC
    Out $61, AL
  End;

Procedure AsmBeep (Freq : Word);{$IFDEF WIN32}Pascal;{$ENDIF}
Label
  Skip;
  Asm
        Push BX
        In AL, $61
        Mov BL, AL
        And AL, 3
        Jne Skip
        Mov AL, BL
        Or AL, 3
        Out $61, AL
        Mov AL, $B6
        Out $43, AL
  Skip: Mov AX, Freq
        Out $42, AL
        Mov AL, AH
        Out $42, AL
        Pop BX
  End;

{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- Low Level Bits for Wind 3.x And \'95 -- --- -- --- -- --- -- --- -- --- }

Procedure HardBleep (Freq : Word; MSecs : LongInt);
Const
  HiValue = {$IFDEF WIN32}High (DWord){$ELSE}High (LongInt){$ENDIF};
Begin
  If (Freq >= 20) And (Freq <= 5000) Then
  Begin
    AsmBeep (Word (1193181 Div LongInt (Freq)));
    If MSecs >= 0 Then
    Begin
      BleepPause (MSecs);
      AsmShutUp;
    End;
  End;
End;

{ -- --- -- --- -- --- -- --- -- --- -- --- -- --- -- --- Procedures for you to use -- --- -- --- -- --- -- --- -- --- -- --- }

{$IFDEF WIN32}
Var
  SysWinNT : Boolean;
{$ENDIF}

Procedure BleepPause (MSecs : LongInt);
Const
  HiValue = {$IFDEF WIN32}High (DWord){$ELSE}High (LongInt){$ENDIF};
Var
  iCurrTickCount, iFirstTickCount : {$IFDEF WIN32}DWord{$ELSE}LongInt{$ENDIF};
  iElapTime : LongInt;
Begin
  iFirstTickCount := GetTickCount;
  Repeat
    {$IFNDEF CONSOLE}
    If MSecs > 1000 Then
      Application.ProcessMessages;
    {$ENDIF}
    iCurrTickCount := GetTickCount;
    { Has GetTickCount wrapped to 0 ? }
    If iCurrTickCount < iFirstTickCount Then
      iElapTime := HiValue - iFirstTickCount + iCurrTickCount
    Else
      iElapTime := iCurrTickCount - iFirstTickCount;
  Until iElapTime >= MSecs;
End;

Procedure DoBleep (Freq : Word; MSecs : LongInt);
Begin
  If MSecs < -1 Then
    MSecs := 0;

  {$IFDEF WIN32}If SysWinNT Then Windows.Beep (Freq, MSecs) Else {$ENDIF}HardBleep (Freq, MSecs);
End;

Procedure ShutUp;
Begin
  {$IFDEF WIN32}If SysWinNT Then Windows.Beep (1, 0) Else{$ENDIF}AsmShutUp;
End;

{$IFDEF WIN32}
Procedure InitSysType;
Var
  VersionInfo : TOSVersionInfo;
Begin
  VersionInfo.dwOSVersionInfoSize := SizeOf (VersionInfo);
  GetVersionEx (VersionInfo);
  SysWinNt := VersionInfo.dwPlatformID = VER_PLATFORM_WIN32_NT;
End;

Initialization
  InitSysType;
{$ENDIF}
End.

den her unit viser hvordan man kan lave nogle lyde til bestemte events :

Unit BleepInt;

Interface

Type
  TBleepType= (bOK, bInterrupt, bError);

Procedure Bleep (BleepType : TBleepType);

Implementation

Uses
  Bleeper;

Procedure Bleep (BleepType : TBleepType);
Begin
  Case BleepType Of
    bOK : Begin
        DoBleep (1047, 100);
        DoBleep (1109, 100);
        DoBleep (1175, 100);
      End;
    bInterrupt : Begin
        DoBleep (2093, 100);
        DoBleep (1976, 100);
        DoBleep (1857, 100);
      End;
    bError : DoBleep (40, 500);
  End;
End;

End.

Hej !

Jeg kan bruge begge jeres koder men jeg vil nu helst bruge borrisholt for det virker i 2000 osv..

borrisholt kan du ikke lave det sådan at den looper ???

Så de looper ? Kunne du ikke specificere det lidt ?

Etv. noget pseudo kode ...
Jens B

Jeg tror bare at han mener en for- eller while-løkke.

f.eks.

var
  I: Integer;
begin
  for I := 0 to 10 do
    begin
      Beep(1000);
      sleep(100);
      beep(500);
      sleep(100);
    end;
end;


Håber det var det du mente

/SpEeDy

Det er nogle fede lyde den laver