FAQ DelphiConsultez toutes les FAQ

Windows.Beep(440, 100)

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
{ Fonction d'émission d'un son sur le haut-parleur interne. } 
{ Hz est la fréquence du son } 
procedure Sound(Hz : Integer);Pascal; 
Asm 
  CMP  Hz,0 
  JZ   @FIN 
  MOV  AL,182 
  OUT  $43,AL 
  IN   AL,$61 
  OR   AL,3 
  OUT  $61,AL 
  MOV  EAX,1193180 
  XOR  EDX,EDX 
  DIV  Hz 
  OUT  $42,AL 
  XCHG AL,AH 
  OUT  $42,AL 
@FIN: 
End; 
  
{ Fonction d'arrêt du son sur le haut-parleur interne. } 
procedure NoSound; 
Asm 
  MOV  AL,182 
  OUT  $43,AL 
  IN   AL,$61 
  AND   AL,3 
  OUT  $61,AL 
End;

1
2
3
Sound(440); 
Sleep(100); 
NoSound;

PlaySound(pszSound: PChar; hmod: HMODULE; fdwSound: DWORD): BOOL; stdcall;

PlaySound('c:\windows\media\ding.wav',0,SND_FILENAME);

PlaySound('NomRessource',GetModuleHandle(Nil),SND_RESOURCE);

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
uses 
  MMSystem; 
  
type 
  TVolumeLevel = 0..127; 
  
procedure MakeSound(Frequency{Hz}, Duration{mSec}: Integer; Volume: TVolumeLevel); 
var 
  WaveFormatEx: TWaveFormatEx; 
  MS: TMemoryStream; 
  i, TempInt, DataCount, RiffCount: integer; 
  SoundValue: byte; 
  w: double; // omega=2*pi*fréquence 
const 
  Mono: Word = $0001; //Son Mono 
  SampleRate: Integer = 11025; // autres taux d'échantillonnage possibles 8000, 11025, 22050, or 44100 
  
  //Champs de l'en-tête d'un fichier .WAV 
  RiffId: string = 'RIFF'; 
  WaveId: string = 'WAVE'; 
  FmtId: string = 'fmt '; 
  DataId: string = 'data'; 
begin 
  //si la fréquence de la note est trop élevée par rapport au taux d'échantillonnage 
  if Frequency > (0.6 * SampleRate) then 
  begin 
    //... on considère que la note sera injouable. 
    ShowMessage(Format('Un taux d''échantillonage de %d est trop bas pour jouer une tonalité de %dHz', 
      [SampleRate, Frequency])); 
    Exit; 
  end; 
  
  with WaveFormatEx do 
  begin 
   //Paramètres d'un en-tête de fichier WAV au format PCM 
    wFormatTag := WAVE_FORMAT_PCM; 
    nChannels := Mono; 
    nSamplesPerSec := SampleRate; 
    wBitsPerSample := $0008; 
    nBlockAlign := (nChannels * wBitsPerSample) div 8; 
    nAvgBytesPerSec := nSamplesPerSec * nBlockAlign; 
    cbSize := 0; 
  end; 
  
  MS := TMemoryStream.Create; 
  with MS do 
  begin 
    //Calcule la longueur des données du son à jouer et celle du fichier WAV qui en découle 
    DataCount := (Duration * SampleRate) div 1000; // sound data 
    RiffCount := Length(WaveId) + Length(FmtId) + SizeOf(DWORD) + 
      SizeOf(TWaveFormatEx) + Length(DataId) + SizeOf(DWORD) + DataCount; // données du fichier 
    //écriture de l'en-tête du fichier WAV dans le flux mémoire 
    Write(RiffId[1], 4); // 'RIFF' 
    Write(RiffCount, SizeOf(DWORD)); // taille du fichier 
    Write(WaveId[1], Length(WaveId)); // 'WAVE' 
    Write(FmtId[1], Length(FmtId)); // 'fmt ' 
    TempInt := SizeOf(TWaveFormatEx); 
    Write(TempInt, SizeOf(DWORD)); // taille de TWaveFormat 
    Write(WaveFormatEx, SizeOf(TWaveFormatEx)); // taille d'un enregistrement WaveFormatEx 
    Write(DataId[1], Length(DataId)); // 'data' 
    Write(DataCount, SizeOf(DWORD)); // taille des données du son 
    //calcule et écrit le signal sonore 
    // calcul des valeurs qui composent le son,  
    // c'est une courbe sinusoïdale dont les valeurs sont comprises entre 0 et 255,  
    //donc l'axe médian de la sinusoïde est en y=127) 
    w := 2 * Pi * Frequency; // omega 
    for i := 0 to DataCount - 1 do 
    begin 
      SoundValue := 127 + trunc(Volume * sin(i * w / SampleRate));  // explication : wt = w * i / SampleRate 
     //on écrit notre "point" de la courbe dans notre fichier WAV 
      Write(SoundValue, SizeOf(Byte)); 
    end; 
    //Maintenant on joue le son en disant à Windows : 
    //-SND_MEMORY : c'est un son écrit dans un flux mémoire 
    //-SND_SYNC : de jouer le son de façon synchrone (tant que le son n'est pas terminé, le code ne se déroule plus. 
	// Ainsi, un deuxième appel consécutif à notre procédure ne "coupera pas le sifflet" du premier appel. 
    sndPlaySound(MS.Memory, SND_MEMORY or SND_SYNC); 
    MS.Free; 
  end; 
end;

1
2
3
4
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  MakeSound(440, 1000, 60); 
end;

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
Unit Unit1; 
Interface 
Uses Windows, Messages, SysUtils, Variants, Classes, Graphics, 
     Controls, Forms, Dialogs, ExtCtrls, mmSystem, StdCtrls; 
   {mmSystem vous permet d'avoir accès aux fonctions de contrôle midi} 
{----------------------------------------------------------------} 
Type 
  TForm1 = Class(TForm) 
    Button1: TButton; 
    Edit1: TEdit; 
    Procedure FormCreate(Sender: TObject); 
    Procedure FormDestroy(Sender: TObject); 
    Procedure Button1MouseDown(Sender: TObject; 
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
    Procedure Button1MouseUp(Sender: TObject; 
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
  End; 
    const 
   Hpc=$100; Hpdm=$10000; 
  
Var Form1: TForm1; 
  MidiOut: hMidiOut; 
  
Implementation 
{----------------------------------------------------------------} 
{$R *.dfm} 
  
  
{----------------------------------------------------------------} 
Procedure TForm1.FormCreate(Sender: TObject); 
Var Res: DWORD; msg: String; 
Begin 
  Res := midiOutOpen(@MidiOut, MIDI_MAPPER, Handle, 0, CALLBACK_WINDOW); 
  
//La partie qui est çi-dessous peut être omise. Mais vous donneras des indications en cas d'erreur 
  If Res <> 0 Then Begin 
    Case Res Of 
      MMSYSERR_BADDEVICEID: msg := 'Device invalide'; 
      MMSYSERR_ALLOCATED: msg := 'Erreur d''allocation mémoire'; 
      MMSYSERR_NOMEM: msg := 'Pas assez de mémoire'; 
      MIDIERR_NOMAP: msg := 'Midi mapper non trouvé'; 
      MIDIERR_NODEVICE: msg := 'Device non trouvé'; 
    Else msg := 'Erreur inconnue'; 
    End; 
    MessageBox(Form1.Handle, pChar(msg), 'Error', MB_OK); 
    Close; 
  End; 
//------------------------------------------------------------------------------------------------- 
  
End; 
  
  
{La procédure çi dessous vous permet d'arrêter tout événement midi à la sortie du programme} 
{rien ne vous empêche de vous faire un petit boutton “Panic” dans le programme à partir de ça, au cas ou un noteOff n'aie pas été détécté}   
Procedure TForm1.FormDestroy(Sender: TObject); 
Begin 
  midiOutShortMsg(MidiOut, $00007BB0); 
  midiOutClose(MidiOut); 
End; 
  
{----------------------------------------------------------------} 
Procedure TForm1.Button1MouseDown(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
  
Begin 
  midiOutShortMsg(MidiOut, ($7F*Hpdm)+($25*Hpc)+($99)); 
End; 
  
{----------------------------------------------------------------} 
Procedure TForm1.Button1MouseUp(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
Begin 
  midiOutShortMsg(MidiOut, ($7F*Hpdm)+($25*Hpc)+($89)); 
   end; 
  
{----------------------------------------------------------------} 
End.

 midiOutShortMsg(MidiOut, ($7F*Hpdm)+($25*Hpc)+($99));

 midiOutShortMsg(MidiOut, ($7F*Hpdm)+(Note*Hpc)+($80));

 midiOutShortMsg(MidiOut, ($7F*$10000)+(Note*$100)+($80));

 midiOutShortMsg(MidiOut, (Volume*$10000)+(Note*$100)+(8*$10)+Canal));