purebasic.info

PureBasic forum
Текущее время: Вт мар 19, 2019 9:14 am

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 34 ]  На страницу Пред.  1, 2, 3  След.
Автор Сообщение
СообщениеДобавлено: Пт янв 11, 2019 9:40 pm 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6503
Благодарил (а): 28 раз.
Поблагодарили: 211 раз.
Пункты репутации: 57
Gregory писал(а):
Сергейчик писал(а):
Kallback переводиться как перерезвоните
При таком написании переводится очень неприлично. :lol:

Да уж :lol:
Kallback

_________________
read-only ¯\_(ツ)_/¯


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Пт янв 11, 2019 11:05 pm 
Не в сети
док

Зарегистрирован: Чт окт 27, 2011 7:43 pm
Сообщений: 133
Откуда: Санкт-Ленинград
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
repeat писал(а):
MIDIin это MidiInProc
Тогда уж скорее midiInMessage.
Т.е. это тоже API-функции?
А почему у них тогда можно имена изменять, и без нижнего подчёркивания?
Что-то вместо понимания, наоборот отупение приходит. :lol:

_________________
ICQ нет, и, в ближайшее время, не будет


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб янв 12, 2019 12:22 am 
Не в сети
профессор

Зарегистрирован: Сб фев 06, 2016 6:18 pm
Сообщений: 291
Благодарил (а): 14 раз.
Поблагодарили: 33 раз.
Пункты репутации: 2
Gregory писал(а):
А почему у них тогда можно имена изменять, и без нижнего подчёркивания?
Потому, что это не Windows API а Procedure (PureBasic). А имена можно менять и в api:
Код:
1
2
3
4
5
6
7
8
9
Beep_(200, 300)
 
Delay(200)
 
Import "kernel32.lib"
  Test(dwFreq.l, dwDuration.l) As "_Beep@8"
EndImport
 
Test(200, 300)



Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб янв 12, 2019 1:41 pm 
Не в сети
док

Зарегистрирован: Чт окт 27, 2011 7:43 pm
Сообщений: 133
Откуда: Санкт-Ленинград
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
repeat писал(а):
Потому, что это не Windows API а Procedure (PureBasic)
Но выше же вроде обратное говорили (и ссылку давали). :roll:

_________________
ICQ нет, и, в ближайшее время, не будет


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб янв 12, 2019 7:54 pm 
Не в сети
профессор

Зарегистрирован: Сб фев 06, 2016 6:18 pm
Сообщений: 291
Благодарил (а): 14 раз.
Поблагодарили: 33 раз.
Пункты репутации: 2
Gregory писал(а):
Но выше же вроде обратное говорили (и ссылку давали). :roll:
Gregory писал(а):
запускает процедуру MIDIin
repeat писал(а):
MIDIin это MidiInProc а MidiInProc уже определена. вот
А в вот написано:
Цитата:
MidiInProc is a placeholder for the application-supplied function name.
:roll:


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб янв 12, 2019 9:35 pm 
Не в сети
док

Зарегистрирован: Чт окт 27, 2011 7:43 pm
Сообщений: 133
Откуда: Санкт-Ленинград
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
repeat писал(а):
MIDIin это MidiInProc
Ну, судя по параметрам, это - всё-таки midiInMessage.
Так и вот как понять, какую функцию использовать?
Или можно любую?

_________________
ICQ нет, и, в ближайшее время, не будет


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб янв 12, 2019 9:43 pm 
Не в сети
профессор

Зарегистрирован: Сб фев 06, 2016 6:18 pm
Сообщений: 291
Благодарил (а): 14 раз.
Поблагодарили: 33 раз.
Пункты репутации: 2
Gregory писал(а):
Или можно любую?
можно любую :)


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб янв 12, 2019 10:03 pm 
Не в сети
док

Зарегистрирован: Чт окт 27, 2011 7:43 pm
Сообщений: 133
Откуда: Санкт-Ленинград
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
repeat писал(а):
можно любую
Краткость, конечно, сестра кое-кого (или чего), но не настолько же. :lol:
"Любую" из чего?

_________________
ICQ нет, и, в ближайшее время, не будет


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вс янв 13, 2019 12:48 am 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11423
Благодарил (а): 4 раз.
Поблагодарили: 453 раз.
Callback это не WinAPI функция, а функция/процедура определенная в коде. Не зря же ее адрес нужно передать вызываемой функции, например midiInOpen, а раз так что имя у callback может быть любым. В данном случае функция вызывается не по имени, а по адресу.
Простой пример.
Код:
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
Procedure CB(Param1, Param2)
  Res = 0
 
  If Param2<=10
    Res = 1
    Debug Param2
  EndIf
 
  ProcedureReturn Res
EndProcedure
 
 
Procedure MyFunct(*AdrCB, Param)
  If *AdrCB
   
    x=Param
    Repeat
      If CallFunctionFast(*AdrCB, Param, x) = 0
        Break
      EndIf
      x+1
    ForEver
   
  EndIf
