procedure Delay(MSecs: Integer);
var
FirstTickCount : LongInt;
begin
FirstTickCount:=GetTickCount;
repeat
SleepEX(1, false);
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;
begin
DoSound(aFreq);
Delay(aDelay);
end;
procedure NoSound;
var
Value: Word;
begin
Value := GetPort($61) and $FC;
SetPort($61, Value);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Sound(500,100);
Sound(700,100);
Sound(900,100);
NoSound;
end;
Pro úplnost dodávám, že příklad by měl fungovat pod Windows 9x.
var
FirstTickCount : LongInt;
begin
FirstTickCount:=GetTickCount;
repeat
SleepEX(1, false);
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;
begin
DoSound(aFreq);
Delay(aDelay);
end;
procedure NoSound;
var
Value: Word;
begin
Value := GetPort($61) and $FC;
SetPort($61, Value);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Sound(500,100);
Sound(700,100);
Sound(900,100);
NoSound;
end;
Pro úplnost dodávám, že příklad by měl fungovat pod Windows 9x.
<< Home