Приветствую Вас, друзья!

     Предлагаю Вашему вниманию одну из ранних моих работ на Pure Basic.  Данное приложение представляет собой генератор звуковых частот, использующий звуковую систему компьютера. В авторском варианте синусоидальный НЧ - сигнал (частотой от 20 до 16000 Гц и амплитудой до 5,3 В) снимается с линейного выхода и подается на внешний повторитель, выполненный на ОУ .

  Подстройка амплитуды сигнала на выходе (калибровка) может осуществляться как средствами операционной системы (микшера) так и на уровне повторителя. При необходимости можно внести изменения в код программы и добавить дополнительные опции (к примеру, формирование сигнала произвольной формы)

Далее представлен текст программы. В начале идёт блок объявлений переменных и констант:

#frmMain=0              ; основное окно

; 0-11                  ; кнопки Частоты  10 -сдвиг, 11-сброс

; 12-23                 ; кнопки Амплитуды 22-сдвиг, 23-сброс

#panF=100               ; панель Частота

#txtF=101               ; табло Частота

#lblF=102               ; метка Частота

#panU=103               ; панель Амплитуда

#txtU=104               ; табло Амплитуда

#lblU=105               ; метка Амплитуда

#panForm=106            ; панель Форма

#cmdPusk=300            ; кнопка Пуск

#cmdStop=301            ; кнопка Стоп



Global numF.i           ; частота в числовом

Global stgF.s           ; частота в строковом

Global numU.i           ; амплитуда в числовом

Global stgU.s           ; амплитуда в строковом

Global numStatus.a      ; статус в числовом 0-в режиме СТОП, 1-в режиме ПУСК

Global stgFile.s        ; путь и имя пользователского файла

Global ogrF.i=16000     ; ограничение по частоте

Global ogrU.i=5300      ; ограничение по амплитуде

#samplerate = 192000    ; частота дискретизации (отсчётов в секунду)

#bitrate = 16           ; бит на сэмпл (разрядность отсчёта)

#channels = 1           ; количество каналов ( 1-моно, 2 серео)

#avBytesPerSec= 384000  ; среднее количество байтов в секунду, 

                        ; = #channels*#bitrate/8*#samplerate



Global maxAmp.l  