EndProcedure
 
 
MyFunct(@CB(), 2)

Представьте что функция MyFunct() это WinAPI функция и она находится где-то в системных DLL. Она ничего не знает об имени callback, а знает только ее адрес, число аргументов и что в них нужно передавать.

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вс янв 13, 2019 12:20 pm 
Не в сети
док

Зарегистрирован: Чт окт 27, 2011 7:43 pm
Сообщений: 133
Откуда: Санкт-Ленинград
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Пётр писал(а):
знает только ее адрес, число аргументов и что в них нужно передавать
Так вот с аргументами я и пытаюсь разобраться.
Если сведения об аргументах содержатся в самой API функции, то получается, что в роли Callback может выступать только одна единственная процедура (точнее определённый набор аргументов, при её описании).
Если же эти процедуры могут быть разными, то как функция определяет, какой надо использовать?

_________________
ICQ нет, и, в ближайшее время, не будет


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вс янв 13, 2019 12:32 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11423
Благодарил (а): 4 раз.
Поблагодарили: 453 раз.
Функции известен лишь адрес. Если у callback несоответствие аргументов, получим ошибку.
Код:
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
Procedure CB(Param1, Param2, Param3, Param4)
  Res = 0
 
  If Param2<=10
    Res = 1
    Debug Param2
  EndIf
 
  ProcedureReturn Res
EndProcedure
 
 
Procedure MyFunct(*AdrCB, Param)
  If *AdrCB
   
    x=Param
    Repeat
      If CallFunctionFast(*AdrCB, Param, x) = 0
        Break
      EndIf
      x+1
    ForEver
   
  EndIf
EndProcedure
 
 
MyFunct(@CB(), 2)


_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вс янв 13, 2019 1:16 pm 
Не в сети
док

Зарегистрирован: Чт окт 27, 2011 7:43 pm
Сообщений: 133
Откуда: Санкт-Ленинград
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Пётр писал(а):
Если у callback несоответствие аргументов, получим ошибку.
Ну, т.е. можно использовать только определённый набор аргументов.
По указанной выше ссылке сказано, что в качестве Callback для midiInOpen должна использоваться MidiInProc callback function, а в приведённом примере набор аргументов указывает на midiInMessage function, которая вроде как и callback function не является.
Где "собака порылась"?
Пример неправильный?
Но ошибки, вроде, не выдаёт... :roll:

_________________
ICQ нет, и, в ближайшее время, не будет


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вс янв 13, 2019 1:35 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11423
Благодарил (а): 4 раз.
Поблагодарили: 453 раз.
Gregory писал(а):
Ну, т.е. можно использовать только определённый набор аргументов.
В x86 при вызове типа stdcall аргументы передаются через стек и если их будет больше или меньше (и в некоторых случаях если не соответствует тип), содержимое стека сместится и например возврат из функции произойдет по неправильному адресу что приведет к ошибке.

Gregory писал(а):
По указанной выше ссылке сказано, что в качестве Callback для midiInOpen должна использоваться MidiInProc callback function, а в приведённом примере набор аргументов указывает на midiInMessage function
Чем указывает? В MidiInProc 5 аргументов, в midiInMessage 4 аргумента. Типы аргументов отличаются.

Gregory писал(а):
Но ошибки, вроде, не выдаёт
Код:
1
midiInOpen_(0, 0, @midiInMessage_(), 0, 0)

Точно нет ошибки?

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вс янв 13, 2019 7:17 pm 
Не в сети
док

Зарегистрирован: Чт окт 27, 2011 7:43 pm
Сообщений: 133
Откуда: Санкт-Ленинград
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Пётр писал(а):
Чем указывает? В MidiInProc 5 аргументов, в midiInMessage 4 аргумента. Типы аргументов отличаются.
Так вот процедура MIDIin как-раз имеет 4 аргумента с соответствующим типом.

Пётр писал(а):
Точно нет ошибки?
Имелось ввиду ошибки компиляции.
Поскольку нет входных миди-портов, функция возвращает не #MMSYSERR_NOERROR, с выдачей соответствующего окна.

_________________
ICQ нет, и, в ближайшее время, не будет


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вс янв 20, 2019 9:59 pm 
Не в сети
док

Зарегистрирован: Чт окт 27, 2011 7:43 pm
Сообщений: 133
Откуда: Санкт-Ленинград
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Вот, нашёл парочку примерчиков и проверил их на реальном МИДИ.
Оба требуют наличие входного МИДИ-порта (иначе не запустятся).
На СисЕксы (т.е. "длинные сообщения") проверить не было возможности.

Первый выводит полученные сообщения в окне.
Со всех каналов читает только 3-й байт в пакете, остальные только с первого канала:

Код:
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
EnableExplicit
;
Structure MIDIs
  MIDIIn.I
  MIDIOut.I
  Stat.A
  Dat1.A
  Dat2.A
  Ons.I[128] ; to keep Sounding Notes
  Chstep.S
