Синтез Midi инструментов

[Ash]

repeat
          ch := readkey;
          if ch = ' ' then
          begin
               midimsg:=$0023c0; // установка инструмента
               midioutshortmsg(hmidi_out,midimsg);
               midimsg:=$903190; // до вкл.
               midioutshortmsg(hmidi_out,midimsg);
               delay(1000);
               midimsg:=$903180; // до выкл.
               midioutshortmsg(hmidi_out,midimsg);
               midimsg:=$903390; // ре
               midioutshortmsg(hmidi_out,midimsg);
               delay(1000);
               midimsg:=$903380; //
               midioutshortmsg(hmidi_out,midimsg);
               midimsg:=$903590; // ми
               midioutshortmsg(hmidi_out,midimsg);
               delay(1000);
               midimsg:=$903580; //
               midioutshortmsg(hmidi_out,midimsg);
               midimsg:=$903690; // фа
               midioutshortmsg(hmidi_out,midimsg);
               delay(1000);
               midimsg:=$903680; //
               midioutshortmsg(hmidi_out,midimsg);
               midimsg:=$903890; // соль
               midioutshortmsg(hmidi_out,midimsg);
               delay(1000);
               midimsg:=$903880; //
               midioutshortmsg(hmidi_out,midimsg);
               midimsg:=$904090; // ля
               midioutshortmsg(hmidi_out,midimsg);
               delay(1000);
               midimsg:=$904080; //
               midioutshortmsg(hmidi_out,midimsg);
               midimsg:=$904290; // си
               midioutshortmsg(hmidi_out,midimsg);
               delay(1000);
               midimsg:=$904280; //
               midioutshortmsg(hmidi_out,midimsg);
          end;
     until ch = #27;

До-мажор гамма

На счёт нот точно неуверен, может не те, но гамма на слух слышится.

Цитата

У меня к примеру не издаёт звуков твой пример

А твоя программка которую ты здесь за постил играет?

[Romtek]

Играет и моя 1-я и твоя гамма...
Но у меня слёзы наворячиваются при виде такого кода

Добавлено 01.06.05, 20:53
Почему не можешь значения в массив загнать и проходить по ним циклом?

[Ash]

Цитата

Но у меня слёзы наворячиваются при виде такого кода

Да что ты не плачь. Эт я на скоряк, скопировал вставил. Просто спать уж скоро, а время на обдумки кода тратить не хотелось, вот и всё.
Больше так не буду.

[Romtek]

Ладно, успокоил.
Если что появится интересное, выкладывай.

Добавлено 01.06.05, 21:31
Вот ещё одну программу наклёпал, играет мелодию "Baked Tostadas in Z Minor"

program Midi_Tostadas;
 
uses CRT, Windows, MMSystem;
 
const
  noteseq: array[0..59] of integer = (
    110, 69, 81, 110, 67, 79, 990,  69, 81, 220, -1, -1,
    110, 67, 79, 110, 65, 77, 110,  64, 76, 110, 62, 74,
    220, 61, 73, 440, 62, 74, 1980, -1, -1, 110, 57, 69,
    110, 55, 67, 990, 57, 69, 220,  -1, -1, 220, 52, 64,
    220, 53, 65, 220, 49, 61, 440,  50, 62, 1980, -1, -1 );
 
var
    midimsg: DWORD;
    hmidi_out: HMIDIOUT;
    CurrentNote,
    devID,
    err_cd: integer;
    ch : char;
 
 
function MidiOutMessage(hMidi:HMIDIOUT; iStatus, iChannel, iData1, iData2: integer): DWORD;
var
  dwMessage:DWORD;
begin
  dwMessage:= iStatus or iChannel or (iData1 shl 8) or (longint( iData2 shl 16)) ;
  result:= midiOutShortMsg (hMidi, dwMessage) ;
end;
 
