purebasic.info

PureBasic forum
Текущее время: Вт июл 07, 2020 11:22 am

Сообщения без ответов | Активные темы


Список форумов » PureBasic Windows » программирование на Purebasic для новичков

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




Начать новую тему Ответить на тему  Страница 3 из 3
  [ Сообщений: 43 ]  На страницу Пред.  1, 2, 3
  Для печати Предыдущая тема | Следующая тема 
Автор Сообщение
alexvolk
 Заголовок сообщения:
СообщениеДобавлено: Вт июн 17, 2008 11:21 pm 
Не в сети
доцент

Зарегистрирован: Пт июн 13, 2008 10:31 pm
Сообщений: 33
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Подскажите пожалуйста как в отдельную переменную записать текущие значение милисекунд?
Вернуться наверх
 Профиль  
 
kvitaliy
 Заголовок сообщения:
СообщениеДобавлено: Ср июн 18, 2008 4:52 am 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6647
Благодарил (а): 36 раз.
Поблагодарили: 234 раз.
Пункты репутации: 65
Код:
1
Tmr = GetTickCount_()
Вернуться наверх
 Профиль  
 
alexvolk
 Заголовок сообщения:
СообщениеДобавлено: Вс авг 03, 2008 11:30 pm 
Не в сети
доцент

Зарегистрирован: Пт июн 13, 2008 10:31 pm
Сообщений: 33
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Ещё вопрос.
При помощи вот этого
CallFunction(0,"SetTimer",WindowID(0), 1, 1, @s4et() )
можно обращаться к процедуре s4et раз в миллисекунду.
А как можно обращаться к процедуре чаще чем один раз в миллисекунду?
Вернуться наверх
 Профиль  
 
AsterDevil
 Заголовок сообщения:
СообщениеДобавлено: Пт авг 08, 2008 11:23 am 
Не в сети
док
Аватар пользователя

Зарегистрирован: Ср авг 15, 2007 1:23 pm
Сообщений: 138
Откуда: с почты
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
А зачем, позвольте полюбопытствовать?

_________________
Не грешите на погрешности перевода, если они сделаны, чего греха таить, дабы не погрешить против истины!
Вернуться наверх
 Профиль  
 
alexvolk
 Заголовок сообщения:
СообщениеДобавлено: Пт авг 08, 2008 11:20 pm 
Не в сети
доцент

Зарегистрирован: Пт июн 13, 2008 10:31 pm
Сообщений: 33
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
AsterDevil писал(а):
А зачем, позвольте полюбопытствовать?


Я начал изучать пурик и вот пришла идея написать что-то вроде осциллографа. Пока пытаюсь изобразить простой луч, а вот скажем для развёртки 0.5 мS на клетку обращение к процедуре, которая отображает точку на экране будет маловато.
Вернуться наверх
 Профиль  
 
Пётр
 Заголовок сообщения:
СообщениеДобавлено: Сб авг 09, 2008 11:47 am 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11705
Благодарил (а): 4 раз.
Поблагодарили: 512 раз.
alexvolk писал(а):
Пока пытаюсь изобразить простой луч, а вот скажем для развёртки 0.5 мS на клетку обращение к процедуре, которая отображает точку на экране будет маловато.
Под Windows будет очень сложно точно выдерживать такие малые интервалы времении и даже если получится, то есть очень большая вероятность что осциллограф будет врать! :?

У меня есть идея как это сделать, но это только теория, на практике может и не получится.
Делаем так.
Отсчитываем время с помощью этого кода
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Procedure MiniDelay(Delay)
; Процедура формирует микросекундную паузу.
; Delay - время задержки, заданное в микросекундах.
 
Protected A.l, i.l, msek.d, C.d
Protected Ctr1.LARGE_INTEGER, Ctr2.LARGE_INTEGER, Freq.LARGE_INTEGER, Overhead.LARGE_INTEGER 
 
  msek.d=Delay/1000000
  If QueryPerformanceFrequency_(Freq) 
    QueryPerformanceCounter_(Ctr1) 
    QueryPerformanceCounter_(Ctr2) 
    Overhead\lowpart = Ctr2\lowpart - Ctr1\lowpart  ; determine API overhead 
    QueryPerformanceCounter_(Ctr1)                  ; start time loop 
    While C.d < msek ; выход из цикла будет только если пройдёт указанное кол-во времени 
     a+1 
     QueryPerformanceCounter_(Ctr2) ; end time loop 
     C.d=(Ctr2\lowpart - Ctr1\lowpart - Overhead\lowpart) / Freq\lowpart 
    Wend                ;  
  EndIf 
 
EndProcedure

его по моей просьбе выложил kvitaliy в одной из тем.
В качестве аргумента процедуры нужно указать задержку в микросекундах.

Учти, эта процедура будет "вещать" программу, т. е. программа перестанет отвечать на системные запросы ОСи (если не будешь использовать WindowEvent()), ведь всё время будет использоватся для отсчёта пауз и измерения. Да и это может не помощь, осциллограф врать будет, наверное придётся установить высокий приоритет программы.
Чтобы программа не зависала во время измерений, целесообразно само исзмерение производить в отдельном потоке, сформировав его при помощи функции CreateThread.

Кстати, а каким образом будет поступать сигнал?

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)
Вернуться наверх
 Профиль  
 
alexvolk
 Заголовок сообщения:
СообщениеДобавлено: Сб авг 09, 2008 10:56 pm 
Не в сети
доцент

Зарегистрирован: Пт июн 13, 2008 10:31 pm
Сообщений: 33
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Цитата:
У меня есть идея как это сделать, но это только теория, на практике может и не получится.
Делаем так.
Отсчитываем время с помощью этого кода Код:
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Procedure MiniDelay(Delay) 
; Процедура формирует микросекундную паузу. 
; Delay - время задержки, заданное в микросекундах. 
  
Protected A.l, i.l, msek.d, C.d 
Protected Ctr1.LARGE_INTEGER, Ctr2.LARGE_INTEGER, Freq.LARGE_INTEGER, Overhead.LARGE_INTEGER 
 
  msek.d=Delay/1000000 
  If QueryPerformanceFrequency_(Freq) 
    QueryPerformanceCounter_(Ctr1) 
    QueryPerformanceCounter_(Ctr2) 
    Overhead\lowpart = Ctr2\lowpart - Ctr1\lowpart  ; determine API overhead 
    QueryPerformanceCounter_(Ctr1)                  ; start time loop 
    While C.d < msek ; выход из цикла будет только если пройдёт указанное кол-во времени 
     a+1 
     QueryPerformanceCounter_(Ctr2) ; end time loop 
     C.d=(Ctr2\lowpart - Ctr1\lowpart - Overhead\lowpart) / Freq\lowpart 
    Wend                ;  
  EndIf 
 
EndProcedure
 



Можно это как-то пояснить что есть что ???

Я уже пытался что-то подобное написать но получается много минусов:
точка толком не прорисовывается,
при длительной работе перестаёт отвечать на команды или отвечает с большой задержкой ну и т.д.

Вот код
Код:
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
 