EndStructure
;
Define Ev
Global _Midi.Midis,_TG,_TGOns,_Quit
Global _CHROMATIC$ = "C C#D EbE F F#G AbA BbB C "            ; mixed # b
;
Macro Mid2(Txt,Pos) :  PeekS(@Txt+Pos-1,2) :EndMacro
;
Macro MIDI2N(Nt) :  Mid2(_Chromatic$,Nt % 12*2+1):EndMacro;  MIDINote name
;
 
Enumeration 100 ; bei vielen Fenstern und Events den Wert 100 erhohen
  #Window_Selectbox
  #Text_Selectbox1
  #Text_Selectbox2
  #Listview_Selectbox1
  #Listview_Selectbox2
  #Button_Selectbox0
  #Button_Selectbox1
EndEnumeration
 
#Channel1 = 1
#Channel2 = 2
#Channel3 = 3
#Channel4 = 4
#Channel5 = 5
#Channel6 = 6
 
Procedure Selectrequester (Selectbox.s,Selecttext1.s,Selecttext2.s,List Mylist1.s(),List Mylist2.s())
 
Protected Return_Selectbox,Return_Selectbox1,Return_Selectbox2, Event, GadgetID,a
 
Return_Selectbox = -1 ; Fehlerwert = -1
 
If OpenWindow(#Window_Selectbox,0,0, 430, 178, Selectbox.s,  #PB_Window_SystemMenu | #PB_Window_TitleBar| #PB_Window_ScreenCentered)
  ;If CreateGadgetList(WindowID(#Window_Selectbox))
    TextGadget(#Text_Selectbox1, 10, 10, 150, 14, Selecttext1.s)
    TextGadget(#Text_Selectbox2, 220, 10, 150, 14, Selecttext2.s)
    ListViewGadget(#Listview_Selectbox1, 10, 30, 200, 100)
    ListViewGadget(#Listview_Selectbox2, 220, 30, 200, 100)
    ButtonGadget(#Button_Selectbox0, 270, 140, 70, 23, "Select")
    ButtonGadget(#Button_Selectbox1, 350, 140, 70, 23, "Cancel")
  ;EndIf
EndIf
 
FirstElement(Mylist1())
For a = 1 To  ListSize(Mylist1())
   AddGadgetItem (#Listview_Selectbox1, -1, Mylist1())   ; definieren des Listview-Inhalts
   NextElement(Mylist1())
Next
 
FirstElement(Mylist2())
For a = 1 To  ListSize(Mylist2())
   AddGadgetItem (#Listview_Selectbox2, -1, Mylist2())   ; definieren des Listview-Inhalts
   NextElement(Mylist2())
Next
 
SetGadgetState(#Listview_Selectbox1,0)
SetGadgetState(#Listview_Selectbox2,0)
 
Repeat ; Start of the event loop
 
  Event = WaitWindowEvent() ; This line waits until an event is received from Windows
  GadgetID = EventGadget() ; Is it a gadget event?
 
  If Event = #PB_Event_Gadget
    If GadgetID = #Button_Selectbox0
       Event = #PB_Event_CloseWindow
       Return_Selectbox1 = GetGadgetState(#Listview_Selectbox1)
       Return_Selectbox2 = GetGadgetState(#Listview_Selectbox2)
    ElseIf GadgetID = #Button_Selectbox1
       Event = #PB_Event_CloseWindow
    EndIf
  EndIf
Until Event = #PB_Event_CloseWindow ; End of the event loop
 
CloseWindow(#Window_Selectbox)
 
Return_Selectbox = Return_Selectbox1 + (Return_Selectbox2 << 8)
 
ProcedureReturn Return_Selectbox
 
EndProcedure
 
Procedure MidiOutMessage(hMidi,iStatus,iChannel,iData1,iData2)
  Protected dwMessage
  dwMessage = iStatus | iChannel | (iData1 << 8 ) | (iData2 << 16)
  ProcedureReturn midiOutShortMsg_(hMidi, dwMessage) ;
EndProcedure
 
Procedure SetInstrument(channel,instrument)
  MidiOutMessage(_Midi\MidiOUT, $C0,  channel, instrument, 0)
EndProcedure
 
Procedure PlayNote(channel,Note,velocity)
  MidiOutMessage(_Midi\MidiOUT, $90, channel, Note , velocity)
EndProcedure
 
 
Procedure StopNote(channel,Note)
  MidiOutMessage(_Midi\MidiOUT, $90, channel, Note , 0)
EndProcedure
 
Procedure SendMidi()
 
  Protected a
 
  SetInstrument(#Channel1,25)
  SetInstrument(#Channel2,25)
  SetInstrument(#Channel3,25)
  SetInstrument(#Channel4,25)
 
  For a = 1 To 5
    ; normal sound
    PlayNote(#Channel1,$2D,63)
    PlayNote(#Channel2,$39,63)
    PlayNote(#Channel3,$3C,63)
    PlayNote(#Channel4,$40,63)
   
    Delay (100)
    StopNote(#Channel1,$2D)
    StopNote(#Channel2,$39)
    StopNote(#Channel3,$3C)
    StopNote(#Channel3,$40)
   
    ; this must be a staccato sound
    PlayNote(#Channel1,$39,100)
    PlayNote(#Channel2,$3C,100)
    PlayNote(#Channel3,$40,100)
   
    Delay (30)
    StopNote(#Channel1,$39)
    StopNote(#Channel2,$3C)
    StopNote(#Channel3,$40)
    Delay (20)
   
    ; this must be a muted sound
    PlayNote(#Channel1,$2D,80)
    PlayNote(#Channel2,$30,80)
    PlayNote(#Channel3,$34,80)
   
    Delay (300)
    StopNote(#Channel1,$2D)
    StopNote(#Channel2,$30)
    StopNote(#Channel3,$34 )
    Delay (285)
   
  Next
 
  ; Zurucksetzen der Instrumente
  SetInstrument(#Channel1,0)
  SetInstrument(#Channel2,0)
  SetInstrument(#Channel3,0)
  SetInstrument(#Channel4,0)
 
EndProcedure
 
Procedure$ SBIN(N,Le=32)
  Protected var$
  var$ = RSet(Bin(N),Le,"0")
 
  If CountString(var$, "0") = Len(var$)
    var$=""
  EndIf
 
  ProcedureReturn var$
 
EndProcedure
;
Procedure$ GetOns() ; ret Notes Played From midiKbd
  Protected I,T$
  For I=0 To 127
    If _Midi\Ons[I]
      T$+Midi2N(I)
    EndIf
  Next
  ProcedureReturn T$
EndProcedure
;
Procedure$ Ons2Midiby()
  Protected I,T$
  For I=0 To 127
    If _Midi\Ons[I]
      T$+Chr(I)
    EndIf
  Next
  ProcedureReturn T$
EndProcedure
;
Procedure MIDIInFull(hMidiIn, Msg, Instance, Dat1, Dat2) ; get MIDINotes
  With _Midi
    Protected *Mem=@\Ons,A,B
    Select Msg  
      Case #MM_MIM_DATA
        Select Dat1 & $FF
          Case 144  
            \Stat=Dat1 >> 8     ;Note
            \Dat1=Dat1 >> 16    ;Velocity
            If \Dat1  :  SetGadgetText(_TG,"Note On "+Str(\Stat)+" : "+"Vel "+Str(\Dat1))
              \Ons[\Stat]=1
            Else      :  SetGadgetText(_TG,"Note Off "+Str(\Stat))
              \Ons[\Stat]=0
            EndIf
            SetGadgetText(_TGOns,Getons())
          Case 128
            \Stat=Dat1 >> 8     ;Note
            \Dat1=Dat1 >> 16    ;Velocity
            \Ons[\Stat]=0
            SetGadgetText(_TG,"Note Off "+Str(\Stat)+" : Vel "+Str(\Dat1))
            SetGadgetText(_TGOns,SBin(PeekI(*Mem+32),12)+Sbin(PeekI(*Mem),12))
          Default  
            ;\Stat=Dat1 >> 8     ;Note
            \Dat1=Dat1 >> 16    ;Velocity
            If \Dat1  :  SetGadgetText(_TG,"Controller "+Str(Dat1 & $FF)+": "+Str(\Dat1))
              \Ons[\Stat]=1
            EndIf
            SetGadgetText(_TGOns,Getons())
        EndSelect
    EndSelect
  EndWith
EndProcedure
;
Procedure MIDIinitFull(Instrument=0)
 
  Protected pointer.MidiInCaps,*pointer2.MidiInCaps, count_device, n, MidiIn_device, MidiOut_device,Return_Selectbox
 
  With _Midi
   
      NewList SelectList1.s()
     
      count_device = midiInGetNumDevs_() ; how Many Midi In device?
         
      For n = 1 To count_device
              midiInGetDevCaps_(n-1,pointer.MidiInCaps,SizeOf(MidiInCaps));
              AddElement(SelectList1())
              SelectList1() = PeekS(@pointer\szPname)
      Next
         
      NewList SelectList2.s()
     
      count_device = midiOutGetNumDevs_(); how Many Midi Out device?
         
      For n = 1 To count_device
              midiOutGetDevCaps_(n-1,pointer.MidiInCaps,SizeOf(MidiInCaps));
             
              AddElement(SelectList2())
              SelectList2() = PeekS(@pointer\szPname)
      Next
       
      Return_Selectbox = Selectrequester ("Please choose the Midi In/Out Device","Midi In Device","Midi Out Device",SelectList1(),SelectList2())
     
      MidiIn_device = Return_Selectbox & $F ; two informations with one return variable
      MidiOut_device = (Return_Selectbox & $FF00) >> 8
     
      ;If Midi_device = -1 :
      ;      MessageRequester("Error","No Midi In devices selected",0)
      ;      End
      ; EndIf
       
      If midiInOpen_(@\MidiIN, MidiIn_device, @MIDIInfull(), 0, #CALLBACK_FUNCTION) = #MMSYSERR_NOERROR
        If midiInStart_(\MidiIN) <> #MMSYSERR_NOERROR
          MessageRequester("Error","Can't start MIDI IN",0)
          End
        EndIf
      Else :  MessageRequester("Error","Can't open MIDI IN",0)
        End
      EndIf
     
      midiOutOpen_(@\MidiOUT, MidiOut_device, 0, 0, 0)
      midiOutShortMsg_(\MidiOUT, 192 | Instrument<<8 ) ; set instrument
      If \MidiIN And \MidiOUT
        If Not midiConnect_(\MidiIN, \MidiOUT, 0)
          SetGadgetText(_TG, "MIDI setting ready!  Play MIDI Keyboard")
        Else : MessageRequester("Error","Can't connect MIDI",0)
          End
        EndIf
      EndIf
     
     
;    Else
;      MessageRequester("Error","No Midi devices found",0)
;      End
;    EndIf
  EndWith
EndProcedure
 
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0,0,0,400,140,"MIDI IN/Out Checker (@)MPZ",#PB_Window_SystemMenu|1)
SetWindowColor(0,$22)
 
Define Wi=WindowWidth(0), He=WindowHeight(0)
_TG=TextGadget(-1,10,10,Wi-20,24,"")
_TGOns=TextGadget(-1,10,40,Wi-20,24,"")
 
Define TBVol=TrackBarGadget(-1,10,70,Wi-20,24,0,$Ffff)
SetGadgetState(Tbvol,$FFFF)
 
Define SendMID=ButtonGadget(-1, 10, 104, 200, 20, "Send Midi")
 
MIDIinitFull()
 
With _Midi
  midiOutSetVolume_(\MidiOUT,$FFFF)
  Repeat
    If GetAsyncKeyState_(27)&$8000 :_Quit=#True : EndIf
    Ev=WaitWindowEvent()
    If Ev=#PB_Event_Gadget
      Select EventGadget()
        Case TBVol    :  midiOutSetVolume_(\MidiOUT,GetGadgetState(Tbvol))
        Case SendMID  : SendMidi()
      EndSelect
    EndIf
  Until Ev=#PB_Event_CloseWindow Or _Quit
  midiDisconnect_(\MidiIN, \MidiOUT, 0)
  While midiInClose_(\MidiIN) = #MIDIERR_STILLPLAYING : Wend
  While midiOutClose_(\MidiOUT) = #MIDIERR_STILLPLAYING : Wend
  midiOutClose_(\MidiOUT)
EndWith




Второй выводит подробное инфо, но только в дебаге.

Код:
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
Procedure.l MIDIRequester(*OutDevice, *InDevice) 
  #MOD_WAVETABLE = 6
  #MOD_SWSYNTH = 7
  #MIDIRequ_InSet = 2
  #MIDIRequ_OutSet = 1
 
  #Width = 400
  If OpenWindow(0, 0, 0, #Width, 270, "MIDI-Requester", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    If CreateGadgetList(WindowID(0))
      #Column = (#Width - 20) / 2
      #Offset = (#Width / 2) + 5
 
      TextGadget(0, 5, 5, #Column, 18, "Output-Device:", #PB_Text_Center | #PB_Text_Border)
      ListViewGadget(2, 5, 23, #Column, 100)
        MaxOutDev.l = midiOutGetNumDevs_()
        InfoOut.MIDIOUTCAPS
        If MaxOutDev
          For a.l = -1 To MaxOutDev - 1
            midiOutGetDevCaps_(a, InfoOut, SizeOf(MIDIOUTCAPS))
            AddGadgetItem(2, -1, PeekS(@InfoOut\szPname[0], 32))
          Next
        Else
          AddGadgetItem(2, -1, "(no output device)")
          DisableGadget(2, 1)
        EndIf
 
      TextGadget(1, #Offset, 5, #Column, 18, "Input-Device:", #PB_Text_Center | #PB_Text_Border)
      ListViewGadget(3, #Offset, 23, #Column, 100)
        MaxInDev.l = midiInGetNumDevs_()
        InfoIn.MIDIINCAPS
        If MaxInDev
          For a.l = 0 To MaxInDev - 1
            midiInGetDevCaps_(a, InfoIn, SizeOf(MIDIINCAPS))
            AddGadgetItem(3, -1, PeekS(@InfoIn\szPname[0], 32))
          Next
        Else
          AddGadgetItem(3, -1, "(no input device)")
          DisableGadget(3, 1)
        EndIf
 
      ButtonGadget(4, 5, 240, #Column, 24, "&OK")
      ButtonGadget(5, #Offset, 240, #Column, 24, "&Cancel")
     
      Frame3DGadget(6, 5, 130, #Width - 10, 100, "Info of Output-Device", 0)
       TextGadget(7, 10, 145, #Width - 20, 18, "Version:")
       TextGadget(8, 10, 165, #Width - 20, 18, "Technology:")
       TextGadget(9, 10, 185, #Width - 20, 18, "Max. Voices:")
       TextGadget(10, 10, 205, #Width - 20, 18, "Polyphonie:")
     
      OutDev.l = 0
      InDev.l = 0
      Quit.l = #False
      OK.l = #False
      Repeat
        If GetGadgetState(2) > -1 Or GetGadgetState(3) > -1
          DisableGadget(4, 0)
        Else
          DisableGadget(4, 1)
        EndIf
       
        If InDev.l <> GetGadgetState(3)
          InDev.l = GetGadgetState(3)
        EndIf
 
        If GetGadgetState(2) <> OutDev
          OutDev.l = GetGadgetState(2)
          midiOutGetDevCaps_(OutDev - 1, InfoOut, SizeOf(MIDIOUTCAPS))
          SetGadgetText(7, "Version: " + Str(InfoOut\vDriverVersion >> 8) + "." + Str(InfoOut\vDriverVersion & FF))
          Select InfoOut\wTechnology
            Case #MOD_MIDIPORT :  TmpS.s = "Hardware Port"
            Case #MOD_SYNTH :     TmpS.s = "Synthesizer"
            Case #MOD_SQSYNTH :   TmpS.s = "Square Wave Synthesizer"
            Case #MOD_FMSYNTH :   TmpS.s = "FM Synthesizer"
            Case #MOD_MAPPER :    TmpS.s = "Microsoft MIDI Mapper"
            Case #MOD_WAVETABLE : TmpS.s = "Hardware Wavetable Synthesizer"
            Case #MOD_SWSYNTH :   TmpS.s = "Software Synthesizer"
            Default: TmpS.s = "(Error Code " + Str(InfoOut\wTechnology) + ")"
          EndSelect
          SetGadgetText(8, "Technology: " + TmpS)
          If InfoOut\wVoices = 0 : TmpS.s = "inf" : Else : TmpS.s = Str(InfoOut\wVoices) : EndIf
          SetGadgetText(9, "Max. Voices: " + TmpS)
          If InfoOut\wNotes = 0 : TmpS.s = "inf" : Else : TmpS.s = Str(InfoOut\wNotes) : EndIf
          SetGadgetText(10, "Polyphonie: " + TmpS)
        EndIf
       
        EventID.l = WaitWindowEvent()
        Select EventID
          Case #PB_Event_CloseWindow
            Quit = #True
            OK = #False
          Case #PB_Event_Gadget
            Select EventGadget()
              Case 4
                PokeL(*OutDevice, OutDev - 1)
                PokeL(*InDevice, InDev)
                Quit = #True
                OK = 3
                If (OutDev = -1 Or CountGadgetItems(2) = 0) And OK & #MIDIRequ_OutSet : OK ! #MIDIRequ_OutSet : EndIf
                If (InDev = -1 Or CountGadgetItems(3) = 0) And OK & #MIDIRequ_InSet : OK ! #MIDIRequ_InSet : EndIf
              Case 5
                Quit = #True
                OK = #False
            EndSelect
        EndSelect
      Until Quit
      CloseWindow(0)
      ProcedureReturn OK
    Else
      End
    EndIf
  Else
    End
  EndIf
EndProcedure
 
Structure MIDIData
  Channel.b
  Note.b
  Velocity.b
  Null.b
EndStructure
 
;Channel from 0 to 15
Procedure ProgramChange(Channel.b, Instr.b)
  Shared HandleOut
  Protected NoteDat.MIDIData
  NoteDat\Channel = $C0 + Channel
  NoteDat\Note = Instr
  If midiOutShortMsg_(HandleOut, PeekW(NoteDat)) = #MMSYSERR_NOERROR : Debug "Kanal gewechselt..." : EndIf
EndProcedure
Procedure NoteOn(Channel.b, Note.b, Velocity.b)
  Shared HandleOut
  Protected NoteDat.MIDIData
  NoteDat\Channel = $90 + Channel
  NoteDat\Note = Note
  NoteDat\Velocity = Velocity
  NoteDat\Null = #Null
  If midiOutShortMsg_(HandleOut, PeekL(NoteDat)) = #MMSYSERR_NOERROR : Debug "Ton gestartet..." : EndIf
EndProcedure
Procedure NoteOff(Channel.b, Note.b, Velocity.b)
  Shared HandleOut
  Protected NoteDat.MIDIData
  NoteDat\Channel = $80 + Channel
  NoteDat\Note = Note
  NoteDat\Velocity = Velocity
  NoteDat\Null = #Null
  midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure NoteOffAlternate(Channel.b, Note.b, Velocity.b)
  Shared HandleOut
  Protected NoteDat.MIDIData
  NoteDat\Channel = $90 + Channel
  NoteDat\Note = Note
  NoteDat\Velocity = 0
  NoteDat\Null = #Null
  midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure AllNotesOff(Channel.b)
  Shared HandleOut
  Protected NoteDat.MIDIData
  NoteDat\Channel = $B0 + Channel
  NoteDat\Note = $7B
  NoteDat\Velocity = 0
  NoteDat\Null = #Null
  midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure ChangeController(Channel.b, Controller.b, Value.b)
  Shared HandleOut
  Protected NoteDat.MIDIData
  NoteDat\Channel = $B0 + Channel
  NoteDat\Note = Controller
  NoteDat\Velocity = Value
  NoteDat\Null = #Null
  midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure ChannelPressure(Channel.b, Value.b)
  Shared HandleOut
  Protected NoteDat.MIDIData
  NoteDat\Channel = $D0 + Channel
  NoteDat\Note = Value
  NoteDat\Velocity = #Null
  NoteDat\Null = #Null
  midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure KeyAftertouch(Channel.b, Note.b, Value.b)
  Shared HandleOut
  Protected NoteDat.MIDIData
  NoteDat\Channel = $A0 + Channel
  NoteDat\Note = Note
  NoteDat\Velocity = Value
  NoteDat\Null = #Null
  midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
Procedure PitchWheel(Channel.b, Value.w)
  Shared HandleOut
  Protected NoteDat.MIDIData
  NoteDat\Channel = $E0 + Channel
  NoteDat\Null = #Null
  PokeW(@NoteDat\Note, Value)
  midiOutShortMsg_(HandleOut, PeekL(NoteDat))
EndProcedure
 
Global Dim Controller.s(127)
Procedure InitController()
  Protected a.l
  Restore ControllerNames
  For a = 0 To 127
    Read.s Controller(a)
  Next
EndProcedure
Procedure.s GetControllerName(Number.l)
  If Number >= 0 And Number <= 127
    ProcedureReturn RSet(Str(Number), 3, "0") + " " + Controller(Number)
  EndIf
EndProcedure
 
;- MAINPROGRAM
 
Procedure MidiInProc(hMidiIn.l, wMsg.l, dwInstance.l, dwParam1.l, dwParam2.l)
  Protected Status.l, OnOf.l, NoteNr.l, Velocity.l
 
 
  Select wMsg
    Case #MM_MIM_OPEN
      Debug "open"
   
    Case #MM_MIM_CLOSE
      Debug "close"
     
    Case #MM_MIM_DATA
      Status = dwParam1 & $FF
      If Status < $F0
        Select Status / 16
          Case $8
            Debug "Note On"
            Debug "  Kanal: " + Str(dwParam1 & $F)
            Debug "  Note: " + Str((dwParam1 >> 8) & $FF)
            Debug "  Velocity: " + Str((dwParam1 >> 16) & $FF)
          Case $9
            If dwParam1 & $FF0000
              Debug "Note On"
            Else
              Debug "Note Off"
            EndIf
            Debug "  Kanal: " + Str(dwParam1 & $F)
            Debug "  Note: " + Str((dwParam1 >> 8) & $FF)
            Debug "  Velocity: " + Str((dwParam1 >> 16) & $FF)
          Case $A
            Debug "Key Aftertouch"
            Debug "  Kanal: " + Str(dwParam1 & $F)
            Debug "  Note: " + Str((dwParam1 >> 8) & $FF)
            Debug "  Value: " + Str((dwParam1 >> 16) & $FF)
          Case $B
            Debug "Controller Change"
            Debug "  Kanal: " + Str(dwParam1 & $F)
            Debug "  Controller: " + GetControllerName((dwParam1 >> 8) & $FF)
            Debug "  Wert: " + Str((dwParam1 >> 16) & $FF)
          Case $C
            Debug "Program Change"
            Debug "  Kanal: " + Str(dwParam1 & $F)
            Debug "  Instrument: " + Str((dwParam1 >> 8 ) & $FF)
          Case $D
            Debug "Channel Pressure"
            Debug "  Kanal: " + Str(dwParam1 & $F)
            Debug "  Value: " + Str((dwParam1 >> 8) & $FF)
          Case $E
            Debug "Pitch Wheel"
            Debug "  Kanal: " + Str(dwParam1 & $F)
            Debug "  Value: " + Str((dwParam >> 16) & $FFFF)
          Default
            Debug Hex(Status)
        EndSelect
      EndIf
   
    Case #MM_MIM_LONGDATA
      Debug "Longdata: " + RSet(Hex(dwParam1), 2, "0") + RSet(Hex(dwParam2), 2, "0")
     
    Case #MM_MIM_ERROR
      Debug "Error: " + RSet(Hex(dwParam1), 2, "0") + RSet(Hex(dwParam2), 2, "0")
   
    Case #MM_MIM_LONGERROR
      Debug "LongError"
   
    Default
      Debug "???"
  EndSelect
EndProcedure
 
InitController()
 
OutDevice.l
InDevice.l
MIDIResult.l = MIDIRequester(@OutDevice, @InDevice)
 
If MIDIResult & #MIDIRequ_InSet
  hMidiIn.l
  If midiInOpen_(@hMidiIn, InDevice, @MidiInProc(), 0, #CALLBACK_FUNCTION) = #MMSYSERR_NOERROR
    Debug "OPEN: MidiIn"
    If midiInStart_(hMidiIn) = #MMSYSERR_NOERROR
      Debug "START: MidiIn"
    EndIf
  EndIf
EndIf
 
If MIDIResult & #MIDIRequ_OutSet
  hMidiOut.l
  If midiOutOpen_(@hMidiOut, OutDevice, 0, 0, 0) = 0
    Debug "OPEN: MidiOut"
  EndIf
EndIf
 
If hMidiIn And hMidiOut
  If midiConnect_(hMidiIn, hMidiOut, 0) = 0
 
  EndIf
EndIf
 
If OpenWindow(0, 0, 0, 400, 300, "WaitWindow", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  Repeat
    EventID.l = WaitWindowEvent()
  Until EventID = #PB_Event_CloseWindow
EndIf
 
midiDisconnect_(hMidiIn, hMidiOut, 0)
While midiInClose_(hMidiIn) = #MIDIERR_STILLPLAYING : Wend
While midiOutClose_(hMidiOut) = #MIDIERR_STILLPLAYING : Wend
 
DataSection
  ControllerNames:
    Data.s "Bank Select", "Modulation", "Breath Controller", "", "4 (0x04) Foot Controller"                   ;0 - 4
    Data.s "Portamento time", "Data Entry (MSB)", "Main Volume", "Balance", "", "Pan"                         ;5 - 10
    Data.s "Expression Controller", "Effect Control 1", "Effect Control 2", "", ""                            ;11 - 15
    Data.s "General-Purpose Controllers 1", "General-Purpose Controllers 2", "General-Purpose Controllers 3"  ;16 - 18
    Data.s "General-Purpose Controllers 4", "", "", "", "", "", "", "", "", "", "", "", ""                    ;19 - 31
    Data.s "LSB for Controller 0", "LSB for Controller 1", "LSB for Controller 2", "LSB for Controller 3"     ;32 - 35
    Data.s "LSB for Controller 4", "LSB for Controller 5", "LSB for Controller 6", "LSB for Controller 7"     ;36 - 39
    Data.s "LSB for Controller 8", "LSB for Controller 9", "LSB for Controller 10", "LSB for Controller 11"   ;40 - 43
    Data.s "LSB for Controller 12", "LSB for Controller 13", "LSB for Controller 14", "LSB for Controller 15" ;44 - 47
    Data.s "LSB for Controller 16", "LSB for Controller 17", "LSB for Controller 18", "LSB for Controller 19" ;48 - 51
    Data.s "LSB for Controller 20", "LSB for Controller 21", "LSB for Controller 22", "LSB for Controller 23" ;52 - 55
    Data.s "LSB for Controller 24", "LSB for Controller 25", "LSB for Controller 26", "LSB for Controller 27" ;56 - 59
    Data.s "LSB for Controller 28", "LSB for Controller 29", "LSB for Controller 30", "LSB for Controller 31" ;60 - 63
    Data.s "Damper pedal (sustain)", "Portamento", "Sostenuto", "Soft Pedal", "Legato Footswitch"             ;64 - 68
    Data.s "Hold 2", "Sound Controller 1 (Default: Timber Variation)"                                         ;69 - 70
    Data.s "Sound Controller 2 (Default: Timber/Harmonic Content)"                                            ;71 - 71
    Data.s "Sound Controller 3 (Default: Release time)", "Sound Controller 4 (Default: Attack time)"          ;72 - 73
    Data.s "Sound Controller 6", "Sound Controller 7", "Sound Controller 8", "Sound Controller 9"             ;74 - 77
    Data.s "Sound Controller 10", "", "General-Purpose Controllers 5", "General-Purpose Controllers 6"        ;78 - 81
    Data.s "General-Purpose Controllers 7", "General-Purpose Controllers 8", "Portamento Control"             ;82 - 84
    Data.s "", "", "", "", "", "", "Effects 1 Depth (formerly External Effects Depth)"                        ;85 - 91
    Data.s "Effects 2 Depth (formerly Tremolo Depth)", "Effects 3 Depth (formerly Chorus Depth)"              ;92 - 93
    Data.s "Effects 4 Depth (formerly Celeste Detune)", "Effects 5 Depth (formerly Phaser Depth)"             ;94 - 95
    Data.s "Data Increment", "Data Decrement", "Non-Registered Parameter Number (LSB)"                        ;96 - 98
    Data.s "Non-Registered Parameter Number (MSB)", "Registered Parameter Number (LSB)"                       ;99 - 100
    Data.s "Registered Parameter Number (MSB)", "", "", "", "", "", "", "", "", "", "", "", "", "", "", ""    ;101 - 116
    Data.s "", "", "", "", "Mode Messages", "Mode Messages", "Mode Messages", "Mode Messages"                 ;117 - 124
    Data.s "Mode Messages", "Mode Messages", "Mode Messages"                                                  ;125 - 127
EndDataSection


_________________
ICQ нет, и, в ближайшее время, не будет


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 34 ]  На страницу Пред.  1, 2, 3  След.

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: Google [Bot] и гости: 6


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB