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

В программе Rene Werner'а для проигрыванмя миди есть такой код

asm
  mov dx,StatusPort
  @1:
  in  al,dx
  and al,DRR
  jnz @1
  mov al,[b]
  dec dx    {DataPort = StatusPort - 1}
  out dx,al
end;
 
if il>=2 then begin {Event mit 2 oder 3 Bytes}
b:=bp^; { Byte holen }
 
(*
  while port[StatusPort] and DRR <> 0 do;
  port[Dataport] := bp^;
*)
 
asm
  mov dx,StatusPort
  @2:
  in  al,dx
  and al,DRR
  jnz @2
  mov al,[b]
  dec dx
  out dx,al
end;
 
inc(bp);
if il=3 then begin { 3. Byte ?? }
b:=bp^; { Byte holen }
 
(*
  while port[StatusPort] and DRR<>0 do;
  port[Dataport] := bp^;
*)
 
asm
  mov dx,StatusPort
  @2:
  in  al,dx
  and al,DRR
  jnz @2
  mov al,[b]
  dec dx
  out dx,al
end;
 
inc(bp);

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

Откуда взят код? Дай ссылку или прикрепи модуль.

Вот
Прикреплённый файлrw_mid.zip (16.6 Кбайт, скачиваний: 1265)

Цитата Ash @ 20.05.05, 18:10

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

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

1. работает только под ДОС
2. не на всех звуковухах
3. комментарии на немецком и документации нет

Если тебе необязательно звучание инструмента, а просто пищание PC-speaker, то вполне сойдёт Sound()

Кто чем может помогите. Нужно звук нормальный идать(PC-speaker не канает, fm тоже).

В DOS'е возможности звука и графики.. ну ОЧЕНЬ ограничены... Пробуй для Windows. Можно в Борланд Паскале 7.0 (16-битные приложения), хотя лучше взглянуть на Free Pascal (раздел 32-битные компиляторы). В особенности предлагаю библиотеку BASS.DLL. Полагаю, с ней легче разобраться, чем с ассемблером.
К тому же вывод звука с помощью DirectX.

Добавлено 22.05.05, 20:33
Вот код с применением библиотеки BASS:

program fpctest;
 
uses
   Crt,
   Windows,
   BassFPC;
 
var
   Stream      :  HStream;
   totallength :  integer;
 
const
   // Enter the name & path of an MP3 or other streamed music file here!
   MUSIC_FILE  =  'D:\MUSIC\test.mp3';
  
 
function    seconds_to_minutes (v: integer): string;
var
   temp1,temp2  :  string;
begin
   str(v div 60,temp1);
   str(v mod 60,temp2);
   if length(temp2) = 1 then temp2 := '0' + temp2;
   result := temp1 + ':' + temp2;  
end;
 
procedure   error(msg: string);
begin
   writeln(msg + '  (Error code: ',BASS_ErrorGetCode,')');
end;
 
procedure   init_stuff;
begin
   stream := 0;
 
   // Ensure BASS 2.0 was loaded
   if BASS_GetVersion() <> MAKELONG(2,1) then begin
     Error('BASS version 2.1 was not loaded!');
     Halt;
   end;
 
   // Initialize audio - default device, 44100hz, stereo, 16 bits
   if not BASS_Init(1, 44100, 0, 0, nil) then
     Error('Error initializing audio!');
end;
 
procedure   done_stuff;
begin
   // Free the stream
   if (stream <> 0) then
      BASS_StreamFree(stream);
 
   // Close BASS
   BASS_Free();
end;
 
procedure   load_song;
var
   p  :  PChar;
begin
   p := PChar(MUSIC_FILE);
   // Load the stream straight from a file.
   stream := BASS_StreamCreateFile(FALSE,p,0,0,0);
   if (stream = 0) then error('Error loading stream!');
end;
 
procedure   play_song;
begin
   // Play stream.
   if not BASS_ChannelPlay(stream, FALSE) then
     Error('Can''t play stream');
end;
 
procedure   stop_song;
begin
   BASS_ChannelStop(stream);
end;
 
 
begin
   clrscr;
   writeln('Welcome to the FPS BASS Test - by Paradice Software.');
   init_stuff;
   writeln('BASS Initialised successfully. ');
   writeln('Press any key to load file: ' + MUSIC_FILE);
   readkey;
   load_song;
   writeln('Song loaded successfully. press any key to play');
   readkey;
   totallength := round(BASS_ChannelBytes2Seconds(stream,BASS_StreamGetLength(stream)));
   play_song;
   writeln('Playing... press any key to stop!');
   repeat
      gotoxy(1,10);
      writeln('Playing: ' + seconds_to_minutes(round(BASS_ChannelBytes2Seconds(stream,BASS_ChannelGetPosition(stream)))) + ' of ' + seconds_to_minutes(totallength));
 
      // Bass plays in a separate thread, so we can sleep here to yield CPU.
      sleep(100);
   until keypressed;
   readkey;
   stop_song;
   clrscr;
   done_stuff;
   writeln('Done... exit');
end.

По-моему всё довольно наглядно и просто.

Сообщение отредактировано: Romtek - 22.05.05, 20:33

Нужно позарез в TP/BP.

Ash покешь мыло... закину...
Конеш прога не фонтан...
Когда-то выдрал демку из PREHISTORIC2... писал методом тыка...
Работает на SB совместимых (пробовал dos/win98)

А чёто он у меня молчит ни чё не издаёт?

Ash Ось DOS/WIN9X? Звукавуха sb совместимая? Базовый порт 220h?
Твой старый проигрыватель работает?

Пиши мне на мыло, [удалено модератором].

Можно обсуждать детали, но не в форме личной переписки!

Сообщение отредактировано: Romtek - 24.05.05, 08:08

Если звуковуха старая, можно попробовать программирование fm синтезатора.

[Модератор: Есть также теория по портам звуковой карты - в аттаче вместе с программой.]

ps 1,5 года назад я тоже хотел написать муз редактор для миди. Получилось только для ФМ. И то не доделано и не доведено до ума. Но надеюсь что возможно поможет.

Сообщение отредактировано: Romtek - 24.05.05, 15:35

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

Сорри, вроде не всё закачал.
Дубль 2:

ps Хорошо, Romtek. И документация тоже в zip

Сообщение отредактировано: @Hgpeu - 24.05.05, 15:39

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

Цитата hot_icer @ 24.05.05, 07:50

Ash Ось DOS/WIN9X? Звукавуха sb совместимая? Базовый порт 220h?
Твой старый проигрыватель работает?

Вот эта программа говорит: You have Sound Blaster Pro2

{$S-}
uses crt;
 
 
Const
 
   sbNamePrefix = 'Sound Blaster ';
 
   { Префикс имени модели для функции GetSBName }
 
 