maxAmp = Pow(2, #bitrate-1)-1

maxAmp=maxAmp*0.5 



Structure PBUnion       ; структура для доступа к памяти

  StructureUnion        ; разделяем на поля

    w.w                 ; для доступа к word (к двумбайтам)

    l.l                 ; для доступа к long (к четырем байтам)

  EndStructureUnion 

EndStructure 



Structure MIXERCONTROL 

  cbStruct.l 

  dwControlID.l 

  dwControlType.l 

  fdwControl.l 

  cMultipleItems.l 

  szShortName.b[#MIXER_SHORT_NAME_CHARS] 

  szName.b[#MIXER_LONG_NAME_CHARS]; 

  lMinimum.l 

  lMaximum.l 

  dwMinimum.l 

  dwMaximum.l 

  Reserved.l[6]; 

  cSteps.l 

  cbCustomData.l; 

  dwReserved.l[6]; 

EndStructure 



Structure MIXERCONTROLDETAILSUNSIGNED 

  dwValue.l 

EndStructure 

После этого следуют основные процедуры работы с регуляторами громкости микшера и линии WAVE:

; Процедура- чтение общего регулятора громкости микшера

Procedure GetSpekearVolumeCtl(mixer,*control.MIXERCONTROL)                

  line.MIXERLINE 

  controls.mixerlinecontrols 

  FillMemory(line,SizeOf(MIXERLINE))

  line\cbStruct = SizeOf(MIXERLINE) 

  line\dwComponentType = #MIXERLINE_COMPONENTTYPE_DST_SPEAKERS

  Result = mixerGetLineInfo_(mixer,line,#MIXER_GETLINEINFOF_COMPONENTTYPE) 

  If Result = #MMSYSERR_NOERROR 

    FillMemory(controls, SizeOf(mixerlinecontrols)); 

    controls\cbStruct = SizeOf(mixerlinecontrols); 

    controls\dwLineID = line\dwLineID; 

    controls\cControls = 1; 

    controls\dwControlType = #MIXERCONTROL_CONTROLTYPE_VOLUME; 

    controls\cbmxctrl = SizeOf(MIXERCONTROL); 

    controls\pamxctrl = *control; 

    Result = mixerGetLineControls_(mixer,controls,#MIXER_GETLINECONTROLSF_ONEBYTYPE)

  EndIf 

  ProcedureReturn Result 

EndProcedure 



 ; Процедура- чтение общего выключателя звука микшера

Procedure GetSpekearMuteCtl(mixer,*control.MIXERCONTROL)                 

  line.MIXERLINE 

  controls.mixerlinecontrols 

   FillMemory(line,SizeOf(MIXERLINE))

  line\cbStruct = SizeOf(MIXERLINE) 

  line\dwComponentType = #MIXERLINE_COMPONENTTYPE_DST_SPEAKERS

  Result = mixerGetLineInfo_(mixer,line,#MIXER_GETLINEINFOF_COMPONENTTYPE) 

  If Result = #MMSYSERR_NOERROR 

    FillMemory(controls, SizeOf(mixerlinecontrols)); 

    controls\cbStruct = SizeOf(mixerlinecontrols); 

    controls\dwLineID = line\dwLineID; 

    controls\cControls = 1; 

    controls\dwControlType = #MIXERCONTROL_CONTROLTYPE_MUTE;

    controls\cbmxctrl = SizeOf(MIXERCONTROL); 

    controls\pamxctrl = *control; 

    Result = mixerGetLineControls_(mixer,controls,#MIXER_GETLINECONTROLSF_ONEBYTYPE)

  EndIf 

  ProcedureReturn Result 

EndProcedure 



; Процедура- чтение регулятора громкости линии WAVE

Procedure GetWaveVolumeCtl(mixer,*control.MIXERCONTROL)                   

  line.MIXERLINE 

  controls.mixerlinecontrols 

  FillMemory(line,SizeOf(MIXERLINE))

  line\cbStruct = SizeOf(MIXERLINE) 

  line\dwComponentType = #MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT; 

  Result = mixerGetLineInfo_(mixer,line,#MIXER_GETLINEINFOF_COMPONENTTYPE) 

  If Result = #MMSYSERR_NOERROR 

    FillMemory(controls, SizeOf(mixerlinecontrols)); 

    controls\cbStruct = SizeOf(mixerlinecontrols); 

    controls\dwLineID = line\dwLineID; 

    controls\cControls = 1; 

    controls\dwControlType = #MIXERCONTROL_CONTROLTYPE_VOLUME; 

    controls\cbmxctrl = SizeOf(MIXERCONTROL); 

    controls\pamxctrl = *control; 

    Result = mixerGetLineControls_(mixer,controls,#MIXER_GETLINECONTROLSF_ONEBYTYPE)

  EndIf 

  ProcedureReturn Result 

  

EndProcedure



; чтение выключателя звука линии WAVE 

Procedure GetWaveMuteCtl(mixer,*control.MIXERCONTROL)                     

  line.MIXERLINE 

  controls.mixerlinecontrols 

   FillMemory(line,SizeOf(MIXERLINE))

  line\cbStruct = SizeOf(MIXERLINE) 

  line\dwComponentType = #MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT

  Result = mixerGetLineInfo_(mixer,line,#MIXER_GETLINEINFOF_COMPONENTTYPE) 

  If Result = #MMSYSERR_NOERROR 

    FillMemory(controls, SizeOf(mixerlinecontrols)); 

    controls\cbStruct = SizeOf(mixerlinecontrols); 

    controls\dwLineID = line\dwLineID; 

    controls\cControls = 1; 

    controls\dwControlType = #MIXERCONTROL_CONTROLTYPE_MUTE;

    controls\cbmxctrl = SizeOf(MIXERCONTROL); 

    controls\pamxctrl = *control; 

    Result = mixerGetLineControls_(mixer,controls,#MIXER_GETLINECONTROLSF_ONEBYTYPE)

  EndIf 

  ProcedureReturn Result 



EndProcedure



; чтение значения громкости общего регулятора громкости

Procedure GetSpekearVolume(mixer)                                         

  MasterVolume.MIXERCONTROL 

  Details.MIXERCONTROLDETAILS 

  UnsignedDetails.MIXERCONTROLDETAILSUNSIGNED 

  code.l=GetSpekearVolumeCtl(mixer,MasterVolume) 

  If code=#MMSYSERR_NOERROR 

    Details\cbStruct = SizeOf(MIXERCONTROLDETAILS); 

    Details\dwControlID = MasterVolume\dwControlID; 

    Details\cChannels = 1;  // set all channels 

    Details\Item = 0; 

    Details\cbDetails = SizeOf(MIXERCONTROLDETAILSUNSIGNED); 

    Details\paDetails = @UnsignedDetails; 

    code=mixerGetControlDetails_(mixer,Details, #MIXER_SETCONTROLDETAILSF_VALUE); 

  EndIf 

  ProcedureReturn UnsignedDetails\dwValue 

  EndProcedure

 

 ; чтение состояния общего выключателя звука

Procedure GetSpekearMute(mixer)                                          

  MasterVolume.MIXERCONTROL 

  Details.MIXERCONTROLDETAILS 

  UnsignedDetails.MIXERCONTROLDETAILSUNSIGNED 

  code.l 

  code=GetSpekearMuteCtl(mixer,MasterVolume) 

  If code=#MMSYSERR_NOERROR 

    Details\cbStruct = SizeOf(MIXERCONTROLDETAILS); 

    Details\dwControlID = MasterVolume\dwControlID; 

    Details\cChannels = 1;  // set all channels 

    Details\Item = 0; 

    Details\cbDetails = SizeOf(MIXERCONTROLDETAILSUNSIGNED); 

    Details\paDetails = @UnsignedDetails; 

    code=mixerGetControlDetails_(mixer,Details, #MIXER_SETCONTROLDETAILSF_VALUE); 

  EndIf 

  ProcedureReturn UnsignedDetails\dwValue 

 EndProcedure



; чтение значения громкости регулятора громкости линии Wave 

Procedure GetWaveVolume(mixer)                                           

  MasterVolume.MIXERCONTROL 

  Details.MIXERCONTROLDETAILS 

  UnsignedDetails.MIXERCONTROLDETAILSUNSIGNED 

  code.l=GetWaveVolumeCtl(mixer,MasterVolume) 

  If code=#MMSYSERR_NOERROR 

    Details\cbStruct = SizeOf(MIXERCONTROLDETAILS); 

    Details\dwControlID = MasterVolume\dwControlID; 

    Details\cChannels = 1;  // set all channels 

    Details\Item = 0; 

    Details\cbDetails = SizeOf(MIXERCONTROLDETAILSUNSIGNED); 

    Details\paDetails = @UnsignedDetails; 

    code=mixerGetControlDetails_(mixer,Details, #MIXER_SETCONTROLDETAILSF_VALUE); 

  EndIf 

  ProcedureReturn UnsignedDetails\dwValue 



 EndProcedure

 

 ; чтение состояния выключателя звука на линии WAVE

Procedure GetWaveMute(mixer)                                             

  MasterVolume.MIXERCONTROL 

  Details.MIXERCONTROLDETAILS 

  UnsignedDetails.MIXERCONTROLDETAILSUNSIGNED 

  code.l 

  code=GetWaveMuteCtl(mixer,MasterVolume) 

  If code=#MMSYSERR_NOERROR 

    Details\cbStruct = SizeOf(MIXERCONTROLDETAILS); 

    Details\dwControlID = MasterVolume\dwControlID; 

    Details\cChannels = 1;  // set all channels 

    Details\Item = 0; 

    Details\cbDetails = SizeOf(MIXERCONTROLDETAILSUNSIGNED); 

    Details\paDetails = @UnsignedDetails; 

    code=mixerGetControlDetails_(mixer,Details, #MIXER_SETCONTROLDETAILSF_VALUE); 

  EndIf 

  ProcedureReturn UnsignedDetails\dwValue 



 EndProcedure

 

 ; чтение минимального значения громкости общего регулятора  

Procedure GetSpekearVolumeMinimum(mixer)                               

  Volume.MIXERCONTROL 

  GetSpekearMuteCtl(mixer,Volume) 

  ProcedureReturn Volume\lMinimum 

EndProcedure 



; чтение максимального значенияобщего регулятора

Procedure GetSpekearVolumeMaximum(mixer)                                  

  Volume.MIXERCONTROL 

  GetSpekearVolumeCtl(mixer,Volume) 

  ProcedureReturn Volume\lMaximum 

EndProcedure 



 ; чтение минимального значения регулятора громкости на линии WAVE

Procedure GetWaveVolumeMinimum(mixer)                                   

  Volume.MIXERCONTROL 

  GetWaveMuteCtl(mixer,Volume) 

  ProcedureReturn Volume\lMinimum 

EndProcedure 



; чтение максимального значения регулятора громкости на линии WAVE

Procedure GetWaveVolumeMaximum(mixer)                                     

  Volume.MIXERCONTROL 

  GetWaveVolumeCtl(mixer,Volume) 

  ProcedureReturn Volume\lMaximum 

EndProcedure 



; установка громкости общего регулятора

Procedure SetSpekearVolume(mixer,value)                                   

  MasterVolume.MIXERCONTROL 

  Details.MIXERCONTROLDETAILS 

  UnsignedDetails.MIXERCONTROLDETAILSUNSIGNED 

  code.l=GetSpekearVolumeCtl(mixer,MasterVolume) 

  If code=#MMSYSERR_NOERROR 

    Details\cbStruct = SizeOf(MIXERCONTROLDETAILS); 

    Details\dwControlID = MasterVolume\dwControlID; 

    Details\cChannels = 1;  // set all channels 

    Details\Item = 0; 

    Details\cbDetails = SizeOf(MIXERCONTROLDETAILSUNSIGNED); 

    Details\paDetails = @UnsignedDetails; 

    UnsignedDetails\dwValue=value 

    code=mixerSetControlDetails_(mixer,Details, #MIXER_SETCONTROLDETAILSF_VALUE); 

  EndIf 

  ProcedureReturn code 

EndProcedure 



; установка общего выключателя звука

Procedure SetSpekearMute(mixer,value)                                     

  MasterVolume.MIXERCONTROL 

  Details.MIXERCONTROLDETAILS 

  UnsignedDetails.MIXERCONTROLDETAILSUNSIGNED 

  code.l 

  

  code=GetSpekearMuteCtl(mixer,MasterVolume) 

  If code=#MMSYSERR_NOERROR 

    Details\cbStruct = SizeOf(MIXERCONTROLDETAILS); 

    Details\dwControlID = MasterVolume\dwControlID; 

    Details\cChannels = 1;  // set all channels 

    Details\Item = 0; 

    Details\cbDetails = SizeOf(MIXERCONTROLDETAILSUNSIGNED); 

    Details\paDetails = @UnsignedDetails; 

    UnsignedDetails\dwValue=value 

    code=mixerSetControlDetails_(mixer,Details, #MIXER_SETCONTROLDETAILSF_VALUE); 

  EndIf 

  ProcedureReturn code 

EndProcedure 



; установка громкости на линии WAVE

Procedure SetWaveVolume(mixer,value)                                      

  MasterVolume.MIXERCONTROL 

  Details.MIXERCONTROLDETAILS 

  UnsignedDetails.MIXERCONTROLDETAILSUNSIGNED 

  code.l=GetWaveVolumeCtl(mixer,MasterVolume) 

  If code=#MMSYSERR_NOERROR 

    Details\cbStruct = SizeOf(MIXERCONTROLDETAILS); 

    Details\dwControlID = MasterVolume\dwControlID; 

    Details\cChannels = 1;  // set all channels 

    Details\Item = 0; 

    Details\cbDetails = SizeOf(MIXERCONTROLDETAILSUNSIGNED); 

    Details\paDetails = @UnsignedDetails; 

    UnsignedDetails\dwValue=value 

    code=mixerSetControlDetails_(mixer,Details, #MIXER_SETCONTROLDETAILSF_VALUE); 

  EndIf 

  ProcedureReturn code 

EndProcedure 



; установка выключателя звука на линии WAVE

Procedure SetWaveMute(mixer,value)                                        

  MasterVolume.MIXERCONTROL 

  Details.MIXERCONTROLDETAILS 

  UnsignedDetails.MIXERCONTROLDETAILSUNSIGNED 

  code.l 

  

  code=GetWaveMuteCtl(mixer,MasterVolume) 

  If code=#MMSYSERR_NOERROR 

    Details\cbStruct = SizeOf(MIXERCONTROLDETAILS); 

    Details\dwControlID = MasterVolume\dwControlID; 

    Details\cChannels = 1;  // set all channels 

    Details\Item = 0; 

    Details\cbDetails = SizeOf(MIXERCONTROLDETAILSUNSIGNED); 

    Details\paDetails = @UnsignedDetails; 

    UnsignedDetails\dwValue=value 

    code=mixerSetControlDetails_(mixer,Details, #MIXER_SETCONTROLDETAILSF_VALUE); 

  EndIf 

  ProcedureReturn code 

EndProcedure 

 И заключительная  часть кода с функциями по созданию звукового файла, инициализации гаджетов и всей системы:

; создание звукового файла

Procedure MakeSound(fq,time)                                      

  ; общее количетво отсчётов для данной длительности(5 сек.) 

  totalsamples = time*#samplerate 

  ; общее количество байт,занимаеммых данными ИКМ                        

  datachunkBytes = totalsamples * #channels * #bitrate/8

  ; выделяем область памяти для звукового файла (44 байта - заголовок, остальное - данные)

  *sound.l = AllocateMemory(44 + datachunkBytes)          

  ; накладываем структуру для обращения либо к word либо к long

  ; заполняем память звуковым файлом (состоит иззаголовка длиной 44 байта и данных ИКМ)

  ; описание файла RIFF (иднентификатор + длина) - 8 первых байт

  *mem.PBUnion = *sound                                   

  *mem\l = 'FFIR'                 : *mem+4  ; идентификатор файла RIFF

  *mem\l = 36 + datachunkBytes    : *mem+4  ; длина файла RIFF(описание не включается), 

                                            ;т.е общая длина файла минус 8 байт (минус описание)

  *mem\l = 'EVAW'                 : *mem+4  ; идентификатор типа файла - "WAVE"

  *mem\l = ' tmf'                 : *mem+4  ; идентификатор блока формата файла - "fmt "

  *mem\l = 16                     : *mem+4  ; длина блока формата (16 байт - последующие 16 байт)

  *mem\w = 1                      : *mem+2  ; код компрессии ((занимает 2байта)

  *mem\w = #channels              : *mem+2  ; количество каналов ((занимает 2байта)

  *mem\l = #samplerate            : *mem+4  ; отсчётов в секунду (частота дискретизации) ((занимает4 байта)

  *mem\l = #avBytesPerSec         : *mem+4  ; байтов в секунду, 

                                            ;(channels)*(block align)*(samplerate) ((занимает 4байта)

  *mem\w = #bitrate/8*#channels   : *mem+2  ; байт на отсчёт (2байта)

  *mem\w = #bitrate               : *mem+2  ; значащих битов на отсчёт (занимает 2 байта)

  *mem\l = 'atad'                 : *mem+4  ; идентификатор блока данных -"data" 

  *mem\l = datachunkBytes         : *mem+4  ; длина блока данных 

  ;начиная от начала блока данныхдо конца

  For acttime = 1 To totalsamples

    ; записываем два байта данных                        ;

    *mem\w = maxAmp * (Sin(2 * #PI * fq * acttime / #samplerate))   

    ; перемещаем указатель на следующее слово в блоке

    *mem+2                                                          

  Next   ; конец цикла

  ; указываем на зввуковой файл (загружаем его в звуковоую систему)                                                           

  CatchSound(0, *sound)                                                

  vol.d=(GetWaveVolumeMaximum(0)*numU)/ (ogrU-1)

  SetWaveVolume(0,vol)

EndProcedure





;новая кнопка

Procedure ButtonGadgetNew _

_(num, x, y, w, h, text$,FontName$="MS Sans Serif", FontSize=8,FontColor=#Black ) 

  buttonBack = GetSysColor_(#COLOR_BTNFACE)

  thisImg = CreateImage(#PB_Any, w, h)

  a=LoadFont(#PB_Any,FontName$,FontSize)

  StartDrawing(ImageOutput(thisImg))

    Box(0, 0, w, h, buttonBack)

    DrawingFont(FontID(a))

    DrawText((w - TextWidth(text$))/2, (h - TextHeight(text$))/2, text$, FontColor, buttonBack)

  StopDrawing()

  gadId = ButtonImageGadget(num, x, y, w, h, ImageID(thisImg))

  ProcedureReturn gadId

EndProcedure



 ; инициализация микшера

Procedure MixerInit()                                                    

  ; сброс громкости линии WAVE

  SetWaveVolume(0,GetWaveVolumeMinimum(0))    

  ; сьброс громкости общего регулятора           

  SetSpekearVolume(0,GetSpekearVolumeMinimum(0))

  ; выключение звука общего выключателя звука          

  SetSpekearMute(0,1)       

  ; выключение звука выключателя линии WAVE                             

  SetWaveMute(0,1)                  

  ; установка громкости линии WAVE на половину от максимально возможного

  SetWaveVolume(0,GetWaveVolumeMaximum(0)) 

  ; установка громкости общего регулятора на половину от максимально возможного

  SetSpekearVolume(0,GetSpekearVolumeMaximum(0)) 

  ; включение звука общего выключателя звука      

  SetSpekearMute(0,0)                

  ; включение звука выключателя линии WAVE                    

  SetWaveMute(0,0)                                        

EndProcedure



; начальная инициализация

Procedure Init()                                                          

Font1 = FontID(LoadFont(#PB_Any, "MS Sans Serif",  9, #PB_Font_Bold))

  Font2 = FontID(LoadFont(#PB_Any, "MS Sans Serif",  14))

  ContainerGadget(#panF, 4, 4, 154, 185, #PB_Container_Flat)

  TextGadget(#txtF,7,7,135,40,"0",#PB_Text_Right|#PB_Text_Border)

  SetGadgetFont(#txtF,LoadFont(#txtF, "Impact", 22, 0))

  SetGadgetColor(#txtF,#PB_Gadget_BackColor ,$444444)

  SetGadgetColor(#txtF,#PB_Gadget_FrontColor,$DD00)

  TextGadget(#lblF,9,52,135,40,"Частота (Гц)")

  SetGadgetFont(#lblF,Font1)

  SetGadgetColor(#lblF,#PB_Gadget_FrontColor, $a00000)

  For i=0 To 3: ButtonGadgetNew(i,i*36+6,75,30,30,Trim(Str(i)),"",14, $a00000):  Next

  For i=0 To 3: ButtonGadgetNew(i+4,i*36+6,110,30,30,Trim(Str(i+4)),"",14, $a00000):  Next

  For i=0 To 3: 

    If i<2 

      ButtonGadgetNew(i+8,i*36+6,145,30,30,Trim(Str(i+8)),"",14, $a00000): 

    Else

      If i=2

          ButtonGadgetNew(i+8,i*36+6,145,30,30,">>","",14, $005000)

      Else

          ButtonGadgetNew(i+8,i*36+6,145,30,30,"C","",14, $0000a0)

      EndIf

    EndIf

  Next

  CloseGadgetList()

  ContainerGadget(#panU, 163, 4, 154, 185, #PB_Container_Flat)

  TextGadget(#txtU,7,7,135,40,"0",#PB_Text_Right|#PB_Text_Border)

  SetGadgetFont(#txtU,LoadFont(#txtU, "Impact", 22, 0))

  SetGadgetColor(#txtU,#PB_Gadget_BackColor ,$444444)

  SetGadgetColor(#txtU,#PB_Gadget_FrontColor,$DD00)

  TextGadget(#lblU,9,52,135,40,"Амплитуда (мВ)")

  SetGadgetFont(#lblU,Font1)

  SetGadgetColor(#lblU,#PB_Gadget_FrontColor, $a00000)

  For i=0 To 3: ButtonGadgetNew(12+i,i*36+6,75,30,30,Trim(Str(i)),"",14, $a00000):  Next

  For i=0 To 3: ButtonGadgetNew(12+i+4,i*36+6,110,30,30,Trim(Str(i+4)),"",14, $a00000):  Next

  For i=0 To 3: 

    If i<2 

      ButtonGadgetNew(12+i+8,i*36+6,145,30,30,Trim(Str(i+8)),"",14, $a00000): 

    Else

      If i=2

          ButtonGadgetNew(12+i+8,i*36+6,145,30,30,">>","",14, $005000)

      Else

          ButtonGadgetNew(12+i+8,i*36+6,145,30,30,"C","",14, $0000a0)

      EndIf

    EndIf

  Next

  CloseGadgetList()



  ButtonGadget(#cmdPusk,325,158,65,30,"ПУСК")

  ButtonGadget(#cmdStop,398,158,65,30,"СТОП")

  DisableGadget(#cmdStop,1)

  numF=0:stgF="0":numU=0:stgU="0"

  numForm=200:numStatus=0

  InitSound()                   ; инициализация звуковой системы

  MixerInit()

EndProcedure



; чтоб не глючило

Procedure DoEvents()                                                      

  While WindowEvent() : Wend

EndProcedure



Procedure cmdStop_Click()

  DisableGadget(#cmdPusk,0)

  DisableGadget(#cmdStop,1)

  DisableGadget(#panF,0)

  DisableGadget(#panU,0)

  StopSound(0)

  FreeSound(0)

EndProcedure



Procedure cmdPusk_Click()

  If numF<20 Or numU<1

    a$=a$+"С данными параметрами частоты и(или) амплитуды работа невозможна."+Chr(10)

    a$=a$+"Попробуйте установитьт другие параметры."+Chr(10)+Chr(10)

    a$=a$+"Частота   - в диапозоне от 20 Гц до "+Str(ogrF)+" Гц"+Chr(10)

    a$=a$+"Амплитуда - в диапозоне от 1 мВ до "+Str(ogrU)+" мВ"+Chr(10)

    MessageRequester("Внимание",a$, 64)

    ProcedureReturn

  EndIf

  DisableGadget(#cmdPusk,1)

  DisableGadget(#cmdStop,0)

  DisableGadget(#panF,1)

  DisableGadget(#panU,1)

  MakeSound(numF,10)   ; создаём звуковой файл

  PlaySound(0,1)       ; проиигрывем

EndProcedure



Procedure cmdF_Click(Ind)

  strTmp.s=stgF               ; объявляем временную переменную, равную глобальной (частота)

  Select Ind                  ; проверка какая кнопка нажата

    Case 0 To 9               ; если цифры от 0 до 9, то

      If strTmp="0" And Ind=0 ; если нажат 0 и был ноль

        strTmp="0"            ; то временная =0

      Else                    ; иначе (если нажат не ноль)

        If strTmp="0"         ; если временная ноль

          strTmp=""           ; то делаем её пустую (чтобыубрать ноль в начале)

        EndIf                 ; конец условия

        strTmp=strTmp+Str(Ind); присоединяем нажатую цифру к уже имеющейся

      EndIf                   ; конец условия

    Case 10                   ; при нажатии сдвига

      If strTmp<>"0"          ; если временная не ноль, то

        strTmp=Mid(strTmp,1,Len(strTmp)-1)    ; отрываем от неё крайний правый символ

        If strTmp="": strTmp="0": EndIf       ; если в итоге пустая строка, то делаем её нолём

      EndIf                                   ; конец условия

    Case 11                                   ; при нажатии сброса

      strTmp="0"                              ; устанавливаем временную в ноль

  EndSelect                                   ; конец проверки какая кнопка нажата

  a=Val(strTmp)                               ; переводим в число значение частоты

  If a
    SetGadgetText(#txtF,strTmp)               ; устанавливаем в текстовом поле

    stgF=strTmp                               ; присваеваем глобальной переменной строковой и 

    numF=a                                    ; числовой

  EndIf                                       ; конец условия

EndProcedure



Procedure cmdU_Click(Ind)

  Ind=Ind-12

  strTmp.s=stgU                ; объявляем временную переменную, равную глобальной (частота)

  Select Ind                   ; проверка какая кнопка нажата

    Case 0 To 9                ; если цифры от 0 до 9, то

      If strTmp="0" And Ind=0  ; если нажат 0 и был ноль

        strTmp="0"             ; то временная =0

      Else                     ; иначе (если нажат не ноль)

        If strTmp="0"          ; если временная ноль

          strTmp=""            ; то делаем её пустую (чтобыубрать ноль в начале)

        EndIf                  ; конец условия

        strTmp=strTmp+Str(Ind) ; присоединяем нажатую цифру к уже имеющейся

      EndIf                                   ; конец условия

    Case 10                                   ; при нажатии сдвига

      If strTmp<>"0"                          ; если временная не ноль, то

        strTmp=Mid(strTmp,1,Len(strTmp)-1)    ; отрываем от неё крайний правый символ

        If strTmp="": strTmp="0": EndIf       ; если в итоге пустая строка, то делаем её нолём

      EndIf                                   ; конец условия

    Case 11                                   ; при нажатии сброса

      strTmp="0"                              ; устанавливаем временную в ноль

  EndSelect                                   ; конец проверки какая кнопка нажата

  a=Val(strTmp)                               ; переводим в число значение частоты

  If a
    SetGadgetText(#txtU,strTmp)               ; устанавливаем в текстовом поле

    stgU=strTmp                               ; присваеваем глобальной переменной строковой и 

    numU=a                                    ; числовой

  EndIf                                       ; конец условия

 

EndProcedure



Procedure MainLoop()

  Repeat                                    ; Начало главного цикла.

    Event=WaitWindowEvent()                 ; Получаем идентификатор события.

    Select Event                            ; Анализ этого идентификатора

      Case #PB_Event_Gadget                 ; Если событие от гаджета, то

        Gadget=EventGadget()                ; Узнаём идентификатор активизировавшегося гаджета.

        Select Gadget                       ; Анализируем этот идинтефикатор

          Case 0 To 11 : cmdF_Click(Gadget) ; кнопка  Частота идём на процедуру cmdF_Click

          Case 12 To 23: cmdU_Click(Gadget) ; кнопка  Амплитуда идём на процедуру cmdU_Click

          Case #cmdPusk: cmdPusk_Click()

          Case #cmdStop: cmdStop_Click()

        EndSelect                           ; завершение идентификатора активизировавшегося гаджета

    EndSelect                               ; Завершение анализа идентификатора события

  Until Event = #PB_Event_CloseWindow       ; Прерываем цикл если событие - закрыть окно 

EndProcedure



; Создаём окно.

OpenWindow(#frmMain,0,0,466,194,"Синусоидальный генератор НЧ", 

#PB_Window_SystemMenu|#PB_Window_ScreenCentered)     

  Init()            ; Начальня инициализация

  MainLoop()        ; Основной цикл

End