begin
     devID:=1;
     //открытие миди выхода
     err_cd:=midioutopen(@hmidi_out,devID,0,0,CALLBACK_NULL);
 
     writeln ('Нажмите пробел для воспроизведения звука или Esc для выхода.');
     writeln ('Baked Tostadas in Z Minor');
     repeat
          ch := readkey;
          if ch = ' ' then
          begin
               MidiOutMessage (hmidi_out, $C0, 0, 19, 0) ;
               MidiOutMessage (hmidi_out, $C0, 12, 19, 0) ;
 
               for CurrentNote := 0 to 59 do
               begin
                 // $80 - MIDI Note On
                 // $90 - MIDI Note Off
                 MidiOutMessage (hmidi_out, $80, 0, NoteSeq[CurrentNote], 0);
                 MidiOutMessage (hmidi_out, $80, 12, NoteSeq[CurrentNote], 0);
                 MidiOutMessage (hmidi_out, $90, 0, NoteSeq[CurrentNote], 127);
                 MidiOutMessage (hmidi_out, $90, 12, NoteSeq[CurrentNote], 127);
                 sleep (100);
               end;
          end;
     until ch = #27;
     err_cd:=midioutclose(hmidi_out);
end.

Добавлено 01.06.05, 21:32
Частично содрана с другого исходника (Дельфи).

[Romtek]

А вот какой-то миди-модуль с польскими именами, надеюсь, поможет.

unit MIDIDeviceUnit;
 
interface
 
Uses Windows, Messages, Classes, MMsystem;
 
type TTablicaBrzmien = array [0..127] of string;
     TTablicaDzwiekow = array [0..11] of string[2];
 
TMIDIDevice = class(TObject)
private
        hMidiOut : PHMIDIOUT;
        function MidiOutMessage(iStatus:integer;
                        iChannel:integer; iData1:integer;
                        iData2:integer):Word;
 public
        constructor Create;
        destructor Destroy;
 
        function ProgramName(ProgramValue:byte):string;
        function NoteName(Note:byte):string;
 
        function MIDINoteOff
                 (Channel:byte; KeyNumber:byte; Velocity:byte):boolean;
        function MIDINoteOn
                 (Channel:byte; KeyNumber:byte; Velocity:byte):boolean;
        function MIDIPolyphonicAfterTouch
                 (Channel:byte; KeyNumber:byte; AfterTouch:byte):boolean;
        function MIDIControlChange
                 (Channel:byte; Controler:byte; Value:byte):boolean;
        function MIDIChannelModeLocalControl
                 (Channel:byte; zalacz:boolean):boolean;
        function MIDIAllNotesOff(Channel:byte):boolean;
        function MIDIOmniModeOff(Channel:byte):boolean;
        function MIDIOmniModeOn(Channel:byte):boolean;
        function MIDIMonoModeOn(Channel:byte):boolean;
        function MIDIPolyModeOn(Channel:byte):boolean;
        function MIDIChannelAfterTouch(Channel:byte;AfterTouch:byte):boolean;
 
        function MIDIProgramChange
                 (Channel:byte; ProgramValue:byte):boolean;
        function MIDIPitchWheelChange
                 (Channel:byte; LowValue:byte; HighValue:byte):boolean;
  end;
  