Const
 
   svSB1       = $100;  { Sound Blaster 1.0/1.5 }    { 1.05??? }
 
   svSB2       = $200;  { Sound Blaster 2.0 }        { 2.01 }
 
   svSBPro     = $300;  { Sound Blaster Pro }        { ??? }
 
   svSBPro2    = $301;  { Sound Blaster Pro2 }       { 3.01, 3.02 }
 
   svSB16      = $400;  { Sound Blaster 16 }         { 4.04, 4.05 }
 
   svSB16SCSI2 = $40B;  { Sound Blaster 16 SCSI-2 }  { 4.11 }
 
   svSBAWE32   = $40C;  { Sound Blaster AWE32 }      { 4.12 }
 
   { Модели Sound Blaster'а, соответствующие версиям DSP (см. DSPVersion) }
 
 
Var sbBase     : Word;  { Базовый порт }
 
Var sbIRQ      : Byte;  { IRQ }
 
Var sbLDMA     : Byte;  { 8-битный канал DMA }
 
Var sbHDMA     : Byte;  { 16-битный канал DMA }
 
Var sbBaseMIDI : Word;  { Базовый порт MIDI }
 
Var sbModel    : Word;  { Модель Sound Blaster'а (см. константы smXXXX) }
 
Var DSPVersion : Word;  { Версия DSP Sound Blaster'а (см. константы svXXXX) }
 
{ Параметры Sound Blaster'а }
 
 
Procedure WriteToSB(N: Byte); assembler;
 
{ Записывает в порт Sound Blaster'а байт N (команду или данные) }
 
Asm
 
   mov dx,sbBase
 
   add dl,0Ch
 
 @:in al,dx
 
   or al,al
 
   js @
 
   mov al,N
 
   out dx,al
 
End;
 
 
Function ReadFromSB: Byte; assembler;
 
{ Читает байт из порта Sound Blaster'а }
 
Asm
 
   mov dx,sbBase
 
   add dl,0Eh
 
 @:in al,dx
 
   or al,al
 
   jns @
 
   sub dl,(0Eh-0Ah)
 
   in al,dx
 
End;
 
 
Function ResetDSP: Boolean; assembler;
 
{ Выполняет сброс процессора DSP и записывает номер версии в DSPVersion. }
 
{ Если  при  инициализации возникает ошибка (например, Sound Blaster уже }
 
{ используется  другой  программой и неверно указан номер базового порта }
 
{ sbBase), функция возвращает значение FALSE.                            }
 
Asm
 
   mov dx,sbBase
 
   add dl,6
 
   mov al,1
 
   out dx,al
 
   mov cx,1000h
 
   push cx
 
@1:loop @1
 
   dec ax
 
   out dx,al
 
   pop cx
 
   add dl,(0Eh-06h)
 
@2:in al,dx
 
   test al,80h
 
   loopz @2
 
   sub dl,(0Eh-0Ah)
 
   in al,dx
 
   cmp al,0AAh
 
   mov al,0
 
   jne @Error
 
   mov al,0E1h
 
   push ax
 
   call WriteToSB
 
   call ReadFromSB
 
   mov byte ptr DSPVersion[1],al
 
   call ReadFromSB
 
   mov byte ptr DSPVersion[0],al
 
   mov al,1
 
 @Error:
 
End;
 
 
Function DetectSBBase: Boolean; assembler;
 
{ Определяет  базовый  порт Sound Blaster'а. В случае неудачи возвращает }
 
{ значение  FALSE  и присваивает переменной sbBase значение $FFFF.       }
 
{ !!! Вызывает функцию ResetDSP.                                         }
 
Asm
 
   mov bx,210h
 
 @Test:
 
   mov sbBase,bx
 
   call ResetDSP
 
   or al,al
 
   jnz @Ok
 
 @:add bl,10h
 
   cmp bl,70h
 
   je @
 
   cmp bl,80h
 
   jbe @Test
 
   mov sbBase,0FFFFh
 
 @Ok:
 
End;
 
 
Function GetSBName: String;
 
{ Получить имя Sound Blaster'а ('1.x', '2.0', 'Pro' и т.д) по версии DSP }
 
Begin
 
   If DSPVersion >= svSBAWE32 then GetSBName := 'AWE32 or better'
 
   else If DSPVersion >= svSB16SCSI2 then GetSBName := '16 SCSI-2'
 
   else If DSPVersion >= svSB16 then GetSBName := '16'
 
   else If DSPVersion >= svSBPro2 then GetSBName := 'Pro2'
 
   else If DSPVersion >= svSBPro then GetSBName := 'Pro'
 
   else If DSPVersion >= svSB2 then GetSBName := '2.0'
 
   else If DSPVersion >= svSB1 then GetSBName := '1.x'
 
   else GetSBName := 'Unknown'
 
End;
 
 
Begin
 
  If not DetectSBBase then WriteLn('Error detecting SB base port!')
 
  else WriteLn('You have '+sbNamePrefix, GetSBName);
  Repeat until keypressed;
 
End.

Где можно посмотреть базовый порт?

Проигрыватель Wernera в ХР играет, в Win98 нет.

-юсртыхэю 24.05.05, 19:30

Цитата @Hgpeu @ 24.05.05, 14:05

Если звуковуха старая, можно попробовать программирование fm синтезатора.

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

Цитата

Где можно посмотреть базовый порт?

Свойства системы/Оборудование/Диспетчер устройств/Звуковуха/Ресурсы
Там диапазон ввода-вывода
Или что?

Ash твоя прога может определить порт, после

If not DetectSBBase then WriteLn('Error detecting SB base port!')
   else WriteLn('You have '+sbNamePrefix, GetSBName);

вставь строку

  WriteLn('Base port: ',sbBase);

В модуле midi.pas есть косяки (хотя у меня пахало)
асмеры меня с потрохами должны со жрать

  mov cx,6
  rep in al,dx
  ...........
  mov cx,28
  rep in al,dx

это не есть правильно! Замени на :

      mov cx,6
@ops: in   al,dx
      loop @ops
      ...........
      mov cx,28
@ops1: in   al,dx
      loop @ops1

В prehistoric'e были "in al,dx" в длинный столбик!

Сообщение отредактировано: hot_icer - 25.05.05, 06:20

В свойствах системы диапазон: E400 - E4FF;

Программа говорит: Base Port: 544;

В ассемблеровском коде сделал изменения, всё равно молчит.

Ash звук интегрированный? Попробуй старую Dos игруху с FM ... вероятно из DOSа
тебе до FM не добратся... Посмотри в виновозе настройку громкости FM, если там написано
типа "SW Syns" значит пи...пиликала гармошка. Тебе одноканальный орган на спикер пойдет?

Цитата

Ash звук интегрированный?

Да.

Цитата

Посмотри в виновозе настройку громкости FM, если там написано
типа "SW Syns" значит пи...пиликала гармошка.

Там написано програмнный синтезатор.
А FM(OPL2/OPL3) звукавуха не поддерживает.

Цитата

Тебе одноканальный орган на спикер пойдет?

Эт какой такой?

Ash
Значит FM только Виновозе... в DOS облом...

Одноканальный... эт когда играет одна нота в еденицу времени
(или проще: нельзя взять аккорд), т.е. прога очень проста...
На спикере проиграть несколько нот одновременно ну... немного проблематично
(хотя если выпендрится вполне возможно)
Тебе сильно позарез надо? Если не секрет, то куда?

Цитата

Одноканальный... эт когда играет одна нота в еденицу времени

Это то я понял.
Я не понял чё за орган. Эт ты про PC-Speaker, чтоли. Нее..

Так чё с миди, чё он молчит, не знаешь.

Цитата

Тебе сильно позарез надо? Если не секрет, то куда?

У меня курсовая, виртуальное пианино надо сделать.

Цитата Ash @ 26.05.05, 19:42

У меня курсовая, виртуальное пианино надо сделать.

Универсальных модулей, рассчитаных на разные звуковые карты, нет. Используй Sound() и забудь о всяких FM.

Несвижский В. - Программирование аппаратных средств в Windows
Издательство BHV
Отдельная глава посвящена программированию звуковых карт.
Вчера видел эту книгу в БиблиоГлобусе. 465 руб. Вроде не плохая книжка.

Ash с FM в TP/BP у тебя не получится(или звуковуху надыбай SB/Adlib совместимую)...
Раз у тебя прога находит базовый порт, то есть подозрения, что wav проиграть из паскаля
можно... Тогда делаешь несколько файлов с записями инструментов и принажатии клавиш
в реалтайм микшируешь и выводишь на звуковуху(чистый гемор)

Совет достань звуковуху...

А с midi чё?

Ash MIDI (или FM) у тебя программный под Win, т.е. в DOS через порты
тебе не дотянутся...

Вобщем либо звуковуху ставь... либо под Win пиши...

Цитата hot_icer @ 28.05.05, 09:17

Вобщем либо звуковуху ставь... либо под Win пиши...

Под вин на TP?

Сообщение отредактировано: Ash - 29.05.05, 16:59

Цитата Ash @ 29.05.05, 16:56

Под вин на TP?

Нет, можно только в BP7.
Неужели такие дикие ограничения в компиляторах? Free Pascal не подойдёт?

Цитата Romtek @ 29.05.05, 17:34

Неужели такие дикие ограничения в компиляторах? Free Pascal не подойдёт?

В том то и дело что ограничения дикие. Всё надо сделать в BP/TP.

Так кто нибудь подскажет как, звуки midi под винду спеть? Пожайлусто, очень надо.

Копай инфу в сторону MMsystem (в стандартной поставке Borland Pascal 7.0) и процедуры mciSendCommand, mciSendString

Вот пример для Дельфи (мною не проверялся):

uses  
  MMSystem;  
 
// Play Midi  
procedure Play;  
const  
  FileName = 'C:\YourFile.mid';  
begin  
  MCISendString(PChar('play ' + FileName), nil, 0, 0);  
end;  
 
// Stop Midi  
procedure Stop;  
const  
  FileName = 'C:\YourFile.mid';  
begin  
  MCISendString(PChar('stop ' + FileName), nil, 0, 0);  
end;

Вот ещё:

procedure TForm1.PlayClick(Sender: TObject);
const
  midi='D:\MUSIC\Midi\tp.mid';
begin
     mcisendstring(PChar('open '+midi+' type sequencer alias MIDIDemo'),0,0,Handle);
     mcisendstring('play MidiDemo FROM 0',0,0,Handle);
end;
 
procedure TForm1.StopClick(Sender: TObject);
begin
     mcisendstring('stop MidiDemo',0,0,0);
end;

С WinAPI, по идее, не должно быть проблем. Даже с Борланд Паскалем.

Сообщение отредактировано: Romtek - 29.05.05, 18:20

Оказалось, что можно и FPC использовать, кто что посоветует. Нужно звук издать при нажатии на клавишу.

Самое простое - это с применением WinAPI: mcisendstring (для WAV, MIDI).

Какой звук ты хочешь издавать ?

Добавлено 31.05.05, 10:37
Графика и мультимедиа->Работа со звуком

Добавлено 31.05.05, 10:52
Windows.Beep(Freq,Duration); для w2k, XP
Freq - частота
Duration - длительность

Добавлено 31.05.05, 10:52
Delphi: Multimedia

Добавлено 31.05.05, 10:53
Всё, что можно в Дельфи, можно сделать и в FPC.

А как можно сыграть определённую миди ноту, определённым инструментом?

Цитата Ash @ 31.05.05, 10:55

А как можно сыграть определённую миди ноту, определённым инструментом?

Этот вопрос лучше задать в разделе Программирование звука

Вот написал маленький пример для озвучивания MIDI:

uses CRT, Windows, MMSystem;
 
var
    midimsg: DWORD;
    hmidi_out: HMIDIOUT;
    hmidi_in:  HMIDIIN;
    err_cd: integer;
    Down:boolean;
    ch : char;
 
begin
     //открытие миди выхода
     err_cd:=midioutopen(@hmidi_out,1,0,0,0);
 
     writeln ('Нажмите пробел для произведения звука или Esc для выхода.');
     repeat
          ch := readkey;
          if ch = ' ' then
          begin
               midimsg:=$7f3a90; // поменять константу для других инструментов
               midioutshortmsg(hmidi_out,midimsg);
          end;
     until ch = #27;
end.

Добавлено 01.06.05, 14:39
Программа написана на для Free Pascal и тестирована в версии 2.0.0
Должна работать в любых 32-битных компиляторах Паскаля.

FPC 2.0.0
Пишет Error while linking
Указатель на последнем end'е.
Чё ему надо?

Бывает такое. Пробуй перезапустить IDE.

Перезапускаю, всё равно ошибка.

Добавлено 01.06.05, 17:30
А, всё. В опциях\линкер другие установочки зделал, всё пошло

Ноту меняю, громкость тоже, однако как инструмент менять не погимаю.

Ну так поиск для чего создан?
Гугл тебе в помощь, MSDN, ...

Всё, разобрался. Спасибо за помощь.

Если кому интересно:
http://www-camil.music.uiuc.edu/Classes/199E/MIDI/midimessages.html

Сообщение отредактировано: Ash - 01.06.05, 19:14

Покажи пример, мне тоже интересно

uses CRT, Windows, MMSystem;
 
var
    midimsg: DWORD;
    hmidi_out: HMIDIOUT;
    hmidi_in:  HMIDIIN;
    err_cd: integer;
    Down:boolean;
    ch : char;
 
begin
     //открытие миди выхода
     clrscr;
     err_cd:=midioutopen(@hmidi_out,0,0,0,0);
 
     writeln ('Нажмите пробел для произведения звука или Esc для выхода.');
     repeat
          ch := readkey;
          if ch = ' ' then
          begin
               midimsg:=$0023c0; // $с - установка инструмента($23=35 - Fretless Bass) channel=0
               midioutshortmsg(hmidi_out,midimsg);
               midimsg:=$903090; // $9 - проигрывание ноты $30(пока точно не знаю какая нота) channel=0
               midioutshortmsg(hmidi_out,midimsg);
               delay(1000);
               midimsg:=$903080; // $8 - выключение ноты channel=0
               midioutshortmsg(hmidi_out,midimsg);
          end;
     until ch = #27;
end.

Сообщение отредактировано: Ash - 01.06.05, 20:17

Ты наверно с константами плохо разобрался. Надо копать дальше.

Да нее... Всё понятно, а чё не понятного?

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

Добавлено 01.06.05, 20:24
Задание:
Составить пример для проигрывания нот любой октавы.

Можешь написать?

Добавлено 01.06.05, 20:39
Вот нашёл интересную функцию:

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;

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;

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

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

Цитата

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

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

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

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

Цитата

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

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

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

Добавлено 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
Частично содрана с другого исходника (Дельфи).

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

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"

Вот более-менее оформленный код. Все низкоуровневые функции находятся в модуле 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)

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

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

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

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

Цитата

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

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

Цитата

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

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

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