Global b.f, h, w, n
  
 
Procedure  time()   
 
  Repeat 
  n=n+1
  
  Ctr1.LARGE_INTEGER 
  Ctr2.LARGE_INTEGER 
  Freq.LARGE_INTEGER 
  Overhead.LARGE_INTEGER 
    
  If QueryPerformanceFrequency_(Freq) 
     QueryPerformanceCounter_(Ctr1)
   
  While C.d < 0.00005 ; выход из цикла будет только если пройдёт указанное кол-во времени 
     QueryPerformanceCounter_(Ctr2) ; end time loop 
     C.d=(Ctr2\lowpart - Ctr1\lowpart - Overhead\lowpart) / Freq\lowpart 
  Wend
    c=0
  EndIf
   
    b+w/300
    
 If b>w-60
    b=0
 EndIf
  
   TextGadget(1, b+30, h/2, 2, 2, "")
   SetGadgetColor(1 , #PB_Gadget_BackColor , RGB(255, 0, 0) )
    
  Until n>300
  n=0
  b=0
 EndProcedure
 
 
OpenWindow(0, 100, 100, 350, 400, "Заголовок",#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)  ;открываем окно вин
CreateGadgetList(WindowID(0))
 
OpenLibrary(0,"user32.dll") ; Открываем файл "user32.dll" 
CallFunction(0,"SetTimer",WindowID(0), 1, 50, @time () ) ; Вызываем функцию "SetTimer"
 
Repeat
 
w=WindowWidth(0)
h=WindowHeight(0)
 
If w<>ww Or h<>hh
ww=w
hh=h
TextGadget(0, 30, 30, w-60, h-60, "")
SetGadgetColor(0 , #PB_Gadget_BackColor , RGB(257, 175, 174) )     
EndIf
 
A= WaitWindowEvent()                        ;Узнаём текущее событие в программе
Until A=#PB_Event_CloseWindow                ;Прерываем работу программы при попытке закрыть окно.
CallFunction(0,"KillTimer",WindowID(0),1) 
   ; Закрываем файл "user32.dll". 
  CloseLibrary(0)
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
 
Global b.f, h, w
 
Procedure  time()   
    b+w/300
 If b>w-60
    b=0
 EndIf
  
   TextGadget(1, b+30, h/2, 2, 2, "")
   SetGadgetColor(1 , #PB_Gadget_BackColor , RGB(255, 0, 0) )
 
 EndProcedure
 
OpenWindow(0, 100, 100, 350, 400, "Заголовок",#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)  ;открываем окно вин
CreateGadgetList(WindowID(0))
 
OpenLibrary(0,"user32.dll") ; Открываем файл "user32.dll" 
CallFunction(0,"SetTimer",WindowID(0), 1, 1, @time () ) ; Вызываем функцию "SetTimer"
 
Repeat
 
w=WindowWidth(0)
h=WindowHeight(0)
 
If w<>ww Or h<>hh
ww=w
hh=h
TextGadget(0, 30, 30, w-60, h-60, "")
SetGadgetColor(0 , #PB_Gadget_BackColor , RGB(257, 175, 174) )     
EndIf
 
A= WaitWindowEvent()                        ;Узнаём текущее событие в программе
Until A=#PB_Event_CloseWindow                ;Прерываем работу программы при попытке закрыть окно.
CallFunction(0,"KillTimer",WindowID(0),1) 
   ; Закрываем файл "user32.dll". 
  CloseLibrary(0)
End                                           ;Завершаем работу программы.
 



Данные получать предполагаю со звуковой карты но об этом я даже пока и не загоняюсь.
Вернуться наверх
 Профиль  
 
kvitaliy
 Заголовок сообщения:
СообщениеДобавлено: Вс авг 10, 2008 5:50 am 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6647
Благодарил (а): 36 раз.
Поблагодарили: 234 раз.
Пункты репутации: 65
Тут у тебя тормоза не от таймера, а от прорисовки текста. Надо рисовать в графическом режиме. Вкуривай раздел справки 2DDrawing.

И вот тебе подарок от Fdisk
Код:
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
 
;********************************************************************************
; Удивительно красивый осциллограф. Найдено Fdisk-ом, не помню где
; Образец для построения графиков....
;********************************************************************************
If InitSprite() = 0
MessageRequester("Ошибка", " !", 0)
End
EndIf
#width = 320
#height = 240
theta.f = 0.0 : x = 0 : y = 0 : frame.f = 0.0 : pas.f = 45.0 : DIV = 1 : DoCos = 1
If OpenWindow(0, 0, 0, #width+70, #height, "Осциллограф",#PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
If CreateGadgetList(WindowID(0))
ButtonGadget(0, #width+10, #height-25, 55, 20, "Quitter")
TextGadget(5, #width+3, 5, 32, 20, "Pas", #PB_Text_Center|#PB_Text_Border)
TextGadget(6, #width+38, 5, 32, 20, "Haut", #PB_Text_Center|#PB_Text_Border)
TrackBarGadget(1, #width+5, 27, 20, #height-80, 0, 100, #PB_TrackBar_Vertical)
SetGadgetState(1, pas)
CheckBoxGadget(7, #width+32, 27, 40, 15, "Cos") : SetGadgetState(7,DoCos)
TrackBarGadget(2, #width+40, 42, 20, #height-80-15, 1, 10, #PB_TrackBar_Vertical)
SetGadgetState(2, DIV)
TextGadget(3, #width+5, #height-50, 30, 20, Str(pas), #PB_Text_Center|#PB_Text_Border)
TextGadget(4, #width+40, #height-50, 30, 20, Str(DIV), #PB_Text_Center|#PB_Text_Border)
EndIf
If OpenWindowedScreen(WindowID(0), 0, 0, #width, #height, 0, 0, 0)
CreateSprite(0, 4, 4)
If StartDrawing(SpriteOutput(0))
Box(0, 0, 4, 4, RGB(255, 0, 255))
Box(1, 0, 2, 4, RGB(127, 200, 127))
Box(0, 1, 4, 2, RGB(127, 200, 127))
Box(1, 1, 2, 2, RGB(0, 255, 0))
StopDrawing()
EndIf
TransparentSpriteColor(0,$FF00FF)
CreateSprite(1, #width, #height)
If StartDrawing(SpriteOutput(1))
For i = 0 To #width - 1 Step #height/12 ;20
LineXY(i,0,i,#height-1,$1F1F1F) 
Next i 
For i = 0 To #height - 1 Step #height/12 ;20 
LineXY(0,i,#width-1,i,$1F1F1F) 
Next i 
LineXY(0,#height/2,#width-1,#height/2,$AFAFAF) 
LineXY(#width/2,0,#width/2,#height,$AFAFAF) 
For i = #width/16 To #width - 1 Step #height/12 ;20 
LineXY(i,(#height/2)-5,i,(#height/2)+5,$AFAFAF) 
Next i 
For i = #width/16 To #height - 1 Step #height/12 ;20 
LineXY((#width/2)-5,i,(#width/2)+5,i,$AFAFAF) 
Next i 
StopDrawing() 
EndIf 
Else 
MessageRequester("Ошибка", "!", 0) 
End 
EndIf 
EndIf 
#RAD_TO_DEG=57.29577951308232087
#DEG_TO_RAD = 0.01745329251994329
 
Macro DegCos(val)
 Cos(val / #RAD_TO_DEG)
EndMacro
Macro DegSin(val)
Sin(val / #RAD_TO_DEG)
EndMacro
Repeat
Repeat
Event = WindowEvent()
; Faire un Random pour le fun
;div = Random(10)
;SetGadgetState(2,div)
;SetGadgetText(4,Str(div))
Select Event
Case #PB_Event_Gadget
If EventGadget()=0
End
EndIf
If EventGadget()=1
pas = GetGadgetState(1)
SetGadgetText(3,Str(pas))
EndIf
If EventGadget()=2
DIV=GetGadgetState(2) 
SetGadgetText(4,Str(DIV))
EndIf
If EventGadget()=7
DoCos = 1 - DoCos
SetGadgetState(7,DoCos)
EndIf
Case #PB_Event_CloseWindow
End
EndSelect
Until Event=0
FlipBuffers() 
;ClearScreen(RGB(0, 0, 0))
DisplaySprite(1,0,0)
For x = 0 To #width - 1
theta = x + frame
Select DoCos
Case 0
y=((#height-4)/2)-DegSin(theta)*(#height/2); 
Case 1
y=((#height-4)/2)-DegSin(theta)*(#height/2)*(DegCos(theta)/DIV)
EndSelect
DisplayTransparentSprite(0,x,y) 
Next
frame=frame+pas;vitesse de defilement 
Delay(25)
ForEver


_________________
☭read-only ¯\_(ツ)_/¯
Вернуться наверх
 Профиль  
 
Пётр
 Заголовок сообщения:
СообщениеДобавлено: Вс авг 10, 2008 12:18 pm 
Не в сети
МОДЕРАТОР
Аватар пользователя

Зарегистрирован: Пн апр 09, 2007 4:53 pm
Сообщений: 11705
Благодарил (а): 4 раз.
Поблагодарили: 512 раз.
alexvolk писал(а):
возможно некорректно написано прошу строго не судить я новичок
Все мы были новичками, так что об этом не беспокойся. :)

Я тут согласен с kvitaliy, нужно использовать 2DDrawing, а чтобы тормоза были по меньше, измерение и прорисовку выполнять в разных потоках. Это позволит добится максимальной точности и скорости работы.

PS.
Процедура запускается как отдельный поток с помощью CreateThread.
Описание этой и ещё нескольких, отвечающих за потоки, можно найти в разделе Thread справки

Да и ещё, я вижу у тебя API таймер вызывается через CallFunction.
Намного удобнее вызывать API напрямую
Было
Код:
1
CallFunction(0,"SetTimer",WindowID(0), 1, 1, @time () ) ; Вызываем функцию "SetTimer"


стало
Код:
1
SetTimer_(WindowID(0), 1, 1, @time() )


Тоже самое касается и KillTimer

_________________
Компьютер позволяет решать все те проблемы, которые до его изобретения не существовали. :) :)
Вернуться наверх
 Профиль  
 
alexvolk
 Заголовок сообщения: Re: Запись звука в PB4
СообщениеДобавлено: Пт авг 18, 2017 11:08 pm 
Не в сети
доцент

Зарегистрирован: Пт июн 13, 2008 10:31 pm
Сообщений: 33
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Здравствуйте. Подскажите где найти библиотеку работы со звуковой картой и описание

Или ее нет?
Вернуться наверх
 Профиль  
 
alexvolk
 Заголовок сообщения: Re:
СообщениеДобавлено: Вс авг 20, 2017 11:15 am 
Не в сети
доцент

Зарегистрирован: Пт июн 13, 2008 10:31 pm
Сообщений: 33
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
SAM писал(а):
Ловите библиотеку ввода вывода звука, написанную мной по мотивам различных исходников на других языках.
Код:
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
 
; Function set for Input and Output Sound use WinAPI
; Ver 1.0a
; @SAM 2007 Rubtsovsk
 
;-Struct
Structure WAVEFORMATEX
  wFormatTag.w
  nChannels.w
  nSamplesPerSec.l
  nAvgBytesPerSec.l
  nBlockAlign.w
  wBitsPerSample.w
  cbSize.w
EndStructure
 
;-Const
; описание возвращаемых процедурами ошибок
#iosNO_ERR=0; выполнено, ошибок нет
#iosERR=1;невыполнено,какая-то ошибка
#iosBAD_PAR=2; параметр передаваемый в процедуру не верен
#iosABSENT=3; невыполнено, т.к. процесс не запущен
#iosPROCESS=4;невыполнено, т.к. процесс запущен
#iosNO_INIT=5;невыполнено, т.к. не установлены параметры
 
;-Var
Global iosProcessStart.l; флаг работы процесса
Global ioswo.l,ioswi.l;хендлы события, потока и звук уст-ва.
Global ios.WAVEFORMATEX; структура описания формата
Global Dim iosbufIN.WAVEHDR(8),Dim iosbufOUT.WAVEHDR(8);Описатели для 4-ех буферов (In/Out)
Global iosNBuf.l,iosBufSize.l; кол-во и размер буфера в степени 2
Global Dim OutBuf.l(8), Dim InBuf.l(8); массивы буфферов
Global *iosFunc; указатель внешней функции обработки буферов
 
;-function
 
;процедура обновления буферов в режиме сквозного канала, в процессе выполняет внешнюю функцию
Procedure iosInOutProc( hwi.l, uMsg.l, dwInstance.l, dwParam1.l, dwParam2.l)
 If   iosProcessStart=1
  If uMsg=#MM_WIM_DATA
    For i=0 To iosNBuf
      If (iosbufIN(i)\dwFlags & #WHDR_DONE) = #WHDR_DONE                   
       waveInAddBuffer_(ioswi, @iosbufIN(i), SizeOf(WAVEHDR));принять данные с микшера
       CallFunctionFast( *iosFunc,InBuf(i),OutBuf(i),iosBufSize); обработка данных
       waveOutWrite_(ioswo,@iosbufOUT(i), SizeOf(WAVEHDR));воспроизвести        
      EndIf    
    Next    
  EndIf
 Else
  iosProcessStart=-1
 EndIf 
EndProcedure
 
;процедура обновления буферов в режиме вывода звука в процессе выполняет внешнюю функцию
Procedure iosOutProc( hwi.l, uMsg.l, dwInstance.l, dwParam1.l, dwParam2.l)
 If   iosProcessStart=1
  If uMsg=#MM_WIM_DATA
    For i=0 To iosNBuf
      If (iosbufIN(i)\dwFlags & #WHDR_DONE) = #WHDR_DONE                  
       waveInAddBuffer_(ioswi, @iosbufIN(i), SizeOf(WAVEHDR));принять данные с микшера
       CallFunctionFast( *iosFunc,OutBuf(i),iosBufSize); обработка данных
       waveOutWrite_(ioswo,@iosbufOUT(i), SizeOf(WAVEHDR));воспроизвести        
      EndIf    
    Next    
  EndIf
 Else
  iosProcessStart=-1
 EndIf 
EndProcedure
 
;процедура обновления буферов в режиме ввода звука в процессе выполняет внешнюю функцию
Procedure iosInProc( hwi.l, uMsg.l, dwInstance.l, dwParam1.l, dwParam2.l)
 If   iosProcessStart=1
  If uMsg=#MM_WIM_DATA
    For i=0 To iosNBuf
      If (iosbufIN(i)\dwFlags & #WHDR_DONE) = #WHDR_DONE                   
        waveInAddBuffer_(ioswi, @iosbufIN(i), SizeOf(WAVEHDR));принять данные с микшера
        CallFunctionFast( *iosFunc,InBuf(i),iosBufSize); обработка данных
      EndIf    
    Next   
  EndIf
 Else
  iosProcessStart=-1  
 EndIf
EndProcedure
 
;установка режима
;NBuf кол-во буферов(2-16)
;BufSize размер буфферов степень 2 (8-16)т.е. 256-65536 выборок
;SamplesPerSec частота выборок (из  стандартного ряда от 8000 до 96000)
;BitsPerSample размер выборки в битах(8,16,24,32)
;Channels кол-во каналов (1 или 2)
;возвращает #iosPROCESS-уже процесс запущен,#iosBAD_PAR-парамтры не верены,#iosNO_ERR- пораметры установлены
;но не факт, что с ними звуковая плата заработает 
ProcedureDLL.l iosSetFormSound(NBuf.l,BufSize.l,SamplesPerSec.l,BitsPerSample.l,Channels.l)
  Protected i.l
  If iosProcessStart=1
    ProcedureReturn #iosPROCESS
  EndIf
  If BufSize<8 And BufSize>16
    ProcedureReturn #iosBAD_PAR
  EndIf  
  If NBuf<2 And NBuf>8
    ProcedureReturn #iosBAD_PAR
  EndIf
  If BitsPerSample<>8 And BitsPerSample<>16 And BitsPerSample<>24 And BitsPerSample<>32
    ProcedureReturn #iosBAD_PAR
  EndIf
  If Channels<>2 And Channels<>1
    ProcedureReturn #iosBAD_PAR
  EndIf
  If  SamplesPerSec<>24000 And SamplesPerSec<>32000 And SamplesPerSec<>44100 And SamplesPerSec<>48000 And SamplesPerSec<>96000 And SamplesPerSec<>16000 And SamplesPerSec<>22050 And SamplesPerSec<>11025 And SamplesPerSec<>8000
    ProcedureReturn #iosBAD_PAR
  EndIf                  
  iosNBuf=NBuf-1 
  iosBufSize=(Channels*|!REG3XP3!>Pow(2,BufSize))*(BitsPerSample/8)
  For i=0 To iosNBuf
 ;   If  OutBuf(i)=0      
      OutBuf(i)=AllocateMemory(iosBufSize)
 ;   Else
  ;    ReAllocateMemory(OutBuf(i),iosBufSize)
 ;   EndIf    
 ;   If InBuf(i)=0        
      InBuf(i)=AllocateMemory(iosBufSize) 
 ;   Else
  ;    ReAllocateMemory(InBuf(i),iosBufSize)
 ;   EndIf    
  Next   
  ; Определяем формат звука
  ios\wFormatTag= #WAVE_FORMAT_PCM
  ios\nChannels=Channels; кол-во каналов 
  ios\nSamplesPerSec=SamplesPerSec ;96000, 48000,32000, 22050, 24000, 11025, 8000 частота оцифровки
  ios\wBitsPerSample =BitsPerSample  ; 8,16,32 bit дискретность 
  ios\nBlockAlign     = (ios\nChannels*ios\wBitsPerSample)/8 
  ios\nAvgBytesPerSec = ios\nSamplesPerSec*ios\nBlockAlign ; сколько байт на одну выборку
  ios\cbSize = 0  
  ProcedureReturn #iosNO_ERR
 EndProcedure
 
;возвращает число устройств ввода в компьютере 
ProcedureDLL.l iosGetNumInDevace()
  ProcedureReturn waveInGetNumDevs_()+1;узнаем сколько устройств есть ввода
EndProcedure 
 
;возвращает число устройств вывода в компьютере 
ProcedureDLL.l iosGetNumOutDevace()
  ProcedureReturn waveOutGetNumDevs_()+1;узнаем сколько устройств есть вывода
EndProcedure
 
;возвращает имя устройства ввода в компьютере под номером Num
ProcedureDLL.s iosGetNameInDevace(Num.l)
    If waveInGetDevCaps_(Num-2,@Caps.WAVEINCAPS,SizeOf(WAVEINCAPS))=#MMSYSERR_NOERROR
     ProcedureReturn PeekS(@Caps\szPname,#MAXPNAMELEN) 
    EndIf
EndProcedure
 
;возвращает имя устройства вывода в компьютере под номером Num
ProcedureDLL.s iosGetNameOutDevace(Num.l)
    If waveOutGetDevCaps_(Num-2,@Caps.WAVEINCAPS,SizeOf(WAVEINCAPS))=#MMSYSERR_NOERROR
      ProcedureReturn PeekS(@Caps\szPname,#MAXPNAMELEN)    
    EndIf
EndProcedure
 
;возвращает уровень звука воспроизведения главного канала
ProcedureDLL.l iosGetOutVolume()
  Protected  Vol.l
  waveOutGetVolume_(ioswo, @Vol)
  ProcedureReturn Vol
EndProcedure
 
;устанавливает уровень звука воспроизведения главного канала
ProcedureDLL.l iosSetOutVolume(volume.l) 
If iosProcessStart.l=1
  waveOutSetVolume_(ioswo, volume)
Else
  ProcedureReturn #iosABSENT
EndIf   
EndProcedure
 
;запуск процесса
;NumInDev номер устройства ввода, если 0 то нет и ввода
;NumOutDev номер устройства вывода, если 0 то нет и вывода
;*func укозатель на функцию обработки буфферов
;возвращает #iosPROCESS-уже процесс запущен,#iosERR-ошибка,#iosNO_INIT-не установлен режим, #iosNO_ERR-запущен 
ProcedureDLL.l iosStartProcess(NumInDev.l,NumOutDev.l,*func.l)
  Protected i.l,pri.l  
  If iosProcessStart=1
    ProcedureReturn #iosPROCESS
  EndIf
  If ios\wFormatTag<>1 And iosBifSize=0
    ProcedureReturn #iosNO_INIT
  EndIf
  If NumInDev>0 And NumOutDev>0
    If #MMSYSERR_NOERROR = waveInOpen_(@ioswi,#WAVE_MAPPER+NumInDev-2,@ios,@iosInOutProc(),0,#CALLBACK_FUNCTION|#WAVE_FORMAT_DIRECT)
        ; готовим буфeры
      For i=0 To iosNBuf
        iosbufIN(i)\lpData = InBuf(i)   
        iosbufIN(i)\dwBufferLength = iosBufSize
        waveInPrepareHeader_(ioswi, @iosbufIN(i), SizeOf(WAVEHDR));подг.  блок
        waveInAddBuffer_(ioswi,iosbufIN(i),SizeOf(WAVEHDR))      
      Next
    Else
      ProcedureReturn #iosERR 
    EndIf
    If #MMSYSERR_NOERROR = waveOutOpen_(@ioswo,#WAVE_MAPPER+NumOutDev-2,@ios,0,0,#CALLBACK_NULL|#WAVE_FORMAT_DIRECT)
        ; готовим буфeры
      For i=0 To iosNBuf
       iosbufOUT(i)\lpData = OutBuf(i)   
       iosbufOUT(i)\dwBufferLength = iosBufSize      
       waveOutPrepareHeader_(ioswo, @iosbufOUT(i), SizeOf(WAVEHDR));подг.  блок      
      Next     
    Else
      ProcedureReturn #iosERR
    EndIf
  EndIf
  If NumInDev>0 And NumOutDev=0
    If #MMSYSERR_NOERROR = waveInOpen_(@ioswi,#WAVE_MAPPER+NumInDev-2,@ios,@iosInProc(),0,#CALLBACK_FUNCTION|#WAVE_FORMAT_DIRECT)
        ; готовим буфeры
      For i=0 To iosNBuf      
        iosbufIN(i)\lpData = InBuf(i)   
        iosbufIN(i)\dwBufferLength = iosBufSize
        waveInPrepareHeader_(ioswi, @iosbufIN(i), SizeOf(WAVEHDR));подг.  блок
        waveInAddBuffer_(ioswi,iosbufIN(i),SizeOf(WAVEHDR))      
      Next
    Else
      ProcedureReturn #iosERR 
    EndIf
  EndIf
  If NumInDev=0 And NumOutDev>0
    If #MMSYSERR_NOERROR = waveInOpen_(@ioswi,#WAVE_MAPPER,@ios,@iosOutProc(),0,#CALLBACK_FUNCTION|#WAVE_FORMAT_DIRECT)
        ; готовим буфeры
      For i=0 To iosNBuf
        iosbufIN(i)\lpData = InBuf(i)   
        iosbufIN(i)\dwBufferLength = iosBufSize
        waveInPrepareHeader_(ioswi, @iosbufIN(i), SizeOf(WAVEHDR));подг.  блок
        waveInAddBuffer_(ioswi,iosbufIN(i),SizeOf(WAVEHDR))      
      Next
    Else
      ProcedureReturn #iosERR 
    EndIf
    If #MMSYSERR_NOERROR = waveOutOpen_(@ioswo,#WAVE_MAPPER+NumOutDev-2,@ios,0,0,#CALLBACK_NULL|#WAVE_FORMAT_DIRECT)
        ; готовим буфeры
      For i=0 To iosNBuf
       iosbufOUT(i)\lpData = OutBuf(i)   
       iosbufOUT(i)\dwBufferLength = iosBufSize      
       waveOutPrepareHeader_(ioswo, @iosbufOUT(i), SizeOf(WAVEHDR));подг.  блок      
      Next     
    Else
      ProcedureReturn #iosERR
    EndIf
  EndIf        
    If #MMSYSERR_NOERROR <>  waveInStart_(iosWi);запустить запись со входа 
      ProcedureReturn #iosERR
    EndIf
  *iosFunc=*func        
  iosProcessStart=1
  ProcedureReturn #iosNO_ERR
EndProcedure
 
;остановка процесса
;возвращает #iosNO_ERR-остановлен, #iosABSENT-процесс не запущен
ProcedureDLL.l iosStopProcess()
  Protected i.l
  If iosProcessStart.l=1
  iosProcessStart=0
  While iosProcessStart=0
    Delay(1)
  Wend
    waveInStop_(ioswi);остановить    
    waveInReset_(ioswi);остановить
    waveOutReset_(ioswo)              
    For i=0 To iosNBuf
      waveInUnprepareHeader_(ioswi, @iosbufIN(i), SizeOf(WAVEHDR));удалить  блок      
      waveOutUnprepareHeader_(ioswo, @iosbufOUT(i), SizeOf(WAVEHDR));удалить  блок    
    Next   
    waveInClose_(ioswo);
    waveOutClose_(ioswo);освободить звуковуху                      
    iosProcessStart.l=0
    ProcedureReturn #iosNO_ERR
  Else
    ProcedureReturn #iosABSENT  
  EndIf
EndProcedure
 
; Global time1
; Procedure DataConvertIO(*inData,*outData,bSize)
;   time1=ElapsedMilliseconds()-time1
;   DrawText(10,400,"Time: "+Str(time1)+"          ")
;   time1=ElapsedMilliseconds()
;     For i=0 To  bSize Step 2
;       PokeL(*outData+i,(PeekW(*inData+i)))
;     Next  
;  WriteData(10,*inData,bSize)
;  steping.l=bSize/2460
;  Box(0,10,640,380,RGB(0,0,0))
;  For i=1 To 639
;  dy=y
;  y=200+Int((PeekW(*inData+(i*4*steping))/180))
;  LineXY(i-1,dy,i,y,RGB(200,200,200))
;  Next
; EndProcedure
; 
; Procedure DataConvertI(*inData,bSize)
;   time1=ElapsedMilliseconds()-time1
;   DrawText(10,400,"Time: "+Str(time1)+"          ")
;   time1=ElapsedMilliseconds() 
;  WriteData(10,*inData,bSize)
;  steping.l=bSize/2460
;  Box(0,10,640,380,RGB(0,0,0))
;  For i=1 To 639
;  dy=y
;  y=200+Int((PeekW(*inData+(i*4*steping))/180))
;  LineXY(i-1,dy,i,y,RGB(200,200,200))
;  Next
; EndProcedure
; 
; Procedure DataConvertO(*outData,bSize)
;   time1=ElapsedMilliseconds()-time1
;   DrawText(10,400,"Time: "+Str(time1)+"          ")
;   time1=ElapsedMilliseconds()
;     For i=0 To  bSize Step 2
;       PokeL(*outData+i,Random(16384))
;     Next  
;  WriteData(10,*outData,bSize)
;  steping.l=bSize/2460
;  Box(0,10,640,380,RGB(0,0,0))
;  For i=1 To 639
;  dy=y
;  y=200+Int((PeekW(*outData+(i*4*steping))/180))
;  LineXY(i-1,dy,i,y,RGB(200,200,200))
;  Next
; EndProcedure
; 
; OpenWindow(0, 0, 0, 640, 480, "IOSound",  #PB_Window_SystemMenu | #PB_Window_ScreenCentered )
; DeleteFile("C:\data.raw")
; OpenFile(10,"C:\data.raw")
; StartDrawing(WindowOutput(0))
; iosGetNumOutDevace()
; iosGetNameOutDevace(2)
; iosSetFormSound(4,12,44100,16,2)
; iosStartProcess(2,2,@DataConvertIO())
; Repeat : Until WaitWindowEvent()=#WM_CLOSE
; iosStopProcess()
; CloseFile(10)
; StopDrawing()
 
; IDE Options = PureBasic v4.02 (Windows - x86)
 



А как ей пользоваться??
Вернуться наверх
 Профиль  
 
alexvolk
 Заголовок сообщения: Re: Запись звука в PB4
СообщениеДобавлено: Вс авг 20, 2017 10:17 pm 
Не в сети
доцент

Зарегистрирован: Пт июн 13, 2008 10:31 pm
Сообщений: 33
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
В теме "запись звука в purebasic с помощью BASS.dll"
cherri123 писал

cherri123 писал(а):
держи простецкий 8)
чисто ПБ

Код:
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
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
;/
;/ Object     Audio Recorder 1.0 (a)
;/
;/ Date       August 2004
;/ Author     Philippe Carpentier
;/ Contact    flype@altern.org
;/ Info       MS Windows only - winmm.lib - mmsystem.h
;/
;  Bug fixes by chris319 on September 2, 2007
;
;  04/02/2010 : DrGolf for PB 4.50
;
;- REC GLOBAL
;
Global QuitRec.l
;
;- REC CONSTANTES
;
#MinWidth      = 320
#MinHeight     = 240
;
;- REC INITIALISATION
;
Enumeration 0 ; #CHANNEL
  #CHANNEL_LEFT
  #CHANNEL_RIGHT
EndEnumeration
Enumeration 0 ; #GADGET
  #gadFrame1
  #gadFrame2
  #gadStart
  #gadStop
  #gadSndVol
  #gadFile
  #gadChannel
  #gadResolution
  #gadFrequence
  #gadDevice
EndEnumeration
Enumeration 0 ; #WINDOW
  #Window
EndEnumeration
Enumeration 0 ; #TOOLBAR
  #ToolBar
EndEnumeration
Enumeration 0 ; #STATUSBAR
  #StatusBar
EndEnumeration
 
;Structure WAVEFORMATEX -- NOT NEEDED IN PB 4.10 -- chris319
;  wFormatTag.w
;  nChannels.w
;  nSamplesPerSec.l
;  nAvgBytesPerSec.l
;  nBlockAlign.w
;  wBitsPerSample.w
;  cbSize.w
;EndStructure
Structure SCOPE
  channel.b
  left.l
  top.l
  width.l
  height.l
  middleY.l
  quarterY.l
EndStructure
Structure CONFIG
 
  hWindow.l           ; Window handle
  hToolBar.l          ; ToolBar handle
  hfont.l             ; Font handle
 
  Date.l              ; Start date
  size.l              ; Wave buffer size
  buffer.l            ; Wave buffer pointer
  output.l            ; WindowOutput()
  wave.l              ; Address of waveform-audio input device
  recorded.l          ; Number of bytes recorded
  recording.b         ; Record is running...
 
  File.s              ; Recording FileName (c:\unnamed.raw)
  FileId.l            ; Recording FileId (#PB_Any)
  SndVol.s            ; Microsoft Volume Control (sndvol32.exe)
 
  format.WAVEFORMATEX ; Capturing WaveFormatEx
  lBuf.l              ; Capturing Buffer size
  nBuf.l              ; Capturing Buffer number
  nDev.l              ; Capturing Device identifier
  nBit.l              ; Capturing Resolution (8/16)
  nHertz.l            ; Capturing Frequency  (Hertz)
  nChannel.l          ; Capturing Channels number (Mono/Stereo)
 
  LScope.SCOPE        ; Wave form display
  RScope.SCOPE        ; Wave form display
  ScopeTimer.l        ; Scope Timer (redraw every n times)
  cback.l             ; Back color
  cline.l             ; Line color
  cwave.l             ; Wave color
  ColRecWave.l        ; Scope Record Wave Color
  ColRecBack.l        ; Scope Record Back Color
  ColRecLine.l        ; Scope Record Line Color
  ColCapWave.l        ; Scope Capture Wave Color
  ColCapBack.l        ; Scope Capture Back Color
  ColCapLine.l        ; Scope Capture Line Color
 
EndStructure
 
Global Config.CONFIG
Global Dim inHdr.WAVEHDR(16)
 
Config\hfont             = LoadFont(0,"Arial",7)
Config\format\cbSize     = 0
Config\format\wFormatTag = #WAVE_FORMAT_PCM
Config\LScope\channel    = #CHANNEL_LEFT
Config\RScope\channel    = #CHANNEL_RIGHT
;
;- REC DECLARATIONS
;
Declare Clamp(value.l,min.l,max.l)
 
Declare CONFIG_Load()
Declare CONFIG_Save()
 
Declare CAPTURE_Stop()
Declare CAPTURE_Start()
Declare CAPTURE_Error(err.l)
Declare CAPTURE_GetDevices(gadId.l)
Declare CAPTURE_Read(hWaveIn.l,lpWaveHdr.l)
 
Declare DRAW_Scope()
Declare DRAW_Wave(*scope.SCOPE)
Declare DRAW_Wave8M(*scope.SCOPE)
Declare DRAW_Wave8S(*scope.SCOPE)
Declare DRAW_Wave16M(*scope.SCOPE)
Declare DRAW_Wave16S(*scope.SCOPE)
Declare DRAW_LCD(*scope.SCOPE,lcd$)
Declare DRAW_Background(*scope.SCOPE)
 
Declare FILE_Close()
Declare FILE_Append()
Declare FILE_Create()
Declare FILE_Select()
Declare FILE_Recording(state.b)
Declare FILE_raw2wav(File.s)
 
Declare GUI_Init()
Declare GUI_Resize()
Declare GUI_TBCombo(Id,x,y,w,h)
Declare GUI_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)
 
;
;- REC PROCEDURES
;
;
Procedure Clamp(value.l,min.l,max.l)
  If value<min : ProcedureReturn min : EndIf
  If value>max : ProcedureReturn max : EndIf 
  ProcedureReturn value
EndProcedure
;
Procedure CONFIG_Load()
 
  OpenPreferences("Recorder.ini")
 
  PreferenceGroup("Files")
  Config\File   = ReadPreferenceString("FileName","c:\unnamed.raw")
  Config\SndVol = ReadPreferenceString("SndVol","sndvol32")
 
  PreferenceGroup("Capture")
  Config\nDev     = ReadPreferenceLong("Device",0)
  Config\nChannel = ReadPreferenceLong("Channel",1)
  Config\nHertz   = ReadPreferenceLong("Frequency",7)
  Config\nBit     = ReadPreferenceLong("Resolution",1)
  Config\nBuf     = ReadPreferenceLong("BufferNum",8)
  Config\lBuf     = ReadPreferenceLong("BufferLen", 2048) ;chris319
 
  PreferenceGroup("Scope")
  Config\ScopeTimer   = ReadPreferenceLong("ScopeTimer",25)
  Config\ColRecLine   = ReadPreferenceLong("ColRecLine",  $000035)
  Config\ColRecWave   = ReadPreferenceLong("ColRecWave",  $1010E0)
  Config\ColRecBack   = ReadPreferenceLong("ColRecBack",  $000050)
  Config\ColCapLine   = ReadPreferenceLong("ColCapLine",  $004000)
  Config\ColCapWave   = ReadPreferenceLong("ColCapWave",  $20E020)
  Config\ColCapBack   = ReadPreferenceLong("ColCapBack",  $004900)
 
  PreferenceGroup("Window")
  pos.WINDOWPLACEMENT
  pos\length=SizeOf(WINDOWPLACEMENT)
  pos\ptMinPosition\x         = ReadPreferenceLong("MinPosX",0)
  pos\ptMinPosition\y         = ReadPreferenceLong("MinPoxY",0)
  pos\ptMaxPosition\x         = ReadPreferenceLong("MaxPosX",-1)
  pos\ptMaxPosition\y         = ReadPreferenceLong("MaxPosY",-1)
  pos\rcNormalPosition\left   = ReadPreferenceLong("PosX1",100)
  pos\rcNormalPosition\top    = ReadPreferenceLong("PosY1",100)
  pos\rcNormalPosition\right  = ReadPreferenceLong("PosX2",#MinWidth)
  pos\rcNormalPosition\bottom = ReadPreferenceLong("PosY2",#MinHeight)
 
  ClosePreferences()
 
  Config\cback   = Config\ColCapBack
  Config\cline   = Config\ColCapLine
  Config\cwave   = Config\ColCapWave
 
  StatusBarText(0,2,Config\File)
  SetGadgetState(#gadDevice,Config\nDev)
  SetGadgetState(#gadChannel,Config\nChannel)
  SetGadgetState(#gadFrequence,Config\nHertz)
  SetGadgetState(#gadResolution,Config\nBit)
  SetWindowPlacement_(Config\hWindow,@pos)
  ShowWindow_(Config\hWindow,#True)
 
EndProcedure
;
Procedure CONFIG_Save()
 
  pos.WINDOWPLACEMENT
  pos\length = SizeOf(WINDOWPLACEMENT)
  GetWindowPlacement_(Config\hWindow,@pos)
 
  If CreatePreferences("Recorder.ini")
   
    PreferenceGroup("Files")
    WritePreferenceString("FileName",Config\File)
    WritePreferenceString("SndVol",Config\SndVol)
   
    PreferenceGroup("Capture")
    WritePreferenceLong("Device",Config\nDev)
    WritePreferenceLong("Channel",Config\nChannel)
    WritePreferenceLong("Frequency",Config\nHertz)
    WritePreferenceLong("Resolution",Config\nBit)
    WritePreferenceLong("BufferNum",Config\nBuf)
    WritePreferenceLong("BufferLen",Config\lBuf)
   
    PreferenceGroup("Scope")
    WritePreferenceLong("ScopeTimer",Config\ScopeTimer)
    WritePreferenceLong("ColRecLine",Config\ColRecLine)
    WritePreferenceLong("ColRecWave",Config\ColRecWave)
    WritePreferenceLong("ColRecBack",Config\ColRecBack)
    WritePreferenceLong("ColCapLine",Config\ColCapLine)
    WritePreferenceLong("ColCapWave",Config\ColCapWave)
    WritePreferenceLong("ColCapBack",Config\ColCapBack)
   
    PreferenceGroup("Window")
    WritePreferenceLong("MinPosX",pos\ptMinPosition\x)
    WritePreferenceLong("MinPoxY",pos\ptMinPosition\y)
    WritePreferenceLong("MaxPosX",pos\ptMaxPosition\x)
    WritePreferenceLong("MaxPosY",pos\ptMaxPosition\y)
    WritePreferenceLong("PosX1",pos\rcNormalPosition\left)
    WritePreferenceLong("PosY1",pos\rcNormalPosition\top)
    WritePreferenceLong("PosX2",pos\rcNormalPosition\right)
    WritePreferenceLong("PosY2",pos\rcNormalPosition\bottom)
   
    ClosePreferences()
    ProcedureReturn #True
   
  EndIf
 
EndProcedure
;
Procedure CAPTURE_Error(err.l)
 
  If err
    text.s=Space(#MAXERRORLENGTH)
    waveInGetErrorText_(err,text,#MAXERRORLENGTH)
    MessageRequester("Error",text,#MB_ICONERROR)
    CAPTURE_Stop()
    End
  EndIf
 
EndProcedure
;
Procedure CAPTURE_Start()
 
  CAPTURE_Stop()
 
  Config\nDev = GetGadgetState(#gadDevice)
 
  Config\nChannel = GetGadgetState(#gadChannel)
  Select Config\nChannel
    Case 0 : Config\format\nChannels = 1
    Case 1 : Config\format\nChannels = 2
  EndSelect
 
  Config\nBit = GetGadgetState(#gadResolution)
  Select Config\nBit
    Case 0 : Config\format\wBitsPerSample = 8
    Case 1 : Config\format\wBitsPerSample = 16
  EndSelect
 
  Config\nHertz = GetGadgetState(#gadFrequence)
  Select Config\nHertz
    Case 0 : Config\format\nSamplesPerSec =  8000
    Case 1 : Config\format\nSamplesPerSec = 11025
    Case 2 : Config\format\nSamplesPerSec = 12000
    Case 3 : Config\format\nSamplesPerSec = 16000
    Case 4 : Config\format\nSamplesPerSec = 22050
    Case 5 : Config\format\nSamplesPerSec = 24000
    Case 6 : Config\format\nSamplesPerSec = 32000
    Case 7 : Config\format\nSamplesPerSec = 44100
    Case 8 : Config\format\nSamplesPerSec = 48000
  EndSelect
 
  Config\format\nBlockAlign     = (Config\format\nChannels*Config\format\wBitsPerSample)/8
  Config\format\nAvgBytesPerSec = Config\format\nSamplesPerSec*Config\format\nBlockAlign
 
  If #MMSYSERR_NOERROR = waveInOpen_(@Config\wave,#WAVE_MAPPER+Config\nDev,@Config\format,Config\hWindow,#Null,#CALLBACK_WINDOW|#WAVE_FORMAT_DIRECT)
   
    For i=0 To Config\nBuf-1
      inHdr(i)\lpData=AllocateMemory(Config\lBuf)
      inHdr(i)\dwBufferLength=Config\lBuf
      waveInPrepareHeader_(Config\wave,inHdr(i),SizeOf(WAVEHDR))
      waveInAddBuffer_(Config\wave,inHdr(i),SizeOf(WAVEHDR))
    Next
   
    If #MMSYSERR_NOERROR = waveInStart_(Config\wave)
      SetTimer_(Config\hWindow,0,Config\ScopeTimer,0)
    EndIf
   
  EndIf
 
EndProcedure
;
Procedure CAPTURE_Stop()
 
  If Config\wave
    waveInReset_(Config\wave)
    waveInStop_(Config\wave)
    For i=0 To Config\nBuf-1
      If inHdr(i)
        waveInUnprepareHeader_(Config\wave,inHdr(i),SizeOf(WAVEHDR))
      EndIf
    Next
    waveInClose_(Config\wave)
  EndIf
 
  KillTimer_(Config\hWindow,0)
 
EndProcedure
;
Procedure CAPTURE_Read(hWaveIn.l,lpWaveHdr.l)
;  waveInAddBuffer_(hWaveIn,lpWaveHdr,SizeOf(WAVEHDR))
 
  *hWave.WAVEHDR=lpWaveHdr
  Config\buffer=*hWave\lpData
  Config\size=*hWave\dwBytesRecorded
;  dwBytesRecorded MUST BE SAVED BEFORE CALLING waveInAddBuffer -- chris319 
  waveInAddBuffer_(hWaveIn,lpWaveHdr,SizeOf(WAVEHDR))
 
  FILE_Append()
 
EndProcedure
;
Procedure CAPTURE_GetDevices(gadId.l)
  MMNumDevice.l = waveInGetNumDevs_()
  If MMNumDevice
    For MMDeviceId=#WAVE_MAPPER To MMNumDevice-1
      MMResult.l = waveInGetDevCaps_(MMDeviceId,@Caps.WAVEINCAPS,SizeOf(WAVEINCAPS))
      If MMResult = #MMSYSERR_NOERROR
        AddGadgetItem(gadId,-1,PeekS(@Caps\szPname,#MAXPNAMELEN))
      EndIf
    Next
  EndIf
EndProcedure
;
Procedure DRAW_Scope()
  If Config\buffer
    StartDrawing(WindowOutput(0)) ; 04/02/2010  DrGolf
   ;  StartDrawing(Config\output)
      DRAW_Background(Config\LScope)
      DRAW_Background(Config\RScope)
      DRAW_Wave(Config\LScope)
      If Config\nChannel
        DRAW_Wave(Config\RScope)
      EndIf
    StopDrawing()
  EndIf
EndProcedure
;
Procedure DRAW_Background(*scope.SCOPE)
 
  Box (*scope\left,*scope\top,*scope\width,*scope\height,Config\cback)
  Line(*scope\left,*scope\middleY-*scope\quarterY,*scope\width,0,Config\cline)
  Line(*scope\left,*scope\middleY+*scope\quarterY,*scope\width,0,Config\cline)
 
EndProcedure
;
Procedure DRAW_LCD(*scope.SCOPE,lcd$)
 
  DrawingMode(1)
  FrontColor($00FFFF)
  DrawingFont(Config\hfont)
  Select *scope\channel
    Case #CHANNEL_LEFT  : DrawText(*scope\left+1, *scope\top, "[L] "+lcd$)
    Case #CHANNEL_RIGHT : DrawText(*scope\left+1, *scope\top, "[R] "+lcd$)
  EndSelect
  DrawingMode(0)
 
EndProcedure
;
Procedure DRAW_Wave(*scope.SCOPE)
  Select Config\nBit
    Case 0
      DRAW_LCD(*scope.SCOPE,"8 bits")
      Select Config\nChannel
        Case 0 : DRAW_Wave8M(*scope.SCOPE)
        Case 1 : DRAW_Wave8S(*scope.SCOPE)
      EndSelect
    Case 1
      DRAW_LCD(*scope.SCOPE,"16 bits")
      Select Config\nChannel
        Case 0 : DRAW_Wave16M(*scope.SCOPE)
        Case 1 : DRAW_Wave16S(*scope.SCOPE)
      EndSelect
  EndSelect
EndProcedure
;
Procedure DRAW_Wave8M(*scope.SCOPE)
  Protected Max_Y = (Config\RScope\height)/2
  oldx.l=*scope\left
  For i = 0 To Config\size - 1 ;chris319
    value.b=PeekB(Config\buffer+i)+$7F
    xx=Clamp(*scope\left+(i**scope\width)/(Config\size+1),*scope\left,*scope\width)
    yy=(value**scope\height)/$FF
    If yy > Max_Y : yy = Max_Y : EndIf
    If yy < -Max_Y : yy = -Max_Y : EndIf
    LineXY(oldx,*scope\middleY+oldy,xx,*scope\middleY+yy,Config\cwave)
    oldx=xx:oldy=yy
  Next
 
EndProcedure
;
Procedure DRAW_Wave8S(*scope.SCOPE)
  Protected Max_Y = (Config\RScope\height)/2
  oldx.l=*scope\left
  For i = 0 To (Config\size - 1) Step 2 ;chris319
    value.b=PeekB(Config\buffer+i+*scope\channel*2)+$7F
    xx=Clamp(*scope\left+(i**scope\width)/(Config\size+1),*scope\left,*scope\width)
    yy=(value**scope\height)/$FF
    If yy > Max_Y : yy = Max_Y : EndIf
    If yy < -Max_Y : yy = -Max_Y : EndIf
    LineXY(oldx,*scope\middleY+oldy,xx,*scope\middleY+yy,Config\cwave)
    oldx=xx:oldy=yy
  Next
 
EndProcedure
;
Procedure DRAW_Wave16M(*scope.SCOPE)
  Protected Max_Y = (Config\RScope\height)/2
  oldx.l=*scope\left
  For i=0 To (Config\size -2) Step 2 ;chris319
    value.w=PeekW(Config\buffer+i)
    xx=Clamp(*scope\left+(i**scope\width)/(Config\size+1),*scope\left,*scope\width)
    yy=(value**scope\height)/$FFFF
    If yy > Max_Y : yy = Max_Y : EndIf
    If yy < -Max_Y : yy = -Max_Y : EndIf
    LineXY(oldx,*scope\middleY+oldy,xx,*scope\middleY+yy,Config\cwave)
    oldx=xx:oldy=yy
  Next
 
EndProcedure
;
Procedure DRAW_Wave16S(*scope.SCOPE) ;chris319
  Protected Max_Y = (Config\RScope\height)/2
Select *scope\channel
 
Case 0 ;LEFT CHANNEL
  oldx.l = *scope\left
  For i = 0 To (Config\size - 2) Step 4
    value.w = PeekW(Config\buffer + i)
    xx = Clamp(*scope\left+(i**scope\width)/(Config\size+1),*scope\left,*scope\width)
;    yy = (value * *scope\height)/$FFFF
    yy = (value * *scope\height) / $FFF
    ayy = Abs(yy)
    If ayy > vmax: vmax = ayy: EndIf
    If yy > Max_Y : yy = Max_Y : EndIf
    If yy < -Max_Y : yy = -Max_Y : EndIf
    LineXY(oldx,*scope\middleY+oldy,xx,*scope\middleY+yy,Config\cwave)
    oldx = xx: oldy = yy
  Next
 
Case 1 ;RIGHT CHANNEL
  oldx.l = *scope\left
  For i = 2 To (Config\size - 2) Step 4
    value.w = PeekW(Config\buffer + i)
    xx=Clamp(*scope\left+(i * *scope\width)/(Config\size+1),*scope\left,*scope\width)
;    yy = (value * *scope\height)/$FFFF
    yy = (value * *scope\height) / $FFF
    ayy = Abs(yy)
    If ayy > vmax: vmax = ayy: EndIf
    If yy > Max_Y : yy = Max_Y : EndIf
    If yy < -Max_Y : yy = -Max_Y : EndIf
    LineXY(oldx,*scope\middleY + oldy, xx, *scope\middleY + yy, Config\cwave)
    oldx = xx: oldy = yy
  Next
 
EndSelect
 
EndProcedure
;
Procedure FILE_Create()
 
  Config\recorded  = #Null ; -- MOVED HERE BY chris319
   
  If Config\File
    Config\FileId = CreateFile(#PB_Any,Config\File)
    If Config\FileId
      DisableToolBarButton(#ToolBar, #gadStart,#True)
      DisableToolBarButton(#ToolBar, #gadFile,#True)
      DisableGadget(#gadChannel,#True)
      DisableGadget(#gadFrequence,#True)
      DisableGadget(#gadResolution,#True)
      DisableGadget(#gadDevice,#True)
      Config\Date = GetTickCount_()
      FILE_Recording(#True)
    Else
      MessageRequester("Error","Can't create file",#MB_ICONERROR)
    EndIf
  EndIf
 
EndProcedure
;
Procedure FILE_Append()
 
  If Config\recording = #True
    Config\recorded + Config\size
    WriteData(Config\FileId, Config\buffer,Config\size)
    StatusBarText(#StatusBar, 0,Str(Config\recorded)+" bytes",#PB_StatusBar_Center)
    StatusBarText(#StatusBar, 1,StrF((GetTickCount_()-Config\Date)/1000,3)+" secs",#PB_StatusBar_Center)
  EndIf
 
EndProcedure
;
Procedure FILE_Recording(state.b)
 
  If state
    Config\cback   = Config\ColRecBack
    Config\cline   = Config\ColRecLine
    Config\cwave   = Config\ColRecWave
  Else
    Config\cback   = Config\ColCapBack
    Config\cline   = Config\ColCapLine
    Config\cwave   = Config\ColCapWave
  EndIf
 
  Config\recording = state
;  Config\recorded  = #Null -- THIS LINE OF CODE MOVED TO FILE_create-- chris319
 
EndProcedure
;
Procedure FILE_Close()
 
  If Config\recording
    Config\Date = #Null
    FILE_Recording(#False)
    CloseFile(Config\FileId)
    Delay(1000)
    FILE_raw2wav(Config\File)   
    DisableToolBarButton(#ToolBar, #gadStart,#False)
    DisableToolBarButton(#ToolBar, #gadFile,#False)
    DisableGadget(#gadChannel,#False)
    DisableGadget(#gadFrequence,#False)
    DisableGadget(#gadResolution,#False)
    DisableGadget(#gadDevice,#False)
  EndIf
 
EndProcedure
;
Procedure FILE_Select()
 
  File.s = SaveFileRequester("Select a file",Config\File,"Raw Sound|(*.raw)",0)
 
  If File
    Config\File = File
  EndIf
 
  StatusBarText(0,2,Config\File)
 
EndProcedure
;
Procedure FILE_raw2wav(File.s)
 
  inId.l = ReadFile(#PB_Any,File)
 
  If inId = #Null
    MessageRequester("Error", "Unable to open file",#MB_ICONERROR) ; chris319
    ProcedureReturn #False
  EndIf
 
  lBuf.l = Lof(inId)
  pBuf.l = AllocateMemory(lBuf)
  If pBuf = #Null
    MessageRequester("Error", "Unable to allocate buffer",#MB_ICONERROR) ; chris319
    ProcedureReturn #False
  EndIf
 
  ReadData(inId, pBuf,lBuf)
  CloseFile(inId)
 
  subchunk2size.l = Config\recorded
  chunksize.l = 36 + subchunk2size
 
  f$ = GetFilePart(File)
  x$ = GetPathPart(File)+Left(f$,Len(f$)-Len(GetExtensionPart(File))-1)+".wav"
 
  outId.l = CreateFile(#PB_Any,x$) 
  If outId = #Null
    MessageRequester("Error", "Unable to create file",#MB_ICONERROR) ; chris319
    ProcedureReturn #False
  EndIf
 
  b.w = Config\format\wBitsPerSample
  c.w = Config\format\nChannels
  h.l = Config\format\nSamplesPerSec
 
  WriteString(outId, "RIFF") ; 4 bytes
 
;  WriteLong(outId, lBuf+44) ; 4 bytes
  WriteLong(outId, chunksize) ; 4 bytes -- chris319
 
  WriteString(outId, "WAVEfmt ") ; 8 bytes -- chris319
    ;WriteString(outId, "fmt ")
 
  ;WriteLong(outId, 16)
  WriteLong(outId, b) ; 4 bytes -- chris319
 
   
  WriteWord(outId, 1) ; 2 bytes -- PCM
  WriteWord(outId, c) ; 2 bytes
  WriteLong(outId, h) ; 4 bytes
  WriteLong(outId, c*h*(b/8)) ; 4 bytes
 
  ;WriteWord(outId, c*(h/8))
  WriteWord(outId, (c * b) / 8) ; -- blockalign 2 bytes -- chris319
   
  WriteWord(outId, b) ; 2 bytes
  WriteString(outId, "data") ; 4 bytes
 
  WriteLong(outId, lBuf) ; -- 4 bytes
  WriteData(outId, pBuf,lBuf)
 
  CloseFile(outId)
 
  ProcedureReturn #True
 
EndProcedure
;
Procedure GUI_Init()
  QuitRec = 0
  WndId.l = OpenWindow(0,0,0,500,400,"Recorder",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_Invisible)
  If WndId=#Null : ProcedureReturn #False : EndIf
 
  Config\hWindow=WindowID(0)
  Config\output=WindowOutput(0)
  Config\hToolBar=CreateToolBar(#ToolBar,Config\hWindow)
  If Config\hToolBar=#Null : ProcedureReturn #False : EndIf
 
  If CreateStatusBar(#StatusBar,Config\hWindow)=#Null
    ProcedureReturn #False
  EndIf
 
  ToolBarStandardButton(#gadStart,#PB_ToolBarIcon_Open)
  ToolBarStandardButton(#gadStop,#PB_ToolBarIcon_Delete)
 
  ToolBarStandardButton(#gadFile,#PB_ToolBarIcon_Save)
  ToolBarSeparator()
  ToolBarStandardButton(#gadSndVol,#PB_ToolBarIcon_Properties)
  ToolBarSeparator()
 
  ToolBarToolTip(#ToolBar, #gadStart,"Record")
  ToolBarToolTip(#ToolBar, #gadStop,"Stop")
  ToolBarToolTip(#ToolBar, #gadFile,"Create a file")
  ToolBarToolTip(#ToolBar, #gadSndVol,"Volume")
 
  GUI_TBCombo(#gadChannel,0,1,58,20) ; 04/02/2010 DrGolf
  AddGadgetItem(#gadChannel,-1,"Mono")
  AddGadgetItem(#gadChannel,-1,"Stereo")
  SetGadgetState(#gadChannel,0)
 
  GUI_TBCombo(#gadResolution,2,1,55,20) ; 04/02/2010 DrGolf
  AddGadgetItem(#gadResolution,-1,"8 bits")
  AddGadgetItem(#gadResolution,-1,"16 bits")
 
  GUI_TBCombo(#gadFrequence,2,1,80,20) ; 04/02/2010 DrGolf
  AddGadgetItem(#gadFrequence,-1,"8.0 kHz")
  AddGadgetItem(#gadFrequence,-1,"11.025 kHz")
  AddGadgetItem(#gadFrequence,-1,"12.0 kHz")
  AddGadgetItem(#gadFrequence,-1,"16.0 kHz")
  AddGadgetItem(#gadFrequence,-1,"22.05 kHz")
  AddGadgetItem(#gadFrequence,-1,"24.0 kHz")
  AddGadgetItem(#gadFrequence,-1,"32.0 kHz")
  AddGadgetItem(#gadFrequence,-1,"44.1 kHz")
  AddGadgetItem(#gadFrequence,-1,"48.0 kHz")
 
  GUI_TBCombo(#gadDevice,2,1,160,20) ; 04/02/2010 DrGolf
  CAPTURE_GetDevices(#gadDevice)
  SetGadgetState(#gadDevice,0)
 
  Frame3DGadget(#gadFrame1,0,0,0,0,"",#PB_Frame3D_Double)
  Frame3DGadget(#gadFrame2,0,0,0,0,"",#PB_Frame3D_Double)
 
  AddStatusBarField( 100)
  AddStatusBarField(  80)
  AddStatusBarField(1000)
  StatusBarText(0,0,"0 "+"bytes",#PB_StatusBar_Center)
  StatusBarText(0,1,"0.000 "+"secs",#PB_StatusBar_Center)
 
  SetWindowCallback(@GUI_CallBack())
  FILE_Recording(#False)
  GUI_Resize()
  ProcedureReturn #True
 
EndProcedure
;
Procedure GUI_Resize()
 
  WndW.l = ( WindowWidth(0)  -  4 )
  WndH.l = ( WindowHeight(0) - 60 ) >> 1
 
  Config\LScope\left     = 2
  Config\LScope\top      = 30
  Config\LScope\width    = WndW
  Config\LScope\height   = WndH
  Config\LScope\quarterY = Config\LScope\height >> 2
  Config\LScope\middleY  = Config\LScope\top + Config\LScope\height >> 1
  ResizeGadget(#gadFrame1,Config\LScope\left-2,Config\LScope\top-2,Config\LScope\width+4,Config\LScope\height+4)
 
  Config\RScope\left     = 2
  Config\RScope\top      = Config\LScope\top + Config\LScope\height + 6
  Config\RScope\width    = WndW
  Config\RScope\height   = WndH
  Config\RScope\quarterY = Config\RScope\height >> 2
  Config\RScope\middleY  = Config\RScope\top + Config\RScope\height >> 1
  ResizeGadget(#gadFrame2,Config\RScope\left-2,Config\RScope\top-2,Config\RScope\width+4,Config\RScope\height+4)
 
EndProcedure
;
Procedure GUI_TBCombo(Id,x,y,w,h)
 
  pos=SendMessage_(Config\hToolBar,#TB_BUTTONCOUNT,0,0)
  ToolBarSeparator()       
  SendMessage_(Config\hToolBar,#TB_GETBUTTON,pos,@separator.TBBUTTON)
  separator\iBitmap=x+w
  SendMessage_(Config\hToolBar,#TB_DELETEBUTTON,pos,0)
  SendMessage_(Config\hToolBar,#TB_INSERTBUTTON,pos,separator)
  SendMessage_(Config\hToolBar,#TB_GETITEMRECT,pos,@rc.RECT)   
  UseGadgetList(Config\hToolBar)
  ComboBoxGadget(Id,x+rc\left,y,w,h)
  UseGadgetList(Config\hWindow)
 
EndProcedure
;
Procedure GUI_CallBack(hWnd.l,Msg.l,wParam.l,lParam.l)
 
  Result.l=#PB_ProcessPureBasicEvents
 
  Select Msg
    Case #WM_KEYDOWN
      If GetAsyncKeyState_(#VK_ESCAPE)
        QuitRec = 1
      EndIf
    Case #WM_SIZE     : GUI_Resize()
    Case #WM_TIMER    : DRAW_Scope()
    Case #MM_WIM_DATA : CAPTURE_Read(wParam,lParam)
    Case #WM_COMMAND
      Select wParam & $FFFF
        Case #gadStart      : FILE_Create()
        Case #gadStop       : FILE_Close()
        Case #gadFile       : FILE_Select()
        Case #gadSndVol     : RunProgram(Config\SndVol,"","")
        Case #gadFrequence  : If EventType()=9 : CAPTURE_Start() : EndIf
        Case #gadResolution : If EventType()=9 : CAPTURE_Start() : EndIf
        Case #gadChannel    : If EventType()=9 : CAPTURE_Start() : EndIf
        Case #gadDevice     : If EventType()=9 : CAPTURE_Start() : EndIf
      EndSelect
    Case #WM_GETMINMAXINFO
      *mmi.MINMAXINFO=lParam
      *mmi\ptMinTrackSize\x=#MinWidth
      *mmi\ptMinTrackSize\y=#MinHeight
  EndSelect
 
  ProcedureReturn Result
 
EndProcedure
;
;- REC MAIN
;
Procedure StartRecorder()
 
  If GUI_Init()
    CONFIG_Load()
    CAPTURE_Start()
    Repeat
    Until WaitWindowEvent()=#WM_CLOSE Or QuitRec
    CAPTURE_Stop()
    CONFIG_Save()
  EndIf
 
EndProcedure
 
StartRecorder()




Это одно и тоже или нет?
Вернуться наверх
 Профиль  
 
SereZa
 Заголовок сообщения: Re: Запись звука в PB4
СообщениеДобавлено: Пт янв 11, 2019 3:27 pm 
Не в сети
профессор

Зарегистрирован: Пт фев 20, 2009 12:57 pm
Сообщений: 1831
Откуда: Алматы
Благодарил (а): 19 раз.
Поблагодарили: 52 раз.
Пункты репутации: 5
тут вопрос возник. о записи звука и его громкости. в оригинале в игре громкость сэмплов высокая и нет искажений. пишу со стереомикса - получается очень тихо. прибавляю громкости - умножая там насколько-то 1.1, 1.2 и так далее каждый тик в вав файле - громкость прибавляется, но в конечном итоге лезут искажения. понятно что это как бы совсем не профессиональное оборудование и все-таки может можно как-то выкрутится?

так идея одна бродит в голове - умножать на 1.1 к примеру, но проверять максимальное значение. типа если оно превышает 127, то умножать тогда не на 1.1, а на 1.05 скажем. то есть в зависимости от значения тика применять изменяемый множитель.

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

Список форумов » PureBasic Windows » программирование на Purebasic для новичков

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


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

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 11

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

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