implementation
const TablicaBrzmien : TTablicaBrzmien =
      ('Piano','Brite Piano','Hammer Piano','Honkey Tonk',
       'New Tines','Digi Pioano','Harpsicord','Clav','Celesta','Glocken','Music Box','Vibes',
       'Marimba','Xylophon','Tabular','Santur','Full Organ','Perc Organ','BX-3 Organ','ChurchPipe',
       'Positive','Musette','Harmonica','Tango','Clscic Guitar','Acoustic Guitar','Jazz guitar','Clean Guitar',
       'Mute Guitar','Over Drive','Dist Guitar','Rock Monics','Jazz Bass','Deep Bass','Pick Bass','Fretless','Slap Bass 1',
       'Slap Bass 2','Synth Bass 1','Synth Bass 2','Violin','Viola','Cello','ContraBass','Termolo Strings','Pizzicato',
       'Harp','Timpani','Marcato','Slow String','AnalogPad','String Pad','Choir','Doo Voice',
       'Voices','Orch Hit','Trumpet','Trombone','Tuba','Muted Trumpet','French Horn','Brass',
       'SynBrass 1','SynBrass 2','Soprano Sax','Alto Sax','Tenor Sax','Bari Sax','Sweet Oboe','English Horn',
       'Basoon Oboe','Clarinet','Piccolo','Flute','Recorder','Pan Flute','Bottle','Shakuhachi','Whistle','Ocaiona','Square Wave','Saw Wave',
       'Syn Caliope','Syn Choff','Charang','Air Chorus','Rezzo4th','Bass&Lead','Fantasia','Warm Pad',
       'Poly Pad','Ghost Pad','Bowed Glass','Metal Pad','Halo Pad','Sweep','Ice Rain','Sound Track','Crystal',
       'Atmosphere','Brightness','Goblin','Echp Drop','Star Theme','Sitar','Banjo','Shamisen',
       'Koto','Kalimba','Scotland','Fiddle','Shanai','Metal Bell','Agogo','Steel Drums',
       'Woodblock','Taiko','Tom','Synth Tom','Rev Cymbal','Fret Noise','Noise Chiff','Seashore',
       'Birds','Telephone','Helicopter','Stadium!!','Gun Shot');
 
       TablicaDzwiekow : TTablicaDzwiekow =
       ('c','c#','d','d#','e','f','f#','g','g#','a','a#','h');
 
constructor TMIDIDevice.Create;
begin
  new(hMidiOut);
  if MidiOutOpen(hMidiOut, MIDI_MAPPER, 0, 0, 0)<>0 then
          hMidiOut:=NIL;
  inherited Create;
end;
 
destructor TMIDIDevice.Destroy;
begin
  dispose(hMidiOut);
  inherited Destroy;
end;
 
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDINoteOff
         (Channel:byte; KeyNumber:byte; Velocity:byte):boolean;
begin
MidiOutMessage($80, Channel, KeyNumber, Velocity);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDINoteOn
         (Channel:byte; KeyNumber:byte; Velocity:byte):boolean;
begin
MidiOutMessage($90, Channel, KeyNumber, Velocity);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIPolyphonicAfterTouch
         (Channel:byte; KeyNumber:byte; AfterTouch:byte):boolean;
begin
MidiOutMessage($A00, Channel, KeyNumber, AfterTouch);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIControlChange
         (Channel:byte; Controler:byte; Value:byte):boolean;
begin
MidiOutMessage($B0, Channel, Controler, Value);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIChannelModeLocalControl
         (Channel:byte; zalacz:boolean):boolean;
var wartosc: byte;
begin
if zalacz = true then wartosc:=127 else wartosc:=0;
MidiOutMessage($B0, Channel, $7A, wartosc);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIAllNotesOff(Channel:byte):boolean;
begin
MidiOutMessage($B0, Channel, $7B, 00);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIOmniModeOff(Channel:byte):boolean;
begin
MidiOutMessage($B0, Channel, $7C, 00);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIOmniModeOn(Channel:byte):boolean;
begin
MidiOutMessage($B0, Channel, $7D, 00);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIMonoModeOn(Channel:byte):boolean;
begin
MidiOutMessage($B0, Channel, $7E, 1);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIPolyModeOn(Channel:byte):boolean;
begin
MidiOutMessage($B0, Channel,$7F, 01);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIProgramChange
         (Channel:byte; ProgramValue:byte):boolean;
begin
     MidiOutMessage($C0, Channel, ProgramValue, 0);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIPitchWheelChange
         (Channel:byte; LowValue:byte; HighValue:byte):boolean;
begin
     MidiOutMessage($E0, Channel, LowValue, HighValue);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.MidiOutMessage(iStatus:integer;
                                    iChannel:integer; iData1:integer;
                                    iData2:integer):Word;
