uses mmsystem; 
 
type 
  Bereich = 0..127; 
 
  Instrumente = (AcousticGrandPiano, BrightAcousticPiano, ElectricGrandPiano, 
    HonkyTonkPiano, RhodesPiano, ChorusedPiano, HarpsiChord, Clavinet, Celesta, 
    Glockenspiel, MusicBox, Vibraphone, Marimba, Xylophone, TubularBells, 
    Dulcimer, HammondOrgan, PercussiveOrgan, RockOrgan, ChurchOrgan, ReedOrgan, 
    Accordion, Harmonica, TangoAccordion, AcousticGuitar_Nylon, 
    AcousticGuitar_Steel, ElectricGuitar_Jazz, ElectricGuitar_Clean, 
    ElectricGuitar_Muted, OverdrivenGuitar, DistortionGuitar, GuitarHarmonics, 
    AcousticBass, ElectricBass_Finger, ElectricBass_Pick, FretlessBass, 
    SlapBass1, SlapBass2, SynthBass1, SynthBass2, Violin, Viola, Cello, 
    Contrabass, TremoloStrings, PizzicatoStrings, OrchestralHarp, Timpani, 
    StringEnsemble1, StringEnsemble2, SynthStrings1, SynthStrings2, ChoirAahs, 
    VoiceOohs, SynthVoice, OrchestraHit, Trumpet, Trombone, Tuba, MutedTrumpet, 
    FrenchHorn, BrassSection, SynthBrass1, SynthBrass2, SopranoSax, AltoSax, 
    TenorSax, BaritoneSax, Oboe, EnglishHorn, Bassoon, Clarinet, Piccolo, 
    Flute, Recorder, PanFlute, BottleBlow, Shakuhachi, Whistle, Ocarina); 
 
var 
  Midi: HMIDIOUT = 0; 
  mTon: Bereich; 
 
function OpenMidi: Boolean; 
begin 
  if Midi = 0 then 
    Result := 
      midiOutOpen(@Midi, MIDI_MAPPER, 0, 0, CALLBACK_NULL) = MMSYSERR_NOERROR 
  else Result := false; 
end; 
 
function CloseMidi: Boolean; 
begin 
  if Midi <> 0 then begin 
    midiOutReset(Midi); 
    Result := midiOutClose(Midi) = MMSYSERR_NOERROR; 
  end else Result := False; 
  Midi := 0 
end; 
 
procedure Aus; 
begin 
  if midiOutShortMsg(Midi, $80 or (mTon shl 8)) = MMSYSERR_NOERROR 
    then CloseMidi; 
end; 
 
function PlayTon 
  (Ton, Lautstrke: Bereich; Lang: Word; Was: Instrumente): Boolean; 
var 
  Zeit: Cardinal; 
begin 
  if not OpenMidi then begin 
    Result := false; 
    exit; 
  end; 
  mTon := Ton; 
  Result := midiOutShortMsg(Midi, 192 + 
    (integer(Instrumente(Was)) shl 8)) = MMSYSERR_NOERROR; 
  if Result then Result := midiOutShortMsg(Midi, ($90 or (Ton shl 8)) 
      or (Lautstrke shl 16)) = MMSYSERR_NOERROR; 
  Zeit := GettickCount + Lang; 
  repeat 
    application.processmessages; 
  until (GetTickCount >= Zeit) or (Application.Terminated) or not Result; 
  Aus; 
end; 
 
 
// Beispielaufruf 1 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  PlayTon(33, 127, 500, AcousticGrandPiano); 
  PlayTon(35, 127, 500, AcousticGrandPiano); 
  PlayTon(37, 127, 500, AcousticGrandPiano); 
  PlayTon(38, 127, 500, AcousticGrandPiano); 
  PlayTon(40, 127, 500, AcousticGrandPiano); 
  PlayTon(42, 127, 500, AcousticGrandPiano); 
  PlayTon(44, 127, 500, AcousticGrandPiano); 
  PlayTon(45, 127, 1250, AcousticGrandPiano); 
end; 
 
 
//Beispielaufruf 2 
 
var 
  Toene: array[0..12] of Bereich = 
  (51, 48, 48, 49, 46, 46, 44, 46, 48, 49, 51, 51, 51); 
  Dauer: array[0..12] of Word = 
  (500, 500, 960, 500, 500, 960, 500, 500, 500, 500, 500, 500, 910); 
 
 
procedure TForm1.Button2Click(Sender: TObject); 
var x: integer; 
begin 
  for x := 0 to high(Toene) do 
    if not PlayTon(Toene[x], 120, Dauer[x], AcousticGuitar_Steel) 
      then exit; 
end;