var dwMessage : LongInt;
begin
dwMessage:=(iStatus) or (iChannel) or (iData1 shl 8) or (iData2 shl 16);
result:=midiOutShortMsg(hMidiOut^,dwMessage);
end;
//------------------------------------------------------------------------------
function TMIDIDevice.MIDIChannelAfterTouch(Channel:byte;AfterTouch:byte):boolean;
begin
MidiOutMessage($D0, Channel, AfterTouch, 00);
end;
 
//------------------------------------------------------------------------------
function TMIDIDevice.ProgramName(ProgramValue:byte):string;
begin
result:=TablicaBrzmien[ProgramValue];
end;
 
function TMIDIDevice.NoteName(Note:byte):string;
begin
result:=TablicaDzwiekow[Note-((Note div 12)*12)]+', octave: ' + IntToStr(Note div 12);
if Note = 60 then result := '* ' + result;
end;
 
end.

Сообщения были разделены в тему "FPC, Error while linking"

[Romtek]

Вот более-менее оформленный код. Все низкоуровневые функции находятся в модуле MIDIDeviceUnit.

program Midi_Gamma;
 
uses CRT, Windows, MMSystem, MIDIDeviceUnit;
 
const
    // Массив нот
    noteseq: array[1..7] of integer = (
     $31, $33, $35, $36, $38, $3A, $3C
    );
 
var
    MidiOut: TMIDIDevice;
    devID,
    CurrentNote: integer;
    ch : char;
 
begin
     MidiOut := TMIDIDevice.Create;
     devID := 1;
     { номер миди-устройства, или MIDI_MAPPER - использует MIDI по умолчанию }
 
     try
          MidiOut.OpenMidi (devID);
 
          writeln ('Press space for playing piano...');
 
          MidiOut.MIDIProgramChange (0, 0); // установка инструмента
          repeat
               ch := readkey;
               if ch = ' ' then
               with MidiOut do
               for CurrentNote := 1 to 7 do
               begin
                    MIDINoteOn (0, NoteSeq[CurrentNote], $90); // включение ноты
                    sleep (300); // 300 msec задержка
                    MIDINoteOff (0, NoteSeq[CurrentNote], $90); // выключение ноты
               end;
          until ch = #27;
     finally
       // освобождать класс, даже при ошибках.
       MidiOut.Destroy;
     end;
end.

Прикреплённый файлMidi_Gamma.zip (3 Кбайт, скачиваний: 948)

[Ash]

я вот годик назад курсовую написал, всё никак выложить не хватало время. А всё благодаря этой теме
Вот помотрите кому не лень. курсовая не много массивная получилась, но ни чё зато на пять.

вот ссылочка, если не лень зацените: http://rapidshare.de/files/22820516/kurs.rar.html

[Romtek]

Музредактор вполне зачётный получился. Но у нас принято исходниками делиться. Как тебе помогли, так и ты можешь помочь этими исходниками.

Кстати, .ехе я обработал утилитой strip и она сбросила вес файла до 473 кб вместо предыдущих 1.8 Мб. Чувствуешь разницу?
А если ужать ещё UPX!, то вообще небольшая по размеру будет...

[Ash]

Цитата

Но у нас принято исходниками делиться.

Да мне не жалко, вот держите.

Цитата

Кстати, .ехе я обработал утилитой strip и она сбросила вес файла до 473 кб вместо предыдущих 1.8 Мб. Чувствуешь разницу?А если ужать ещё UPX!, то вообще небольшая по размеру будет...

Круто...!!! Что это раньше я не воспользовался этим
Прикреплённый файлKurs1.rar (21.5 Кбайт, скачиваний: 1059)

[SeregaZ]

у меня вопрос по midi - а внешний файл нельзя подключать в качестве инструмента? я так понимаю всего 127 этих инструментов... вот можно как-то использовать внешний файл?