|
Таблица
21. Протокол расчета сметы затрат и цены НИР
|
|
|
|
|
|
5.3 Оценка экономической
эффективности НИР
В данном дипломном проекте была
разработана система регистрации речи диспетчерских переговоров. При создании
системы был решен целый ряд проблем, которые позволят владельцу системы более
эффективно организовать работу. Этими проблемами являются: возможность
диспетчера отчитаться за требуемый период времени (запись разговора в файл и
регистрация события в базе данных), проблема экономии места на жестком диске
(сжатие звуковых данных), в техническом плане – освобождение рук оператора от
трубки телефона (подключение телефонной гарнитуры к модему).
Выше сказанное позволяет судить об
актуальности и говорит о возможности внедрения этой системы на предприятиях
представляющих собой таксопарки.
Экономический эффект может быть
достигнут вследствие, снижения стоимости аппаратных средств (за счет сжатия
звуковых данных), а также в результате более эффективной организации работы
диспетчера.
6 Безопасность и
экологичность проекта.
6.1
Вступление
Проблемы
безопасности человека необходимо решать на всех стадиях жизненного цикла, будь
то разработка, внедрение в жизнь или эксплуатация программы.
Так как
основная часть дипломного проекта – разработка программы, осуществлялась с
помощью ПЭВМ, которая является потребителем
электроэнергии. Поэтому значение здесь имеет вопрос об экономном расходе
данного вида ресурса. Но так ПЭВМ является экологически чистым оборудованием, то основное внимание
в данном разделе будет уделяться безопасности разработчика программы.
Обеспечение
безопасности человека в значительной степени зависит от правильной оценки
опасных, вредных производственных факторов. Одинаковые по тяжести изменения в
организме человека могут быть вызваны различными причинами. Это могут быть
какие-либо факторы производственной среды, чрезмерная физическая и умственная
нагрузка, нервно-эмоциональное напряжение, а также разное сочетание этих
причин.
В
данной главе решаются вопросы безопасной жизнедеятельности на стадии
разработки программного и методического обеспечения.
Зал
вычислительного центра (ВЦ), в котором производилась разработка дипломного
проекта, имеет следующие параметры:
размеры помещения – 6 х 4 м;
высота потолка – 3.00 м;
количество рабочих мест с ПЭВМ – 6 (работают
инженеры-программисты);
2 окна размером 2´2 м;
1 дверь размером 0.9´2.1 м.
Программисты
работают на ПЭВМ мониторы, которых выполнены на базе ЭЛТ.
Питание
электрооборудования осуществляется от трёхфазной сети переменного тока частотой
50 Гц напряжением 380/220 В с глухозаземленной нейтралью .
6.2 Анализ опасных и вредных
факторов, воздействующих на разработчика при разработке данной системы.
Опасные
и вредные производственные факторы по природе возникновения
делятся на следующие группы:
-физические;
-химические;
-психофизиологические;
-биологические.
В
помещении ВЦ на программиста могут негативно действовать следующие физические
факторы согласно
ГОСТ 12.0.003-74*[1]:
-неблагоприятные
параметры воздушной среды;
-недостаточная
освещенность рабочего места;
-блескость экрана
дисплея.
-превышающий допустимые
нормы шум;
-повышенный уровень
ионизирующего излучения;
-повышенный уровень
электромагнитных полей;
-повышенный уровень
статического электричества;
-мягкое рентгеновское
излучение;
-ионизация воздуха;
-опасность поражения
электрическим током;
К
химически опасным факторам, постоянно действующим на программиста относятся
следующие:
-возникновение, в
результате ионизации воздуха при работе компьютера, активных частиц.
Биологические
вредные производственные факторы в данном помещении отсутствуют.
К
психофизиологическим вредным факторам, воздействующим на оператора в течение
его рабочей смены можно отнести следующие:
-нервно
- психические перегрузки;
-физическая
перегрузка мышц;
-монотонность
труда;
-малая
частота регенерации изображения.
Далее
более подробно рассмотрены опасные и вредные факторы, воздействующие на
программиста, возникшие в связи с разработкой данной системы.
6.2.1 Микроклимат рабочей зоны
разработчика.
Микроклимат
производственных помещений - это климат внутренней среды этих помещений,
который определяется действующими на организм человека сочетаниями температуры,
влажности и скорости движения воздуха.
Работа
в ВЦ согласно СанПиН
2.2.2/2.4.1340-03[2] ( с энергозатратами до 120 ккал/час) относится к 1а
категории, поэтому должны соблюдаться следующие требования:
-в
холодный период года: температура 22-24°С, влажность воздуха 40-60%, скорость движения воздуха
0.1 м/с.
-в тёплый
период года: температура 23-25°С, влажность воздуха 40-60%, скорость движения воздуха 0.1 м/с.
Для
создания и автоматического поддержания в лаборатории независимо от наружных
условий оптимальных значений температуры, влажности, чистоты и скорости
движения воздуха, в холодное время года используется водяное отопление, в
теплое время года применяется кондиционирование воздуха. Кондиционер
представляет собой вентиляционную установку, которая с помощью приборов
автоматического регулирования поддерживает в помещении заданные параметры
воздушной среды.
6.2.2 Освещение рабочего места
Работа,
выполняемая с использованием вычислительной техники, имеет следующие
недостатки:
-
вероятность появления прямой блескости;
-
ухудшенная контрастность между изображением и фоном;
-
отражение экрана.
-пульсация
света.
В
связи с тем, что естественное освещение слабое, на рабочем месте должно
применяться также искусственное освещение.
Требования к искусственному
освещению описаны в ГОСТ Р 50923-96[3] и СанПиН
2.2.2/2.4.1340-03[2]
для работников вычислительных центров.
Искусственное освещение в
помещениях эксплуатации ПЭВМ осуществляется системой
общего равномерного освещения.
В производственных и
административно-общественных помещениях, в случаях
преимущественной работы с документами, разрешено применение системы комбинированного освещения (к общему освещению дополнительно устанавливаются светильники местного освещения, предназначенные для
освещения зоны расположения документов).
Освещенность на поверхности
стола в зоне размещения рабочего документа должна быть
300-500 лк(оптимальная-400лк), также допускается установка светильников местного освещения для подсветки документов, но с таким условием, чтобы оно не создавало бликов на поверхности экрана и не увеличивало освещенность экрана более чем на 300 лк относительно
оптимальной.
В качестве источников света
при искусственном освещении должны применяться преимущественно
люминесцентные лампы типа ЛБ. При устройстве отраженного
освещения в административно-общественных помещениях допускается применение
металлогалогенных ламп мощностью до 250 Вт. Допускается
применение ламп накаливания в светильниках местного
освещения.
Общее освещение следует
выполнять в виде сплошных или прерывистых линий
светильников, расположенных сбоку от рабочих мест, параллельно линии зрения пользователя при рядном расположении ПЭВМ. При периметральном расположении компьютеров линии светильников должны располагаться локализовано над рабочим столом, ближе к его переднему краю, обращенному к оператору.
Для обеспечения нормируемых
значений освещенности в помещениях использования ПЭВМ следует проводить чистку
стекол оконных рам и светильников не реже двух раз в год и проводить
своевременную замену перегоревших ламп.
6.2.3 Воздействие шума на разработчика.
Защита от шума.
В
помещениях с низким уровнем общего шума, каким является ВЦ, где работает
программист, источниками шумовых помех могут стать вентиляционные установки,
кондиционеры и принтеры. Длительное воздействие этих шумов отрицательно
сказываются на эмоциональном состоянии персонала, от чего увеличивается число
ошибок и падает производительность труда.
Согласно
ГОСТ Р 50923-96[3] и СН 2.2.4/2.1.8.562-03[2] эквивалентный
уровень звука не должен превышать 50 дБА, так как наше помещение расположено в
жилом общественном здании.
В качестве мер по
снижению шума можно предложить следующее:
-облицовка
потолка и стен звукопоглощающим материалом;
-
экранирование рабочего места (постановкой перегородок);
-
установка в компьютерных помещениях оборудования, производящего минимальный
шум;
-
рациональная планировка помещения.
Защиту
от шума следует выполнять в соответствии с ГОСТ 12.1.029-80[5]
6.2.4 Опасность повышенного уровня
напряженности электромагнитного поля.
Электромагнитные
поля, характеризующиеся напряженностями электрических и магнитных полей,
наиболее вредны для организма человек. Основным источником этих проблем,
связанных с охраной здоровья людей, использующих в своей работе
автоматизированные информационные системы на основе персональных компьютеров,
являются дисплеи (мониторы), особенно дисплеи с электронно-лучевыми трубками.
Они представляют собой источники наиболее вредных излучений, неблагоприятно
влияющих на здоровье программиста.
Существуют два
основополагающих стандарта в этой области: ГОСТ Р 50948-96[6] и
ГОСТ Р 50949-96[7] .
Ниже приведены
нормы по электрическим и магнитным полям согласно СанПиН 2.2.2/2.4.1340-03[2].
-Напряжённость переменного
электрического поля на расстоянии 50 см вокруг дисплея:
в
диапазоне частот 5 Гц – 2 Кгц: не более 25 В/м;
в
диапазоне частот2 Кгц – 400 Кгц: не более 2.5 В/м.
-Плотность магнитного потока
(магнитная индукция):
в
диапазоне частот 5 Гц – 2 Кгц: не более 250 нТл;
в
диапазоне частот2 Кгц – 400 Кгц: не более 25 нТл.
-
Напряженность электростатического поля не более 15 кВ/м.
ГОСТ Р 51658-2000[14] -
стандарт устанавливает требования к визуальным параметрам защитных фильтров,
параметрам экранировки по электростатическому и переменным электрическим полям.
Поля, порождённые посторонними источниками (фоновые поля), определяются
физическими особенностями этих источников и положением их по отношению к
рабочему месту. Часто фоновые поля имеют общий источник – сеть электропитания,
дающую существенный вклад на частоте 50 Гц и её гармониках. Этот вклад во
многом зависит от правильности организации электросети и контура зануления,
удалённости и расположения рабочего места относительно розеток питания и других
элементов сети. Особого внимания требуют случаи появления экстремальных полей
посторонних источников, которые могут не только многократно превышать гигиенические
требования, но и нарушать нормальную работу ПЭВМ. Исследование причин появления
экстремальных полей, путей их снижения и устранения требует привлечения
специализированных организаций, имеющих опыт решения таких задач и необходимую
для этого аппаратуру.
6.2.5 Электробезопасность. Статическое
электричество.
Питание
электрооборудования осуществляется от трёхфазной сети переменного тока частотой
50 Гц напряжением 380/220 В с глухозаземленной нейтралью.
На рабочем месте
программиста из всего оборудования металлическим
является лишь корпус системного блока компьютера, но здесь используются
системные блоки, отвечающие стандарту фирмы IBM, в которых кроме рабочей
изоляции предусмотрен элемент для заземления и провод с зануляющей жилой для
присоединения к источнику питания. Таким образом,
оборудование выполнено по классу 1 ГОСТ 12.2.007.0-75* [8].
Опасное
и вредное воздействие на людей электрического тока, электрической дуги и
электромагнитных полей проявляется в виде профессиональных заболеваний.
Рассмотрим
основные причины поражения программиста электрическим током на рабочем месте:
- Прикосновение
к металлическим нетоковедущим частям (корпусу, периферии компьютера), которые
могут оказаться под напряжением в результате повреждения изоляции.
-
Нерегламентированное использование электрических приборов.
-
Отсутствие инструктажа сотрудников по ПТЭ и ПТБ[17].
Обеспечение электробезопасности
техническими способами и средствами
Так
как все токоведущие части ЭВМ изолированы, то случайное прикосновение в
процессе работы программиста к токоведущим частям исключено.
Для
обеспечения дополнительной защиты от поражения электрическим током при
прикосновении к металлическим нетоковедущим частям, которые могут оказаться под
напряжением в результате повреждения изоляции, рекомендуется применять
защитное зануление.
Зануление
металлических частей системного блока ЭВМ обеспечено подведением зануляющей
жилы к питающим розеткам. Сопротивление заземления нейтрали 4 Ом, согласно
ПУЭ-03[15] для электроустановок с напряжением до 1000 В.
Организационные и технические
мероприятия по обеспечению электробезопасности
Основным
организационным мероприятием является инструктаж и обучение безопасным методам
труда, а так же проверка знаний правил безопасности и инструкций в соответствии
с занимаемой должностью применительно к выполняемой работе.
При
проведении незапланированного и планового ремонта вычислительной техники
выполняются следующие действия:
-
Отключение компьютера от сети
-
Проверка отсутствия напряжения
После
выполнения этих действий проводится ремонт неисправного оборудования. Ремонт
необходимо производить в специально оборудованном помещении.
Если
ремонт проводится на токоведущих частях, находящихся под напряжением, то
выполнение работы проводится не менее чем двумя лицами с применением
электрозащитных средств.
6.3 Организация рабочего места
разработчика.
Производственная
деятельность программиста, заставляет его продолжительное время находиться в
сидячем положении, которое является вынужденной позой, поэтому организм
постоянно испытывает недостаток в подвижности и активной физической
деятельности. При выполнении работы, сидя, большую роль играет плечевой пояс.
Перемещение рук в пространстве влияет не только на работу мышц плечевого пояса
и спины, но и на положение позвоночника, таза и даже ног.
Чтобы
исключить возникновение заболеваний необходимо иметь возможность свободной
перемены поз. Необходимо соблюдать режим труда и отдыха с перерывами,
заполняемыми "отвлекающими" мышечными нагрузками на те звенья
опорно-двигательного аппарата, которые не включены в поддержание основной
рабочей позы. (ГОСТ Р 50923-96[3] )
Антропологические
характеристики человека определяют габаритные и компоновочные параметры его
рабочего места, а также свободные параметры отдельных его элементов.
По
условиям работы рабочее место программиста относится к индивидуальному рабочему
месту для работы сидя.
Рабочее
место программиста согласно СанПиН 2.2.2/2.4.1340-03[2] должно занимать площадь
не менее 6 м2 на одного человека, так как используются мониторы на базе ЭЛТ.
После
проведения анализа рабочего места программиста в ВЦ было выяснено, что площадь
данного рабочего места составляет 4 м2, что не соответствует приведенным
требованиям. Также в результате анализа были выявлены нарушения в организации
непосредственно самого рабочего места программиста. В связи с этим предлагается
организовать рабочее место программиста, следующим образом. Высота над уровнем
пола рабочей поверхности, за которой работает программист, должна составлять
720 мм. Желательно, чтобы рабочий стол программиста при необходимости можно
было регулировать по высоте в пределах 680 - 780 мм. Оптимальные размеры
поверхности стола 1600 х 1000 кв. мм. Под столом должно иметься пространство
для ног с размерами по глубине 650 мм. Рабочий стол оператора должен также
иметь подставку для ног, расположенную под углом 15° к поверхности стола. Длина
подставки 400 мм, ширина-350 мм. Удаленность клавиатуры от края стола должна
быть не более 300 мм, что обеспечит оператору удобную опору для предплечий.
Расстояние между глазами оператора и экраном видеодисплея должно составлять 40
- 80 см.
Рабочий
стул программиста должен быть снабжен подъемно-поворотным механизмом. Высота
сиденья должна регулироваться в пределах 400 - 500 мм. Глубина сиденья должна
составлять не менее 380 мм, а ширина не менее 400 мм. Высота опорной
поверхности спинки не менее 300 мм, ширина - не менее 380 мм. Угол наклона
спинки стула к плоскости сиденья должен изменяться в пределах 90 - 110°.
6.4 Анализ пожарной безопасности
Степень
огнестойкости зданий принимается в зависимости от их назначения, категории по
взрывопожарной и пожарной опасности, этажности, площади этажа в пределах
пожарного отсека.
Общие требования
по пожарной безопасности регламентируются ГОСТ 12.1.004-91[10].
Здание,
в котором находится ВЦ, по пожарной опасности строительных конструкций
относится к категории К1 (малопожароопасное), поскольку здесь присутствуют
горючие (книги, документы, мебель, оргтехника и т.д.) и трудносгораемые
предметы (сейфы, различное оборудование и т.д.).
По
конструктивным характеристикам здание можно отнести к зданиям с несущими и
ограждающими конструкциями из естественных или искусственных каменных
материалов, бетона или железобетона, где для перекрытий допускается
использование деревянных конструкций, защищенных штукатуркой или трудногорючими
листовыми, а также плитными материалами.
Следовательно,
степень огнестойкости здания можно определить как третью (III). ГОСТ Р 22.7.01-99[11], СНиП
2.04.09-84[12].
Помещение
ВЦ по функциональной пожарной опасности относится к классу Ф 4.3 - учреждения органов
управления, проектно-конструкторские организации, информационные и
редакционно-издательские организации, научно-исследовательские организации,
банки, конторы, офисы; СНиП 21-01-97[13].
Для предотвращения возникновения пожара на рабочем месте необходимо
соблюдение правил пожарной безопасности (ППБ 01-03[16]), кроме того, действует
федеральный закон «О пожарной безопасности» № 69-ФЗ (от 21.12.1994г.).
Пожарная профилактика представляет
собой комплекс организационных и технических мероприятий, направленных на
обеспечение безопасности людей, на предотвращении пожара, ограничение его
распространения, а также создание условий для успешного тушения пожара. Для
профилактики пожара чрезвычайно важна правильная оценка пожароопасности здания,
определение опасных факторов и обоснование способов и средств
пожаропредупреждения и защиты ППБ 01-03[16].
Одно
из условий обеспечения пожаробезопасности - ликвидация возможных источников
воспламенения.
В ВЦ
источниками воспламенения могут быть:
-неисправное
электрооборудование, неисправности в электропроводке, электрических розетках и
выключателях. Для исключения возникновения пожара по этим причинам необходимо
вовремя выявлять и устранять неисправности, проводить плановый осмотр и
своевременно устранять все неисправности;
-неисправные
электроприборы. Необходимые меры для исключения пожара включают в себя
своевременный ремонт электроприборов, качественное исправление поломок, не
использование неисправных электроприборов;
-обогревание
помещения электронагревательными приборами с открытыми нагревательными элементами.
Открытые нагревательные поверхности могут привести к пожару, так как в
помещении находятся бумажные документы и справочная литература в виде книг,
пособий, а бумага легковоспламеняющийся предмет. В целях профилактики пожара
предлагается не использовать открытые обогревательные приборы в помещении ВЦ.
-
несоблюдение мер пожарной безопасности, и курение в помещении также может
привести к пожару. Для устранения возгорания в результате курения в помещении
ВЦ предлагается категорически запретить курение, а разрешить только в строго
отведенном для этого месте.
В
целях предотвращения пожара предлагается проводить с инженерами, работающими в
ВЦ, противопожарный инструктаж, на котором ознакомить работников с правилами
противопожарной безопасности, а также обучить использованию первичных средств
пожаротушения.
В
случае возникновения пожара необходимо отключить электропитание, вызвать по
телефону пожарную команду, эвакуировать людей из помещения согласно плану
эвакуации и приступить к ликвидации пожара огнетушителями. При наличии
небольшого очага пламени можно воспользоваться подручными средствами с целью
прекращения доступа к объекту возгорания.
Для тушения пожаров на начальных стадиях широко
применяются огнетушители. По виду используемого
огнетушащего вещества огнетушители подразделяются на
следующие основные группы.
Пенные огнетушители,
применяются для тушения горящих жидкостей, различных материалов,
конструктивных элементов и оборудования, кроме электрооборудования, находящегося под напряжением.
Газовые огнетушители
применяются для тушения жидких и твердых веществ, а также электроустановок,
находящихся под напряжением.
К системам
сигнализации предъявляются следующие технические требования: они должны иметь
минимальную инерционность сработки, обеспечивать заданную достоверность
информации, отсутствие ошибочной сработки; быть надежными в работе при всех
условиях эксплуатации, обеспечивать автономное включение сигнала тревоги.
Основными
элементами пожарной сигнализации являются:
датчики пожарной
сигнализации, которые размещаются в наиболее пожаро- и взрывоопасных местах;
электронно-усилительный
блок, который обеспечивает дистанционный контроль за состоянием датчиков;
исполнительный
блок, с помощью которого включается первый рубеж противопожарной системы и блок
сигнализации.
Датчики – наиболее важный элемент системы сигнализации,
который в основном определяет возможности и характеристики системы в целом.
В качестве
пожарных извещателей выбираем 10 тепловых датчиков типа ИП-103М-5АС; в качестве
средств пожаротушения – один углекислотный огнетушитель ОУ-5, в силу условий,
приведенных выше.
6.5 Расчет искусственного
освещения
Конечной целью расчёта искусственного освещения
является определение типа, числа и расположения светильников, а также типа,
числа и мощности ламп, необходимых для обеспечения требуемого нормативного
уровня освещенности.
Расчёт освещения производился в системе MathCAD 2000. Помещение имеет следующие
характеристики:
Нормативные уровни
освещенности рабочего места осуществляются согласно СНиП 23-05-95[19] .
Eнорм – нормированная минимальная
освещенность для нашего помещения равна 300 лк.
Показатель ослепленности
P=
20 %
Коэффициент пульсаций
освещенности Kп=
15 %
Для искусственного
освещения рабочих мест с ПЭВМ следует использовать люминесцентные лампы,
имеющие высокую световую отдачу (до 75 лм/Вт и более), большой срок службы (до
10000 ч), малую яркость светящейся поверхности, а также близкий к естественному
спектр излучения, что обеспечивает хорошую цветопередачу. Наиболее целесообразным
для применения освещения рабочих мест с ПЭВМ рекомендуются люминесцентные
лампы 36-65 Вт типа ЛБ (белого цвета) или лампы типа ЛТБ (тёпло-белого цвета)
мощностью 20 или 40 Вт.
При питании
газоразрядных ламп от сети переменного тока осветительные установки кроме
нормативных условий освещенности должны также удовлетворять требованию
приемлемого уровня пульсаций освещенности.
В связи с тем, что в
люминесцентных лампах пульсации генерируемого светового потока существенно
сглаживаются люминофором, покрывающим внутреннюю поверхность трубчатой колбы,
можно считать, что при их использовании требования к коэффициенту пульсаций
удовлетворяются автоматически .
Выбирая систему
освещения, необходимо учитывать, что более эффективной является система
комбинированного освещения, но система общего освещения более гигиенична, т.к.
обеспечивает большую равномерность освещенности рабочих поверхностей, поэтому
остановимся на последней.
Тип светильников
определяется с учётом требований к освещению данного помещения, по экономическим
показателям, а также в зависимости от условий среды и требований взрыво- и
пожаробезопасности. Таким образом, конструктивное исполнение светильников
должно соответствовать условиям окружающей среды: влажности, запыленности,
пожаро- и взрывоопасности и другим особенностям производства.
Расположение
светильников оказывает существенное влияние на экономичность, качество и
удобство эксплуатации системы освещения и должно обеспечивать заданные уровни
освещённости на всех рабочих местах при наименьшей мощности установленных ламп.
Это возможно благодаря выбору наивыгоднейшего соотношения между расстоянием
между рядами светильников и высотой подвеса светильника над рабочей
поверхностью.
Поскольку мощность
люминесцентных ламп и их количество в светильнике известны, то расчёт числа
светильников будем вести по формуле (1) .
7
Заключение
В данном дипломном проекте была
разработана система регистрации речи диспетчерских переговоров. При создании
системы был решен целый ряд проблем, которые позволят владельцу системы более
эффективно организовать работу. Этими проблемами являются: возможность
диспетчера отчитаться за требуемый период времени (запись разговора в файл и
регистрация события в базе данных), проблема экономии места на жестком диске
(сжатие звуковых данных), в техническом плане – освобождение рук оператора от
трубки телефона (подключение телефонной гарнитуры к модему).
Использование данной системы возможно
только в том случаи, если установлен механизм работы с базой данных – BDE, а также желательно наличие ОС WidowsXP.
Возможно, также исправление узких мест
системы, если таковые обнаружатся в ходе использования данной системы или же
может иметь место увеличение производительности системы в плане повышения
функциональности (например, добавления возможности распечатки отчетов и т. д.)
Список литературы
1.
ГОСТ 12.0.003-74
“ОПАСНЫЕ И ВРЕДНЫЕ ПРОИЗВОДСТВЕННЫЕ ФАКТОРЫ. Классификация”
2.
СанПиН 2.2.2.542-03
“Гигиенические требования к персональным электронно-вычислительным машинам и
организации работы”
3.
ГОСТ Р 50923-96 “Дисплеи. Рабочее место оператора. Общие
эргономические требования и требования к производственной среде. Методы
измерения.”
4.
СН
2.2.4/2.1.8.562-03 “Шум на рабочих местах в помещениях жилых общественных зданий
и на территории жилой застройки”
5. ГОСТ
12.1.029-80 “Средства и методы защиты от шума. Классификация”
6.
ГОСТ Р 50948-96 “Средства
отображения информации индивидуального пользования. Общие эргономические
требования и требования безопасности”
7.
ГОСТ Р 50949-96 “Средства
отображения информации индивидуального пользования. Методы измерения и оценки
эргономических параметров и параметров безопасности”
8. Гост 12.2.007.0-75* “ИЗДЕЛИЯ ЭЛЕКТРОТЕХНИЧЕСКИЕ.Общие требования
безопасности”
9. ГОСТ
12.1.019-79 “Электробезопасность. Общие требования и номенклатура видов
защиты”
10.
ГОСТ 12.1.004-91 “ПОЖАРНАЯ
БЕЗОПАСНОСТЬ”
11.
ГОСТ Р 22.7.01-99
“Безопасность в чрезвычайных ситуациях. Единая дежурно-диспетчерская служба.
Основные положения”
12. СНиП 2.04.09-84 “ПОЖАРНАЯ АВТОМАТИКА ЗДАНИЙ И СООРУЖЕНИЙ”
13. СНиП 21-01-97 “ПОЖАРНАЯ БЕЗОПАСНОСТЬ ЗДАНИЙ И ОРУЖЕНИЙ”
14. ГОСТ Р 51658-2000 "Фильтры-экраны защитные для
средств отображения информации. Типы, основные параметры и методы
измерений".
15. ПУЭ-03 “Правила устройства электроустановок”
16. ППБ 01-03 “Правила пожарной безопасности”
17. ПТЭ и ПТБ “Правила технической эксплуатации
электрических станций и сетей РФ” и “Правила техники безопасности при
эксплуатации электрических станций и сетей РФ”
18. Материалы по Delphi на сайте #"#">http://www.delphiclub.de (сеть Internet)
Приложение 1
Исходный текст программы
program SysWave;
uses
Forms,
main in 'main.pas' {SysWaves},
DataMode in 'DataMode.pas' {DataModule1: TDataModule},
About in 'About.pas' {Abouts},
VarTo in 'VarTo.pas' {VarS};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TSysWaves, SysWaves);
Application.CreateForm(TDataModule1, DataModule1);
Application.CreateForm(TAbouts, Abouts);
Application.CreateForm(TVarS, VarS);
Application.Run;
end.
Главный модуль
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms,
Dialogs, Menus, ComCtrls, StdCtrls, XPMan,
Buttons,IniFiles, Mask,mmSystem,
Grids, DBGrids,DataMode, ExtCtrls,About, TAPITon,
TAPIAddress,MSAcm,
TAPIDevices, TAPICall, TAPILines, TAPISystem, DevConf,
TAPIServices,
TAPILineSelectDialog, TAPIWave,VarTo, TAPIPhone;
type
TRecorderMode = (recModeOff, recModeRecord, recModePlay);
TSysWaves = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
MainMenu1: TMainMenu;
exit1: TMenuItem;
GroupBox2: TGroupBox;
TabSheet3: TTabSheet;
XPManifest1: TXPManifest;
SaveConf: TBitBtn;
DBGrid1: TDBGrid;
Play: TBitBtn;
Answer: TBitBtn;
DisplayMemo: TMemo;
HandsetDown: TBitBtn;
GroupBox3: TGroupBox;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton10: TSpeedButton;
DialNo: TBitBtn;
CancelNo: TBitBtn;
GroupBox4: TGroupBox;
CallNo: TEdit;
About1: TMenuItem;
TAPICall1: TTAPICall;
TAPILine1: TTAPILine;
CallParams1: TCallParams;
TAPILineDevice1: TTAPILineDevice;
TAPIAddress1: TTAPIAddress;
TAPILineDeviceConfig1: TTAPILineDeviceConfig;
TAPILineService1: TTAPILineService;
Bevel1: TBevel;
Timer1: TTimer;
FormatTagLabel: TLabel;
FormatDescLabel: TLabel;
Label6: TLabel;
Label7: TLabel;
LengthDispLabel: TLabel;
LengthPosLabel: TLabel;
TrackBar1: TTrackBar;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Bevel2: TBevel;
DelTrack: TSpeedButton;
Stop: TBitBtn;
GroupBox5: TGroupBox;
Bevel3: TBevel;
GetFormatDesc: TLabel;
GetFormat: TBitBtn;
GroupBox6: TGroupBox;
Label3: TLabel;
MaskEdit1: TMaskEdit;
CheckBox1: TCheckBox;
GroupBox1: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
Timer2: TTimer;
FTLabel: TLabel;
FDLabel: TLabel;
ClearNo: TSpeedButton;
Label1: TLabel;
MaskEdit2: TMaskEdit;
Bevel4: TBevel;
ModemName: TLabel;
Label2: TLabel;
Label4: TLabel;
Timer3: TTimer;
DevName: TLabel;
GroupBox7: TGroupBox;
DateTimePicker1: TDateTimePicker;
DateTimePicker2: TDateTimePicker;
Label5: TLabel;
Label12: TLabel;
Select: TSpeedButton;
NoSelect: TSpeedButton;
TAPIPhoneService1: TTAPIPhoneService;
TAPIPhoneDevice1: TTAPIPhoneDevice;
TAPIPhone1: TTAPIPhone;
SpeedButton11: TSpeedButton;
SpeedButton12: TSpeedButton;
GroupBox9: TGroupBox;
HeadSetVolume: TProgressBar;
HeadSetGain: TProgressBar;
HandSetVolume: TProgressBar;
HandSetGain: TProgressBar;
HeadSetVolUpDown: TUpDown;
HeadSetGainUpDown: TUpDown;
HandSetVolUpDown: TUpDown;
HandSetGainUpDown: TUpDown;
Image1: TImage;
Image2: TImage;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
procedure SaveConfClick(Sender: TObject);
procedure PlayClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure DialNoClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure SpeedButton7Click(Sender: TObject);
procedure SpeedButton8Click(Sender: TObject);
procedure SpeedButton9Click(Sender: TObject);
procedure SpeedButton10Click(Sender: TObject);
procedure CancelNoClick(Sender: TObject);
procedure TAPICall1StateConnected(Sender: TObject;
ConnectedMode: TLineConnectedModes; Rights:
TLineCallPrivilege);
procedure TAPICall1StateDisconnected(Sender: TObject;
DisconnectedMode: TLineDisconnectMode; Rights:
TLineCallPrivilege);
procedure TAPICall1StateProceeding(Sender: TObject;
Rights: TLineCallPrivilege);
procedure TAPILineDevice1StateRinging(Sender: TObject;
RingModeIndex,
RingCounter: Cardinal);
procedure TAPICall1InfoCallerId(Sender: TObject);
procedure exit1Click(Sender: TObject);
procedure AnswerClick(Sender: TObject);
procedure GetFormatClick(Sender: TObject);
procedure StopClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure SpeedButton11Click(Sender: TObject);
procedure ClearNoClick(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
procedure TAPILineDevice1StateReMoved(Sender: TObject);
procedure Timer3Timer(Sender: TObject);
procedure HandsetDownClick(Sender: TObject);
procedure SelectClick(Sender: TObject);
procedure NoSelectClick(Sender: TObject);
procedure DelTrackClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action:
TCloseAction);
procedure TAPICall1Reply(Sender: TObject; AsyncFunc:
TAsyncFunc;
Error: Cardinal);
procedure SpeedButton12Click(Sender: TObject);
procedure TAPICall1StateBusy(Sender: TObject; BusyMode:
TLineBusyMode;
Rights: TLineCallPrivilege);
procedure HeadSetVolUpDownChangingEx(Sender: TObject;
var AllowChange: Boolean; NewValue: Smallint;
Direction: TUpDownDirection);
procedure HeadSetGainUpDownChangingEx(Sender: TObject;
var AllowChange: Boolean; NewValue: Smallint;
Direction: TUpDownDirection);
procedure HandSetVolUpDownChangingEx(Sender: TObject;
var AllowChange: Boolean; NewValue: Smallint;
Direction: TUpDownDirection);
procedure HandSetGainUpDownChangingEx(Sender: TObject;
var AllowChange: Boolean; NewValue: Smallint;
Direction: TUpDownDirection);
procedure TAPICall1StateOffering(Sender: TObject;
OfferingMode: TLineOfferingModes; Rights:
TLineCallPrivilege);
procedure TAPICall1StateIdle(Sender: TObject;
Rights: TLineCallPrivilege);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
FPulse : boolean;{признак импульсного набора номера}
FAutoAnswer : boolean;{признак автоответа модема}
ConfigFile : TIniFile;{переменная инициализационного файла}
FTimeReg : integer;{Время регистрации}
FTimeCounter : integer;{счетчик
времени}
VG : array[1..4] of integer;{массив с настройками телефонной
гарнитуры}
{******************Для работы со звуковыми
данными*************************************************************}
FWaveInID : DWORD;{индификатор Wave устройства}
FWaveFormat : PWAVEFORMATEX;{указатель на структуру ТWAVEFORMATEX
(формата
звуковых данных)}
FTotalWaveSize : DWORD;{ Номер записанных выборок }
FByteDataSize : DWORD;{ Накапливаемый размер записанных данных}
FDiskFreeSpace : DWORD;{Свободное пространство для временного файла }
FWaveHdr : array [0..1] of PWAVEHDR;{ Точки доступа к wav информации
заголовка}
FWaveMem : array [0..1] of PChar;{Точки доступа к wav буферам }
FBufIndex : Integer;{ Номер буфера который добавляется для использования}
FWaveIn : HWAVEIN;//Маркер{Дескриптор} устройства для того, чтобы
//делать запись
FWaveOut : HWAVEOUT;//Маркер{Дескриптор} устройства для проигрывания звука
FMaxFmtSize : DWORD;// наибольший размер формата, требуемый для сжатия
FFormatDesc : String;// Описание формата
FFormatTag : String;// Описание тэга формата
FDeviceOpened : Boolean;// состояние открытия устройства
FRecorderMode :
TRecorderMode;//Режим рекордера
//записи/проигрывания/не
активности
FWaveBufSize : DWORD;// Размер буфера
FFilename : String;// Имя файла, чтобы сохранить WAV
FMoreToPlay : Boolean; //признак наличия звуковых данных, чтобы проигрывать
FRecordedData : Boolean;// мы сделали запись данных
FTmpFileName : String;//имя временного WAV файла
FTmpFileHandle : HFILE; // Маркер{Дескриптор} к временному WAV файлу
//==============работа с временым
файлом========================================
function OpenTmpFile : Integer; // Открытие временного файла для
чтения.
function CreateTmpFile : integer; // Создание временного файла чтобы
писать
//wav данные.
procedure DeleteTmpFile; // Удаление временного wav файла.
procedure CloseTmpFile; // Закрытие временного файла содержащего недавно
//записаные
данные.
//==================работа с
записью============================================
procedure StopWaveRecord;//
Остановка записи.
function StartWaveRecord : Integer;// Подготовка заголовков, добавление
//буфера, подготовка показа, и начало записи.
procedure InitWaveHeaders;// Обнуляет заголовки wav и инициализирует
//указатели
данных и буферные длины
procedure CloseWaveDeviceRecord;//Закрытие временного файл и устройства,
//делающего
запись.
procedure UpdateLength(BytePosition : DWORD;
BytePositiontotal : DWORD);//
//
Обновление на экране числа записанных байт
function AddNextBuffer : integer;// Добавление буфера к очереди и
//переключение индекса буфера
procedure UpdateRecordDisplay;// обновления количества записанных байтов
//================сохранение
файла==============================================
function SaveWaveFile : integer;// Сохранение wav
файла
procedure WFerror(mmfp : HMMIO;
const msg : String); // Закрытие wav файла,
//вывод сообщения об ошибках
function CopyDataToWaveFile(mmfp : HMMIO) : integer;// Копирование wav данных
//из временного файла в wav файл
//======================получение и установка
кодеков===========================
function GetWaveFormat : integer; //функция вызывающая визуальный выбор
кодека
function
GetFormatTagDetails(wFormatTag : WORD) : integer; // Получение
//подробности тэга
формата, и сохранение строкового описания.
//=========================инициализация========================================
function InitWaveRecorder : integer;//Размещение формата и заголовков wav,
//буфера данных,
и получение временного имени файла
function AllocWaveFormatEx : Integer;//Размещение и захват структуры WAVEFORMATEX,
//основанную на
максимальном размере формата согласно ACM.
function GetFormatDetails(pfmtin :
PWAVEFORMATEX) : integer; // Получение
//подробности
формата, и сохранение строкового описания.
function AllocWaveHeader : integer; //размещение в памяти заголовка wave
function AllocPCMBuffers : Integer;//размещение wave
буфера в памяти
//========================завершение============================================
procedure DestroyWaveRecorder; // Освобождение памяти, связанной с буферами wav.
procedure FreeWaveFormatEx; //
Освобождение WAVEFORMATEX буфера
procedure FreeWaveHeader; //Освобождение памяти
заголовка wav.
procedure FreePCMBuffers; //Освобождение памяти wav.
//===================проигрывание
звука=========================================
function ReadWaveFile : Integer;//Чтение wav файла
function CopyWaveToTempFile(mmfp : HMMIO; datasize :
DWORD) : Integer;//
//Копирование
данных из wav файла RIFF во временый
файл.
function StartWavePlay : Integer;//Подготовка заголовков, добавление
буферов,
//и начало проигрывания.
procedure StopWavePlay; //остановка проигрывания wav файла
procedure CloseWaveDevicePlay; // закрытие устройства проигрывания
function QueueNextBuffer : Integer;// Запись из буфера в wav устройство и
//переключение
индекса буфера .
function ReadWaveBuffer : Integer;// Чтение куска wav из временного файла
//====================работа с сообщениями wave=================================
procedure MMWimData(var msg: TMessage);
message MM_WIM_DATA; //вызывается
//если устройство завершило передачу
данных в блок памяти, установленный
//процедурой waveInAddBuffer;
procedure MMWomDone(var msg: TMessage); message
MM_WOM_DONE; // Сделать
//проигрывание очередного волнового
буфера, если проигран предыдущий.
procedure MMWomClose(var msg:
TMessage); message MM_WOM_CLOSE;// посылается,
//когда устройство закрывается функцией waveOutClose;
function WriteWaveBuffer(size :
UINT) : integer; // Запись записаных даных
//в временый файл
{*******************************************************************************************************************************}
procedure Display(Msg : String); //
выводит сообщение Msg на DisplayMemo
procedure errormsg(msg : String); // Отобразите сообщение об ошибках.
public
{ Public declarations }
end;
const
{Тип FOURCC
Описывает коды, используемых в формате RIFF (Resource
Interchange File Format -
формат файлов обмена ресурсами). }
WAVE_BUFSIZE = 32768;
FOURCC_WAVE = $45564157; { 'WAVE' }
FOURCC_FMT = $20746d66; { 'fmt ' }
FOURCC_FACT = $74636166; { 'fact' }
FOURCC_DATA = $61746164; { 'data' }
var
SysWaves: TSysWaves;
implementation
{$R *.dfm}
{*********************обработка формы SysWaves**********************************************}
//при создании формы и всей проги
procedure TSysWaves.FormShow(Sender: TObject);
var
v:variant;
begin
FRecorderMode := recModeOff;//режим рекордера устанавливаем 'нет режима записи'
//если функция "Разместите формат и
заголовки волны, буфера данных, и временное имя файла" <> 0
if InitWaveRecorder <> 0 then
Application.Terminate;//то завершить программу
//проверяет наличие файла config.ini
if
FileExists(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName))+'config.ini')
then begin
//создает или открывает конфигурационный
файл
ConfigFile:=TIniFile.Create(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName))+'config.ini');
//проверяет наличие в config.ini разделов WaveFormat и
DeviceMode, VolGain
if (ConfigFile.SectionExists('WaveFormat')=false) and
(ConfigFile.SectionExists('DeviceMode')=false) and
(ConfigFile.SectionExists('VolGain')=false) then begin
//принудительно устанавливает режим
администратора
VarS.RadioButton1.Checked:=false;
VarS.RadioButton2.Checked:=true;
VarS.RadioButton1.Enabled:=false;
VarS.UserName.Enabled:=false;
end;
ConfigFile.Free;
end
else begin
//принудительно устанавливает режим
администратора
VarS.RadioButton1.Checked:=false;
VarS.RadioButton2.Checked:=true;
VarS.RadioButton1.Enabled:=false;
VarS.UserName.Enabled:=false;
end;
//выбор прав и интерфейса
VarS.ShowModal;
try
//инициализируем ТAPI
(интерфейс, устройства)
TAPILineService1.Active:=True;
TAPILine1.Active:=True;
TAPIAddress1.SetStatusMessages;
TAPIPhone1.Device.ID:= TAPILine1.Device.ID;
TAPIPhoneService1.Active:=true;
TAPIPhone1.Active:=true;
except
errormsg('Ошибка
определения устройства типа модем');
Application.Terminate;
end;
//при выборе интерфейса - пользователь
if VarS.Tag=1 then begin
//установка заголовка формы и ее вида
SysWaves.Caption:='SysWave - пользователь';
TabSheet2.TabVisible:=false;
TabSheet3.TabVisible:=false;
//вывод на экран формата сжатия
FormatTagLabel.Caption :=
FFormatTag;
FormatDescLabel.Caption := FFormatDesc;
DisplayMemo.Clear;
LengthPosLabel.Caption := '0';
LengthDispLabel.Caption := '0';
DevName.Caption:=TAPILineDevice1.Caps.Name;//вывод на
экран устройства типа модем
//загрузка настроек из config.ini
try
ConfigFile:=TIniFile.Create(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName))+'config.ini');
//загрузка настроек устройства типа модем
FAutoAnswer:=ConfigFile.ReadBool('DeviceMode','AutoAnswer',true);
FPulse:=ConfigFile.ReadBool('DeviceMode','Pulse',true);
TAPIAddress1.NumRings:=ConfigFile.ReadInteger('DeviceMode','NumRings',0);
FTimeReg:=ConfigFile.ReadInteger('DeviceMode','TimeReg',0);
VG[1]:=ConfigFile.ReadInteger('VolGain','HeadSetVolume',50000);
VG[2]:=ConfigFile.ReadInteger('VolGain','HeadSetGain',50000);
VG[3]:=ConfigFile.ReadInteger('VolGain','HandSetVolume',50000);
VG[4]:=ConfigFile.ReadInteger('VolGain','HandSetGain',50000);
ConfigFile.Free;
except
errormsg('Ошибка загрузки конфигурации!');
Application.Terminate;
end;
if FAutoAnswer then Label4.Caption:='Авто'
else Label4.Caption:='Ручной'
end;
//при выборе интерфейса - администратор
if VarS.Tag=2 then begin
//установка заголовка формы и ее вида
SysWaves.Caption:='SysWave - администратор';
TabSheet1.TabVisible:=false;
ModemName.Caption:=TAPILineDevice1.Caps.Name;
//вывод на экран формата сжатия
GetFormatTag.Caption :=
FFormatTag;
GetFormatDesc.Caption := FFormatDesc;
TAPILineService1.Active:=false;
TAPILine1.Active:=false;
TAPIPhoneService1.Active:=false;
TAPIPhone1.Active:=false;
//загрузка настроек из config.ini
try
ConfigFile:=TIniFile.Create(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName))+'config.ini');
RadioButton1.Checked:=ConfigFile.ReadBool('DeviceMode','AutoAnswer',true);
RadioButton2.Checked:= not RadioButton1.Checked;
CheckBox1.Checked:=ConfigFile.ReadBool('DeviceMode','Pulse',true);
MaskEdit1.Text:=ConfigFile.ReadString('DeviceMode','NumRings','0');
MaskEdit2.Text:=ConfigFile.ReadString('DeviceMode','TimeReg','0');
HeadSetVolUpDown.Position:=trunc(ConfigFile.ReadInteger('VolGain','HeadSetVolume',0)/2);
HeadSetGainUpDown.Position:=trunc(ConfigFile.ReadInteger('VolGain','HeadSetGain',0)/2);
HandSetVolUpDown.Position:=trunc(ConfigFile.ReadInteger('VolGain','HandSetVolume',0)/2);
HandSetGainUpDown.Position:=trunc(ConfigFile.ReadInteger('VolGain','HandSetGain',0)/2);
ConfigFile.Free;
except
errormsg('Ошибка загрузки конфигурации!');
Application.Terminate;
end;
end;
//открытие базы данных
Datamodule1.WavBase.Open;
if not Datamodule1.WavBase.Active then begin
errormsg('Ошибка открытия базы данных!');
Application.Terminate;
end;
end;
////////////////////////////////////////////////////////////////////////////
//при закрытии формы и всей проги
procedure TSysWaves.FormDestroy(Sender: TObject);
//отключаем ТAPI
(интерфейс, устройства)
TAPIPhoneService1.Active:=false;
TAPILineService1.Active:=false;
TAPILine1.Active:=false;
TAPIPhone1.Active:=false;
//если идет запись остановить ее
if FRecorderMode = recModeRecord then
StopWaveRecord
//если идет проигрыш остановить его
else if FRecorderMode = recModePlay
then StopWavePlay;
// Освобождение памяти, связанной с wav буферами.
DestroyWaveRecorder;
end;
//////////////////////////////////////////////////////////////////////////
//Вывод информациии о программе
procedure TSysWaves.About1Click(Sender: TObject);
begin
Abouts.ShowModal;
end;
////////////////////////////////////////////////////////////////////////////
//при нажатии Выход
procedure TSysWaves.exit1Click(Sender: TObject);
begin
close;
end;
{********************работа с
модемом***************************************}
//при удаление устройства из системы
procedure TSysWaves.TAPILineDevice1StateReMoved(Sender:
TObject);
begin
errormsg('Устройство
было удалено из системы. Программа будет закрыта');
Application.Terminate;
end;
/////////////////////////////////////////////////////////////////////////////
//набор номера(запрос на соединение)
procedure TSysWaves.DialNoClick(Sender: TObject);
begin
DialNo.Enabled:=false;
CancelNo.Enabled:=true;
//проверка настройки тонального или
импульсного набора номера
if FPulse then
TAPIAddress1.OutboundCall.MakeCall(TAPILine1.Handle,'p'+ CallNo.Text,0)
else
TAPIAddress1.OutboundCall.MakeCall(TAPILine1.Handle,'t'+ CallNo.Text,0)
end;
////////////////////////////////////////////////////////////////////////////
//отмена набора номера и соединения
procedure TSysWaves.CancelNoClick(Sender: TObject);
begin
Display('Идет отмена
вызова...');
TAPICall1.Drop;//понижение статуса вызова
DialNo.Enabled:=true;
CancelNo.Enabled:=false
end;
/////////////////////////////////////////////////////////////////////////////
//при состоянии соединения модема с удаленным
телефоном
procedure TSysWaves.TAPICall1StateConnected(Sender: TObject;
ConnectedMode: TLineConnectedModes; Rights:
TLineCallPrivilege);
begin
Display('Соединение...');
TAPIPhone1.SpeakerHookSwitchMode:=phsmMicSpeaker;//включаем общую связь
TAPIPhone1.SpeakerVolume:=65000;
TAPIPhone1.SpeakerGain:=65000;
TAPIPhone1.HeadSetHookSwitchMode:=phsmMicSpeaker;//включаем наушники
TAPIPhone1.HandSetHookSwitchMode:=phsmMicSpeaker;//включаем микрофон
//установка громкости наушников и микрофона
TAPIPhone1.HeadSetVolume:=VG[1];
TAPIPhone1.HeadSetGain:=VG[2];
TAPIPhone1.HandSetGain:=VG[3];
TAPIPhone1.HandSetVolume:=VG[4];
//если идет запись
if FRecorderMode
<> recModeOff then // остановить запись
StopWaveRecord
else begin
Display('Идет запись...');
//делаем записи в базе данных
Datamodule1.WavBase.Insert;
Datamodule1.WavBase.FieldByName('DateName').AsDateTime:=Date;//дата
Datamodule1.WavBase.FieldByName('TimeName').AsDateTime:=Time;//время
//имя пользователя
Datamodule1.WavBase.FieldByName('UserName').AsString:=VarS.UserName.Text;
FTimeCounter:=0;//обнуляем счетчик времени
StartWaveRecord; // начать запись
end;
end;
/////////////////////////////////////////////////////////////////////////////
//при состоянии разъединения модема с
удаленным телефоном
procedure TSysWaves.TAPICall1StateDisconnected(Sender:
TObject;
DisconnectedMode: TLineDisconnectMode; Rights:
TLineCallPrivilege);
begin
Display('Соединение
разорвано');
//если идет запись
if FRecorderMode
<> recModeOff then //остановить запись
StopWaveRecord;
//если время разговора >= времени
регистрации
if FTimeCounter >= FTimeReg then
begin
SaveWaveFile;//сохранить файл с звуковыми
данными
Datamodule1.WavBase.Post;//запись внесенных изменений в базу данных
end
else
Datamodule1.WavBase.Cancel;//отмена изменений внесенных в текущую
запись
Answer.Enabled:=true;
HandsetDown.Enabled:=false;
TAPICall1.Drop;//понижение
статуса запроса
end;
/////////////////////////////////////////////////////////////////////////////
//сообщение о наборе номера
procedure TSysWaves.TAPICall1StateProceeding(Sender:
TObject;
Rights: TLineCallPrivilege);
begin
display('Идет набор номера ' + CallNo.Text);
end;
///////////////////////////////////////////////////////////////////////////////
//при состоянии звонка
procedure TSysWaves.TAPILineDevice1StateRinging(Sender:
TObject;
RingModeIndex, RingCounter: Cardinal);
begin
display('Звонок...');
Windows.Beep(300,
500);//подача звукового сигнала через встроенный динамик
Windows.Beep(350, 500);
//если режим ответа модема - авто
if FAutoAnswer then begin
//если кол-во принятых звонков >= заданных
if RingCounter >=
TAPIAddress1.NumRings then begin
Answer.Enabled:=false;
HandsetDown.Enabled:=true;
TAPIAddress1.InboundCall.Answer;//модем берет трубку
end;
end
end;
/////////////////////////////////////////////////////////////////////////
//при поступлении информации о входящем звонке
procedure TSysWaves.TAPICall1InfoCallerId(Sender: TObject);
begin
//если есть информация о входящем звонке
if TAPICall1.Info.CallerID <>
'' then begin
display('Входящий звонок с номером' +
TAPICall1.Info.CallerID);
end;
end;
////////////////////////////////////////////////////////////////////////////
//пользователь берет трубку
procedure TSysWaves.AnswerClick(Sender: TObject);
begin
Answer.Enabled:=false;
HandsetDown.Enabled:=true;
TAPIAddress1.InboundCall.Answer;//модем берет трубку
end;
////////////////////////////////////////////////////////////////////////////
//пользователь положил трубку
procedure TSysWaves.HandsetDownClick(Sender: TObject);
begin
Answer.Enabled:=true;
HandsetDown.Enabled:=false;
TAPICall1.Drop;//понижение
статуса запроса
end;
////////////////////////////////////////////////////////////////////////////////
//отчистка набираемого номера
procedure TSysWaves.ClearNoClick(Sender: TObject);
begin
CallNo.Clear;
end;
//при состоянии поступления предложения
запроса
procedure TSysWaves.TAPICall1StateOffering(Sender: TObject;
OfferingMode: TLineOfferingModes; Rights:
TLineCallPrivilege);
begin
TAPIAddress1.InboundCall.Accept;// приложение примет
контроль вызова
end;
//если запрос находится в неактивном состоянии
procedure TSysWaves.TAPICall1StateIdle(Sender: TObject;
Rights: TLineCallPrivilege);
begin
TAPICall1.DeallocateCall;
end;
//при состоянии занято
procedure TSysWaves.TAPICall1StateBusy(Sender: TObject;
BusyMode: TLineBusyMode; Rights: TLineCallPrivilege);
begin
TAPIAddress1.OutboundCall.Drop;
end;
//ответ модема
procedure TSysWaves.TAPICall1Reply(Sender: TObject;
AsyncFunc: TAsyncFunc;
Error: Cardinal);
begin
if Error <> 0 then errormsg('Ошибка.Модем не может
реагировать на запрос.');
if AsyncFunc =afDrop then TAPICall1.DeallocateCall;
end;
{***********************набор номера с
клавиатура на экране******************************************}
procedure TSysWaves.SpeedButton1Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '1';
end;
procedure TSysWaves.SpeedButton2Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '2';
end;
procedure TSysWaves.SpeedButton3Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '3';
end;
procedure TSysWaves.SpeedButton4Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '4';
end;
procedure TSysWaves.SpeedButton5Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '5';
end;
procedure TSysWaves.SpeedButton6Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '6';
end;
procedure TSysWaves.SpeedButton7Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '7';
end;
procedure TSysWaves.SpeedButton8Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '8';
end;
procedure TSysWaves.SpeedButton9Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '9';
end;
procedure TSysWaves.SpeedButton10Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '0';
end;
procedure TSysWaves.SpeedButton11Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '*';
end;
procedure TSysWaves.SpeedButton12Click(Sender: TObject);
begin
CallNo.Text:=CallNo.Text + '#';
end;
{******************Работа со
звуком****************************************}
//=========================инициализация===================================
//Размещение формата и заголовков wav, буфера данных, и получение временного имени файла
function TSysWaves.InitWaveRecorder : integer;
var
Temp : array [0..MAX_PATH] of char;
begin
Result := -1;
// размещение в памяти структуры формата wav...
if AllocWaveFormatEx <> 0 then
Exit;
// размещение в памяти заголовка wav...
if AllocWaveHeader <> 0 then
begin
Result := -3;
Exit;
end;
// размещение в памяти буфера данных wav
if AllocPCMBuffers <> 0 then
begin
Result := -4;
Exit;
end;
//Генирируем имя временного файла
GetTempPath(sizeof(Temp), Temp);
SetLength(FTmpFileName, MAX_PATH);
GetTempFileName(Temp, 'wr', 0, PChar(FTmpFileName));
Result := 0;
end;
////////////////////////////////////////////////////////////////////////////
//Размещение и захват структуры WAVEFORMATEX, основанной на максимальном размере
//формата согласно ACM.
function TSysWaves.AllocWaveFormatEx : Integer;
var
v:variant;
begin
//если не получен наибольший размер формата,
требуемый от установленного ACM...
if acmMetrics(nil, ACM_METRIC_MAX_SIZE_FORMAT,
FMaxFmtSize) <> 0 then begin
errormsg('Ошибка получения размера
максимального формата сжатия .');
Result := -1;
Exit;
end;
//выделение памяти
GetMem(FWaveFormat, FMaxFmtSize);
//если формат неопределен
if FWaveFormat = nil then begin
errormsg('Ошибка размещения в памяти WaveFormatEx структуры.');
Result := -2;
Exit;
end;
//обнуление структуры FWaveFormat
FillChar(FWaveFormat^, FMaxFmtSize, 0);
//загрузка настроек звукового формата из config.ini
try
ConfigFile:=TIniFile.Create(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName))+'config.ini');
FWaveFormat.wFormatTag:=ConfigFile.ReadInteger('WaveFormat','FormatTag',WAVE_FORMAT_PCM);
FWaveFormat.nChannels:=ConfigFile.ReadInteger('WaveFormat','Channels',1);
v:=ConfigFile.ReadInteger('WaveFormat','SamplesPerSec',8000);
FWaveFormat.nSamplesPerSec:=v;
v:=ConfigFile.ReadInteger('WaveFormat','AvgBytesPerSec',8000);
FWaveFormat.nAvgBytesPerSec:=v;
FWaveFormat.nBlockAlign:=ConfigFile.ReadInteger('WaveFormat','BlockAlign',1
);
FWaveFormat.wBitsPerSample:=ConfigFile.ReadInteger('WaveFormat','BitsPerSample',16);
FWaveFormat.cbSize:=ConfigFile.ReadInteger('WaveFormat','Size',0);
ConfigFile.Free;
except
errormsg('Ошибка загрузки конфигурации!');
Application.Terminate;
end;
// сохранить формат и теги строки описания
GetFormatTagDetails(FWaveFormat.wFormatTag);
GetFormatDetails(FWaveFormat);
Result := 0;
end;
////////////////////////////////////////////////////////////////////////////
// Получение подробности формата, и сохранение
строкового описания.
function TSysWaves.GetFormatDetails(pfmtin : PWAVEFORMATEX)
: integer;
var
acmfmtdetails : TACMFORMATDETAILS;
begin
//обнуление структуру acmfmtdetails
FillChar(acmfmtdetails,
sizeof(acmfmtdetails), 0);
acmfmtdetails.cbStruct := sizeof(acmfmtdetails);
acmfmtdetails.pwfx := pfmtin;
acmfmtdetails.dwFormatTag := pfmtin.wFormatTag;
acmfmtdetails.cbwfx := sizeof(TWAVEFORMATEX) +
pfmtin.cbSize;
//если запрос о сведении формата <> 0
то FormatDetails функция потерпела неудачу
if acmFormatDetails(nil,
acmfmtdetails, ACM_FORMATDETAILSF_FORMAT) <> 0 then begin
errormsg('Ошибка, FormatDetails не работает');
Result := -1;
Exit;
end;
// сохранение строки описания деталей
формата...
FFormatDesc :=
acmfmtdetails.szFormat;
Result := 0;
end;
////////////////////////////////////////////////////////////////////////////
// размещение в памяти заголовка wave
function TSysWaves.AllocWaveHeader : integer;
var
i : Integer;
begin
for i := Low(FWaveHdr) to High(FWaveHdr) do begin
GetMem(FWaveHdr[i], sizeof(TWAVEHDR));//выделяем память
под заголовок
//если заголовок не определен
if FWaveHdr[i] = nil then begin
errormsg('Ошибка размещения в памяти
заголовка wave.');
Result := -1;
Exit;
end;
end;
Result := 0;
end;
/////////////////////////////////////////////////////////////////////////////
//размещение wave буфера
в памяти
function TSysWaves.AllocPCMBuffers : Integer;
var
i : Integer;
begin
for i := Low(FWaveMem) to High(FWaveMem) do begin
GetMem(FWaveMem[i], WAVE_BUFSIZE);//выделяем память под
wav буфер
if FWaveMem[i] = nil then begin
errormsg('Ошибка размещения wave буфера в памяти.');
Result := -1;
Exit;
end;
FWaveHdr[i].lpData := FWaveMem[i];
end;
Result := 0;
end;
/////////////////////////////////////////////////////////////////////////////
//========================завершение============================================
//Освобождение памяти, связанной с буферами wav
procedure TSysWaves.DestroyWaveRecorder;
begin
FreeWaveFormatEx;// Освобождение памяти от структуры
WAVEFORMATEX
FreePCMBuffers;//Освобождение памяти от wav буферов.
FreeWaveHeader;//Освобождение
памяти заголовка wav.
DeleteTmpFile;//Удаление
временного файла
end;
////////////////////////////////////////////////////////////////////////////
//Освобождение памяти от структуры WAVEFORMATEX
procedure TSysWaves.FreeWaveFormatEx;
begin
//если FWaveFormat не
является неопределенной
if FWaveFormat <> nil then
begin
FreeMem(FWaveFormat);
FWaveFormat := nil;
end;
end;
////////////////////////////////////////////////////////////////////////////
//Освобождение памяти wav
буферов.
procedure TSysWaves.FreePCMBuffers;
var
i : Integer;
begin
for i := Low(FWaveMem) to High(FWaveMem) do begin
if FWaveMem[i] <> nil then begin
FreeMem(FWaveMem[i]);
FWaveMem[i] := nil;
end;
end;
end;
/////////////////////////////////////////////////////////////////////////////
//Освобождение памяти заголовка wav.
procedure TSysWaves.FreeWaveHeader;
var
i : Integer;
begin
for i := Low(FWaveHdr) to High(FWaveHdr) do begin
if FWaveHdr[i] <> nil then begin
FreeMem(FWaveHdr[i]);
FWaveHdr[i] := nil;
end;
end;
end;
//==============работа с временым
файлом========================================
//Создание временного файла чтобы писать wav данные.
function TSysWaves.CreateTmpFile : integer;
var
RootPathName : array [0..MAX_PATH] of char;
SectorsPerCluster : DWORD;
BytesPerSector : DWORD;
NumberOfFreeClusters : DWORD;
TotalNumberOfClusters : DWORD;
begin
FTmpFileHandle := _lcreat(PChar(FTmpFileName),
0);//получение дескриптора
//временного
файла и его создание
//если произошла ошибка создания временого
файла
if FTmpFileHandle = HFILE_ERROR then
begin
errormsg('Ошибка создания временого
файла');
Result := -1;
Exit;
end;
// получение доступного пространства на
временном диске...
//если в полном имени файла есть знак ':'
if FTmpFileName[2] = ':' then
//то имя диска определяется так
RootPathName[0] := FTmpFileName[1]
else //иначе
//получение текущей дериктории
GetCurrentDirectory(sizeof(RootPathName),
@RootPathName);
RootPathName[1] := ':';
RootPathName[2] := '\';
RootPathName[3] := #0;
//получение свободного места на диске
GetDiskFreeSpace(@RootPathName,
SectorsPerCluster,
BytesPerSector,
NumberOfFreeClusters,
TotalNumberOfClusters);
//FDiskFreeSpace = кол-во
Свободных Кластеров * секторов в кластере
FDiskFreeSpace :=
NumberOfFreeClusters * SectorsPerCluster;
// FDiskFreeSpace =
кол-во Свободных секторов * байт в секторе
FDiskFreeSpace := FDiskFreeSpace *
BytesPerSector;
Result := 0;
end;
////////////////////////////////////////////////////////////////////////////
// Закройте временный файл содержащий недавно
записаные данные.
procedure TSysWaves.CloseTmpFile;
begin
if _lclose(FTmpFileHandle) = HFILE_ERROR then
errormsg('Ошибка закрытия временного
файла');
end;
//////////////////////////////////////////////////////////////////////////////
// Удалите временный файл
procedure TSysWaves.DeleteTmpFile;
begin
//если длина временного файла > 0
if Length(FTmpFileName) > 0 then
DeleteFile(FTmpFileName);//удалить файл
end;
////////////////////////////////////////////////////////////////////////////
// Откройте временный файл для чтения.
function TSysWaves.OpenTmpFile : Integer;
begin
// Открываем временный файл для чтения.
FTmpFileHandle :=
_lopen(PChar(FTmpFileName), OF_READ);
//если произошла ошибка открытия временного
файла
if FTmpFileHandle = HFILE_ERROR then
Result := 0
else
Result := 1;
end;
//==================работа с
записью============================================
// Остановка записи
procedure TSysWaves.StopWaveRecord;
var
v:variant;
begin
FRecorderMode := recModeOff;//устанавливаем режим рекордера - выключен
//Функция waveInReset
останавливает операцию загрузки данных.
//Все текущие буферы отмечаются как
обработанные и приложение уведомляется
//о завершении загрузки данных
if waveInReset(FWaveIn) <> 0
then
errormsg('Ошибка остановки записи');
CloseWaveDeviceRecord;//закрытие
устройства записи
Timer3.Enabled := FALSE;// стоп
таймер
end;
////////////////////////////////////////////////////////////////////////////
// Подготовка заголовков, добавление буфера,
подготовка показа, и начало записи.
function TSysWaves.StartWaveRecord : Integer;
var
Status : MMRESULT;
Flags:DWord;
WaveInCaps:PWaveInCaps;
begin
//обнуляем номер записанных выборок, размер
записаных данных и номер буфера
FTotalWaveSize := 0;
FByteDataSize := 0;
FBufIndex := 0;
//получаем номер открываемого устройства типа
модем
FWaveInID
:=TAPICall1.GetWaveID('wave/in');
//если номер открываемого устройства равен
полученному автоматически то
if FWaveInID= Wave_Mapper then
Flags:=WAVE_FORMAT_QUERY//устанавливаем флаг , чтобы функция
запрашивала
//устройство для определения, поддерживает ли
оно указанный формат, но не открывала его;
else
Flags:=WAVE_FORMAT_QUERY or WAVE_MAPPED;
Status := waveInOpen(@FWaveIn, FWaveInID, FWaveFormat,
0, 0, Flags);
if Status <> MMSYSERR_NOERROR then begin
errormsg('Ошибка открытия устройства ввода
данных для записи.');
Result := -1;
Exit;
end;
if FWaveInID = Wave_Mapper then Flags:=CALLBACK_WINDOW
else
Flags:=CALLBACK_WINDOW or WAVE_MAPPED;
Status := waveInOpen(@FWaveIn, FWaveInID, FWaveFormat,
HWND(SysWaves.Handle), 0, Flags);
if Status <> MMSYSERR_NOERROR then begin
errormsg(' Ошибка открытия устройства
ввода данных для записи.');
Result := -1;
Exit;
end;
//устанавливаем признак открытия устройства
FDeviceOpened := TRUE;
// Обнуляем заголовки wav
и инициализируем указатели данных и буферные длины
InitWaveHeaders;
//если подготовка буферов для операции
загрузки данных не успешна
if not ((waveInPrepareHeader(FWaveIn,
FWaveHdr[0], sizeof(TWAVEHDR)) = 0) and
(waveInPrepareHeader(FWaveIn, FWaveHdr[1],
sizeof(TWAVEHDR)) = 0))
then begin
CloseWaveDeviceRecord;//закрыть устройство
errormsg('Ошибка подготовки заголовка для
записи.');
Result := -2;
Exit;
end;
// добавляем первый буфер...
if AddNextBuffer <> 0 then
begin
Result := -3;
Exit;
end;
//Создаем временный файл, в который мы будем
писать...
if CreateTmpFile <> 0 then
begin
CloseWaveDeviceRecord;//закрыть устройство
Result := -4;
Exit;
end;
// запускаем начало записи
if waveInStart(FWaveIn) <> 0
then begin
CloseWaveDeviceRecord;//закрыть устройство
errormsg('Ошибка
начала записи.');
Result := -5;
Exit;
end;
FRecorderMode := recModeRecord;//режим рекордера - запись
// установка таймера чтобы модифицировать
дисплей...
Timer3.Interval := 1000;
Timer3.Enabled := TRUE;
UpdateLength(0, FDiskFreeSpace);
//добавляем в очередь следующий буфер...
if AddNextBuffer <> 0 then
begin
Result := -6;
Exit;
end;
Result := 0;
end;
////////////////////////////////////////////////////////////////////////////////
// Обнуляем заголовки wav
и инициализируем указатели данных и буферные длины
procedure TSysWaves.InitWaveHeaders;
begin
// делаем размер буфера , который
выравнивает множитель блока ...
FWaveBufSize := (WAVE_BUFSIZE -
WAVE_BUFSIZE mod FWaveFormat.nBlockAlign);
// обнулить заголовки wav
FillChar(FWaveHdr[0]^, sizeof(TWAVEHDR), 0);
FillChar(FWaveHdr[1]^, sizeof(TWAVEHDR), 0);
// теперь инициализируем указатели данных и
буферные длины...
FWaveHdr[0].dwBufferLength :=
FWaveBufSize;
FWaveHdr[1].dwBufferLength := FWaveBufSize;
FWaveHdr[0].lpData := FWaveMem[0];
FWaveHdr[1].lpData := FWaveMem[1];
end;
///////////////////////////////////////////////////////////////////////////////
//Закрытие временного файла и устройства,
делающего запись.
procedure TSysWaves.CloseWaveDeviceRecord;
begin
// если устройство уже закрыто,
возвращаться...
if not FDeviceOpened then Exit;
//освобождение памяти занимаемой
заголовком1...
if waveInUnprepareHeader(FWaveIn,
FWaveHdr[0], sizeof(TWAVEHDR)) <> 0 then
errormsg('Ошибка в waveInUnprepareHeader (1)');
//освобождение памяти занимаемой
заголовком2...
if waveInUnprepareHeader(FWaveIn,
FWaveHdr[1], sizeof(TWAVEHDR)) <> 0 then
errormsg('Ошибка в waveInUnprepareHeader (2)');
// сохранение зарегистрированого полного
размера зап. данных, и обновление дисплея
FTotalWaveSize := FByteDataSize;
UpdateLength(FTotalWaveSize, FDiskFreeSpace);
//признак записи данных
FRecordedData := TRUE;
// закрыть временый файл
CloseTmpFile;
// закрыть wav устройство
if waveInClose(FWaveIn) <> 0 then errormsg('Ошибка закрытия
устройства входа');
//признак открытия устройства
FDeviceOpened := FALSE;
// обновление дисплея
Display('Запись
остановлена');
end;
//////////////////////////////////////////////////////////////////////////////
//Обновление на экране числа записанных байт
procedure TSysWaves.UpdateLength(BytePosition : DWORD;
BytePositiontotal : DWORD);
var
v:variant;
begin
LengthPosLabel.Caption := IntToStr(BytePosition);//число
байт
LengthDispLabel.Caption :=
IntToStr(BytePositiontotal);//позиция
end;
//////////////////////////////////////////////////////////////////////////////
// Добавление буфера к очереди и переключение
индекса буфера
function TSysWaves.AddNextBuffer : integer;
begin
//ставит в очередь на загрузку данными буфер
памяти
if waveInAddBuffer(FWaveIn, FWaveHdr[FBufIndex],
sizeof(TWAVEHDR)) <> 0 then begin
StopWaveRecord;
errormsg('Ошибка добавления буфера.');
Result := -1;
Exit;
end;
// переключение индекса для следующего
буфера...
FBufIndex := 1 - FBufIndex;
Result := 0;
end;
///////////////////////////////////////////////////////////////////////////
//обновления количества записанных байтов
procedure TSysWaves.UpdateRecordDisplay;
var
mmtime : TMMTIME;
begin
mmtime.wType := TIME_BYTES;
//Функция восстанавливает текущее положение{позицию}
данного звукового устройства
waveInGetPosition(FWaveIn, @mmtime,
sizeof(mmtime));
UpdateLength(mmtime.cb, FDiskFreeSpace);//Обновление на экране числа
записанных байт
FTotalWaveSize:=mmtime.cb;//накапливает максимальный размер
end;
//================сохранение
файла==============================================
// Сохранение wav файла
function TSysWaves.SaveWaveFile : Integer;
var
mmfp : HMMIO;
dwTotalSamples : DWORD;
fTotalSamples : double;
mminfopar : TMMCKINFO;
mminfosub : TMMCKINFO;
GetDT : TSystemTime;
str : string;
begin
// если никакие данные не зарегистрированы ,то
выход
if FTotalWaveSize = 0 then begin
errormsg('Не записаны звуковые данные
чтобы сохранить их.');
Result := 0;
Exit;
end;
//получение имени файла
DateTimeToSystemTime(Now,GetDT);
with GetDT do begin
Datamodule1.WavBase.FieldByName('FileName').AsString:=IntToStr(Integer(wYear))+
IntToStr(Integer(wMonth))+IntToStr(Integer(wDay))+IntToStr(Integer(wHour))+
IntToStr(Integer(wMinute))+IntToStr(Integer(wSecond))+'.wav';
FFilename:=IncludeTrailingBackslash(ExtractFilePath(Application.ExeName))+
'WavBase\'+
Datamodule1.WavBase.FieldByName('FileName').AsString;
end;
// откройте wav файл для
записи...
mmfp := mmioOpen(PChar(FFilename),
nil,
MMIO_CREATE or MMIO_WRITE or
MMIO_ALLOCBUF);
//если произошла ошибка открытия файла, то
if mmfp = 0 then begin
errormsg('Ошибка открытия файла для
записи.');
Result := -1;
Exit;
end;
Cursor := crHourGlass;
// создайте wav кусок RIFF
mminfopar.fccType := FOURCC_WAVE;
mminfopar.cksize :=
0;//пусть функция определит размер
//если создание куска неудачно
if mmioCreateChunk(mmfp, @mminfopar,
MMIO_CREATERIFF) <> 0 then begin
WFerror(mmfp, 'Ошибка создания RIFF wave куска.');
Result := -2;
Exit;
end;
//создайте кусок формата, и запишите wav формат...
mminfosub.ckid := FOURCC_FMT;
mminfosub.cksize := FMaxFmtSize;
//если создание куска неудачно
if mmioCreateChunk(mmfp, @mminfosub,
0) <> 0 then begin
WFerror(mmfp, 'Ошибка
создания RIFF формата куска.');
Result := -3;
Exit;
//если ошибка записи RIFF
if mmioWrite(mmfp,
PChar(FWaveFormat), FMaxFmtSize) <> LongInt(FMaxFmtSize) then begin
WFerror(mmfp, 'Ошибка
записи RIFF формата данных.');
Result := -3;
Exit;
end;
// назад из куска формата...
mmioAscend(mmfp, @mminfosub, 0);
// этот кусок только содержит полную длину в
выборках...
mminfosub.ckid := FOURCC_FACT;
mminfosub.cksize := sizeof(DWORD);
//если создание куска неудачно
if mmioCreateChunk(mmfp, @mminfosub,
0) <> 0 then begin
WFerror(mmfp, 'Ошибка
создания RIFF ''фактического'' куска.');
Result := -4;
Exit;
end;
fTotalSamples := FTotalWaveSize /
FWaveFormat.nAvgBytesPerSec *
FWaveFormat.nSamplesPerSec;
dwTotalSamples := Trunc(fTotalSamples);
//если ошибка записи RIFF
if mmioWrite(mmfp,
PChar(@dwTotalSamples), sizeof(dwTotalSamples))
<> sizeof(dwTotalSamples) then begin
WFerror(mmfp, 'Ошибка
записи RIFF ''фактических'' данных.');
Result := -4;
Exit;
end;
// назад из куска факта...
mmioAscend(mmfp, @mminfosub, 0);
// теперь создайте, и запишите wav кусок данных...
mminfosub.ckid := FOURCC_DATA;
mminfosub.cksize :=
0;// пусть функция определяет размер
//если создание куска неудачно
if mmioCreateChunk(mmfp, @mminfosub,
0) <> 0 then begin
WFerror(mmfp, 'Ошибка
создания RIFF куска данных.');
Result := -5;
Exit;
end;
// копируйте данные из временного файла в wav файл
if CopyDataToWaveFile(mmfp) <>
0 then begin
WFerror(mmfp, 'Ошибка записи wave данных.');
Result := -5;
Exit;
end;
mmioAscend(mmfp, @mminfosub, 0);
// поднимитесь из куска RIFF...
mmioAscend(mmfp, @mminfopar, 0);
//закрыть
mmioClose(mmfp, 0);
Cursor := crDefault;
Result := 0;
end;
/////////////////////////////////////////////////////////////////////////////
// Закрытие wav файла,
вывод сообщения об ошибках
procedure TSysWaves.WFerror(
mmfp : HMMIO;
const msg : String);
begin
mmioClose(mmfp, 0);
Cursor := crDefault;
errormsg(msg);
end;
///////////////////////////////////////////////////////////////////////////
// Копирование wav
данных из временного файла в wav файл
function TSysWaves.CopyDataToWaveFile(mmfp : HMMIO) :
integer;
var
pbuf : PChar;
ht : HFILE;
nbytes : integer;
begin
pbuf := FWaveMem[0]; //используйте один из волновых буферов для копирования
// откройте временный файл для чтения
ht := _lopen(PChar(FTmpFileName),
OF_READ);
//если произошла ошибка открытия файла
if ht = HFILE_ERROR then begin
Result := -1;
Exit;
end;
// копируйте в RIFF/wave файл
while TRUE do begin
nbytes := _lread(ht, pbuf, WAVE_BUFSIZE);
if nbytes <= 0 then break;
mmioWrite(mmfp, pbuf, nbytes);
end;
// закройте файл чтения
_lclose(ht);
Result := 0;
end;
//======================получение и установка
кодеков=====================================
//функция вызывающая визуальный выбор кодека
function TSysWaves.GetWaveFormat : integer;
var
acmopt : TACMFORMATCHOOSE;
err : MMRESULT;
ptmpfmt : PWAVEFORMATEX;
begin
//размещение структуры ptmpfmt в динамич памяти
GetMem(ptmpfmt, FMaxFmtSize);
//если структура не определена
if ptmpfmt = nil then begin
errormsg('Ошибка распределения временного
буфера формата.');
Result := -1;
Exit;
end;
//Переместите байты размером FMaxFmtSize из FWaveFormat^ в ptmpfmt^
Move(FWaveFormat^, ptmpfmt^,
FMaxFmtSize);
// ACM установка выбирает
поля и отображает диалог...
//заполняет нулями acmopt
FillChar(acmopt, sizeof(acmopt), 0);
//заносим предварительные данные
acmopt.cbStruct := sizeof(acmopt);//размер
области памяти, занимаемой структурой.
acmopt.fdwStyle :=
ACMFORMATCHOOSE_STYLEF_INITTOWFXSTRUCT;//флаги стилей
//построения диалога
acmopt.hwndOwner := Handle;//ключ окна-владельца создаваемого
диалога
acmopt.pwfx := FWaveFormat;//указатель области памяти
для структуры типа
//WAVEFORMATEX
acmopt.cbwfx := FMaxFmtSize;//размер области памяти для
структуры описания
//формата
acmopt.pszTitle := 'Выбор кодека';
acmopt.fdwEnum := ACM_FORMATENUMF_INPUT;//флаги режимов перебора фильтров/форматов.
err := acmFormatChoose(acmopt);//выбираем кодек
//сравниваем полученную и предыдущую структуру
TWAVEFORMATEX
if CompareMem(FWaveFormat, ptmpfmt,
sizeof(TWAVEFORMATEX)) then
err := ACMERR_CANCELED; //пользователь закрыл диалог
кнопкой Cancel
if err <> MMSYSERR_NOERROR then begin
//Переместите байты размером FMaxFmtSize из ptmpfmt^ в FWaveFormat^
Move(ptmpfmt^, FWaveFormat^,
FMaxFmtSize);
FreeMem(ptmpfmt);//освобождаем память
if err = ACMERR_CANCELED then begin
Result := 0;
Exit;
end;
errormsg('Ошибка функции FormatChoose');
Result := -2;
Exit;
end;
//запомнить описание формата...его
характеристики
FFormatDesc := acmopt.szFormat;
GetFormatTagDetails(acmopt.pwfx.wFormatTag);
FreeMem(ptmpfmt);//освобождаем память
Result := 0;
end;
/////////////////////////////////////////////////////////////////////////////
// Получение подробности тэга формата, и
сохранение строкового описания.
function TSysWaves.GetFormatTagDetails(wFormatTag : WORD) :
integer;
var
acmtagdetails : TACMFORMATTAGDETAILS;
begin
// обнулить....
FillChar(acmtagdetails, sizeof(acmtagdetails), 0);
acmtagdetails.cbStruct := sizeof(acmtagdetails);
acmtagdetails.dwFormatTag := wFormatTag;
//если запрос о сведении типа формата <>
0 то
if acmFormatTagDetails(nil,
acmtagdetails,
ACM_FORMATTAGDETAILSF_FORMATTAG)
<> 0 then begin
errormsg('Ошибка функции FormatTagDetails');
Result := -1;
Exit;
end;
//сохраните строку описания деталей формата...
FFormatTag :=
acmtagdetails.szFormatTag;
Result := 0;
end;
//===================проигрывание
звука=========================================
//Чтение волнового файла
function TSysWaves.ReadWaveFile : Integer;
var
mmfp : HMMIO;
mminfopar : TMMCKINFO;
mminfosub : TMMCKINFO;
dwTotalSamples : DWORD;
Sec,Min:variant;
begin
dwTotalSamples:=0;
//получаем имя проигрываемого файла
FFileName:=
IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) +
'WavBase\'+
datamodule1.WavBase.FieldByName('FileName').AsString;
// открыть wave файл для
чтения...
mmfp := mmioOpen(PChar(FFileName),
nil, MMIO_READ + MMIO_ALLOCBUF);
//если файл не открыт
if mmfp = 0 then begin
errormsg('Ошибка открытия файла для
чтения.');
Result := -1;
Exit;
end;
Cursor := crHourGlass;
// поиск куска формата...
mminfopar.fccType := FOURCC_WAVE;
if mmioDescend(mmfp, @mminfopar, nil, MMIO_FINDRIFF)
<> 0 then begin
WFerror(mmfp, 'Wave формат не найден в файле.');
Result := -2;
Exit;
end;
mminfosub.ckid := FOURCC_FMT;
if mmioDescend(mmfp, @mminfosub, @mminfopar,
MMIO_FINDCHUNK) <> 0 then begin
WFerror(mmfp, 'Формат
куска не найден.');
Result := -3;
Exit;
end;
//если размер wav формата
> максимального размера ACM
if mminfosub.cksize > FMaxFmtSize
then begin
WFerror(mmfp, 'Размер
формата в файле не соответствует типам ACM.');
Result := -4;
Exit;
end;
// читайте wav формат....
if mmioRead(mmfp, PChar(FWaveFormat),
mminfosub.cksize)
<> LongInt(mminfosub.cksize) then begin
WFerror(mmfp, 'Ошибка
чтения куска формата.');
Result := -4;
Exit;
end;
//назад
mmioAscend(mmfp, @mminfosub, 0);
//поиск 'фактического'' куска
mminfosub.ckid := FOURCC_FACT;
if mmioDescend(mmfp, @mminfosub, @mminfopar,
MMIO_FINDCHUNK) <> 0 then begin
WFerror(mmfp, 'Ошибка
поиска RIFF ''фактического'' куска.');
Result := -7;
Exit;
end;
//чтение ''фактических'' данных
if mmioRead(mmfp, PChar(@dwTotalSamples),
mminfosub.cksize)
<> LongInt(mminfosub.cksize) then begin
WFerror(mmfp, 'Ошибка
чтения RIFF ''фактических'' данных.');
Result := -7;
Exit;
end;
//получение общего времени проигрывания файла
min:=0;
Sec:=dwTotalSamples/FWaveFormat.nSamplesPerSec ;
trackbar1.Max:= trunc(Sec);
if Sec/60 < 1 then Sec:=trunc(Sec)
else begin
Min:=trunc(Sec/60);
Sec:=trunc((Sec/60-Min)*60);
end;
Label10.Caption:=Format('%.2d:%.2d',[integer(Min),integer(Sec)]);
// назад из куска факта...
mmioAscend(mmfp, @mminfosub, 0);
// получите полный wav
размер данных (mminfo.cksize)..
mminfosub.ckid := FOURCC_DATA;
if mmioDescend(mmfp, @mminfosub, @mminfopar,
MMIO_FINDCHUNK) <> 0 then begin
WFerror(mmfp, 'Кусок
данных не найден.');
Result := -5;
Exit;
end;
// если нет никаких данных,
if mminfosub.cksize = 0 then begin
WFerror(mmfp, 'Кусок
данных не содержит никаких данных.');
Result := -6;
Exit;
end;
// теперь читайте wav
данные и копируйте во временный файл...
if CopyWaveToTempFile(mmfp,
mminfosub.cksize) <> 0 then begin
mminfosub.cksize := 0;
errormsg('Ошибка чтения wave данных.');
end;
//закрытие wav файл
mmioClose(mmfp, 0);
Cursor := crDefault;
FTotalWaveSize := mminfosub.cksize;
// признак записи данных
FRecordedData := FALSE;
// сохраните формат и тег описание строки...
GetFormatTagDetails(FWaveFormat.wFormatTag);
GetFormatDetails(FWaveFormat);
FTLabel.Caption := FFormatTag;
FDLabel.Caption := FFormatDesc;
Result := 0;
end;
/////////////////////////////////////////////////////////////////////////////
// Копируйте данные волны из файла RIFF в временый файл.
function TSysWaves.CopyWaveToTempFile(mmfp: HMMIO;datasize :
DWORD) : Integer;
var
pbuf : PChar;
ntotal : DWORD;
nbytes : integer;
readsize : DWORD;
begin
pbuf := FWaveMem[0];
readsize := WAVE_BUFSIZE;
ntotal := 0;
Result := 0;
// создайте временный файл, основанный на
текущем временном имени
if CreateTmpFile <> 0 then
begin
Result := -1;
Exit;
end;
//введите чтение/копирование цикл
while ntotal < datasize do begin
if (ntotal + readsize) > datasize then readsize :=
datasize - ntotal;
nbytes := mmioRead(mmfp, pbuf, readsize);
if nbytes = 0 then begin
Result := -2;
break;
end;
if _lwrite(FTmpFileHandle, pbuf, nbytes) <>
UINT(nbytes) then begin
Result := -3;
break;
end;
Inc(ntotal, nbytes);
end;
// закройте файл чтения...
CloseTmpFile;
end;
////////////////////////////////////////////////////////////////////////////
//Подготовка заголовков, добавьте буфер, и
начните делать запись.
function TSysWaves.StartWavePlay : Integer;
begin
FByteDataSize := 0;
FBufIndex := 0;
// откройте устройство для
регистрации(записи)...
if waveOutOpen(@FWaveOut,
WAVE_MAPPER, FWaveFormat,
Handle, 0, CALLBACK_WINDOW or
WAVE_ALLOWSYNC) <> 0 then begin
errormsg('Ошибка открытия устройства
проигрывания.');
Result := -1;
Exit;
end;
FDeviceOpened := TRUE;
// подготовка заголовков...
InitWaveHeaders;
if (waveOutPrepareHeader(FWaveOut, FWaveHdr[0],
sizeof(TWAVEHDR)) <> 0) or
(waveOutPrepareHeader(FWaveOut, FWaveHdr[1],
sizeof(TWAVEHDR)) <> 0)
then begin
CloseWaveDevicePlay;
errormsg('Ошибка подготовки заголовков для
проигрывания.');
Result := -2;
Exit;
end;
// откройте временный файл для чтения...
if OpenTmpFile = 0 then begin
CloseWaveDevicePlay;
errormsg('Ошибка
открытия временного файла для чтения');
Result := -3;
Exit;
end;
// запишите первый буфер, чтобы запустить
играть..
if QueueNextBuffer <> 0 then
begin
CloseWaveDevicePlay;
Result := -4;
Exit;
end;
FRecorderMode := recModePlay;
FMoreToPlay := TRUE;
// установите таймер чтобы модифицировать
дисплей....
Timer1.Interval := 1000;
Timer1.Enabled := TRUE;
// и очередь следующий буфер..
QueueNextBuffer;
end;
////////////////////////////////////////////////////////////////////////////
// закрытие устройства проигрывания
procedure TSysWaves.CloseWaveDevicePlay;
begin
//освобождение памяти заголовков
if (waveOutUnprepareHeader(FWaveOut,
FWaveHdr[0], sizeof(TWAVEHDR)) <> 0) or
(waveOutUnprepareHeader(FWaveOut, FWaveHdr[1],
sizeof(TWAVEHDR)) <> 0)
then errormsg('Ошибка
работы с заголовками.');
// закрыть устройство
if waveOutClose(FWaveOut) <> 0 then
errormsg('Ошибка закрытия устройства
для проигрывания.');
FDeviceOpened := FALSE;
// закрыть временый файл
CloseTmpFile;
Play.Caption:='Играть';
Select.Enabled:=true;
NoSelect.Enabled:=true;
DelTrack.Enabled:=true;
TrackBar1.Position:=0;
Play.Enabled:=true;
Stop.Enabled:=false;
Label10.Caption :=Format('%.2d:%.2d',[0,0]);
Label11.Caption :=Format('%.2d:%.2d',[0,0]);
end;
////////////////////////////////////////////////////////////////////////////
// Запись из буфера в устройство проигрывания
и переключение индекса буфера .
function TSysWaves.QueueNextBuffer : Integer;
begin
// заполните волновой буфер данными от
файла...
if ReadWaveBuffer = 0 then begin
// сбросьте поля признака (удалите атрибут WHDR_DONE)...
FWaveHdr[FBufIndex].dwFlags :=
WHDR_PREPARED;
// теперь очередь буфер для вывода...
if waveOutWrite(FWaveOut,
FWaveHdr[FBufIndex], sizeof(TWAVEHDR)) <> 0
then begin
StopWavePlay;
errormsg('Ошибка записи wave буфера.');
Result := -1;
Exit;
end;
// переключите для следующего буфера...
FBufIndex := 1 - FBufIndex;
end;
Result := 0;
end;
////////////////////////////////////////////////////////////////////////////
// Читайте кусок wav из
временного файла
function TSysWaves.ReadWaveBuffer : Integer;
begin
// если мы не столкнулись с концом wav , читайте другой буфер
if FByteDataSize < FTotalWaveSize
then begin
// читайте кусок wav из
временного файла
FWaveHdr[FBufIndex].dwBufferLength
:=
_lread(FTmpFileHandle,
FWaveMem[FBufIndex], FWaveBufSize);
// модифицируйте общее количество байтов
чтения
Inc(FByteDataSize,
FWaveHdr[FBufIndex].dwBufferLength);
Result := 0;
Exit;
end;
FMoreToPlay := FALSE; //
обработанный в MM_WOM_DONE сообщении
Result := 1;
end;
////////////////////////////////////////////////////////////////////////////
//стоп проигывание wav
файла
procedure TSysWaves.StopWavePlay;
begin
// если устройство не является открытым,
возвращаться...
if not FDeviceOpened then Exit;
// стоп игра
waveOutReset(FWaveOut);
// стоп таймер
Timer1.Enabled := FALSE;
FRecorderMode := recModeOff;
FMoreToPlay := FALSE;
// закройте устройство и освободите память
заголовков
CloseWaveDevicePlay;
end;
//====================работа с сообщениями wave=================================
//вызывается если устройство завершило
передачу данных в блок памяти, установленный
//процедурой waveInAddBuffer;
procedure TSysWaves.MMWimData(var msg: TMessage);
var
pwavehdrtmp : PWAVEHDR;
begin
// Сделанный буфер регистрации, выпишите это
pwavehdrtmp := PWAVEHDR(msg.lparam);
if WriteWaveBuffer(pwavehdrtmp.dwBytesRecorded) <> 0
then StopWaveRecord;
if FRecorderMode <> recModeOff then AddNextBuffer
//буфер в очередь
else
CloseWaveDeviceRecord;// стоп запись
end;
//////////////////////////////////////////////////////////////////////////////
//Сделать проигрывание очередного волнового
буфера, если проигран предыдущий.
procedure TSysWaves.MMWomDone(var msg: TMessage);
begin
if FMoreToPlay then QueueNextBuffer
else
StopWavePlay;
end;
/////////////////////////////////////////////////////////////////////////////
// посылается, когда устройство закрывается
функцией waveOutClose;
procedure TSysWaves.MMWomClose(var msg: TMessage);
begin
FDeviceOpened := FALSE;
end;
////////////////////////////////////////////////////////////////////////////
// Запись записаных даных в временый файл
function TSysWaves.WriteWaveBuffer(size : UINT) : integer;
begin
Result := 0;
if size = 0 then Exit;
if _lwrite(FTmpFileHandle, FWaveMem[FBufIndex], size)
<> size then begin
errormsg('Ошибка записи данных во
временный файл.');
Result := -1;
Exit;
end;
Inc(FByteDataSize, size);
end;
{************************Other*******************************************************}
////////////////////////////////////////////////////////////////////////////
//вызывает окно выбора кодека
procedure TSysWaves.GetFormatClick(Sender: TObject);
begin
GetWaveFormat;
//функция вызывающая визуальный выбор кодека
GetFormatTag.Caption := FFormatTag;
//формат
GetFormatDesc.Caption := FFormatDesc; //его характеристики
SaveConf.Enabled:=true;
end;
////////////////////////////////////////////////////////////////////////////
//останавливает проигрывание записи и
устанавливает запись на начало
procedure TSysWaves.StopClick(Sender: TObject);
begin
StopWavePlay;
end;
//////////////////////////////////////////////////////////////////////////////
//при изменениях настроек конфигурации
разблокировать кнопку сохранения
procedure TSysWaves.RadioButton1Click(Sender: TObject);
begin
SaveConf.Enabled:=true;
end;
////////////////////////////////////////////////////////////////////////////
// выводит сообщение Msg
на DisplayMemo
procedure TSysWaves.Display(Msg : String);
var
i:Integer;
begin
if DisplayMemo.Lines.Count > 100 then begin //если
число линий >100 то
//удаляются 50 первых линий
for I := 1 to 50 do DisplayMemo.Lines.Delete(0);
end;
DisplayMemo.Lines.Add(Msg); //DisplayMemo выводит Msg
end;
////////////////////////////////////////////////////////////////////////////
//Выводит сообщение об ошибках.
procedure TSysWaves.errormsg(msg : String);
begin
Application.MessageBox(PChar(msg), 'Error', MB_OK);
end;
///////////////////////////////////////////////////////////////////////////
//сохранение настроек
procedure TSysWaves.SaveConfClick(Sender: TObject);
var
v:variant;
begin
try
ConfigFile:=TIniFile.Create(IncludeTrailingBackslash(ExtractFilePath(Application.ExeName))+'config.ini');
//сохранение параметров кодека
ConfigFile.WriteInteger('WaveFormat','FormatTag',FWaveFormat.wFormatTag);
ConfigFile.WriteInteger('WaveFormat','Channels',FWaveFormat.nChannels);
v:=FWaveFormat.nSamplesPerSec;
ConfigFile.WriteInteger('WaveFormat','SamplesPerSec',v);
v:=FWaveFormat.nAvgBytesPerSec;
ConfigFile.WriteInteger('WaveFormat','AvgBytesPerSec',v);
ConfigFile.WriteInteger('WaveFormat','BlockAlign',FWaveFormat.nBlockAlign );
ConfigFile.WriteInteger('WaveFormat','BitsPerSample',FWaveFormat.wBitsPerSample);
ConfigFile.WriteInteger('WaveFormat','Size',FWaveFormat.cbSize);
//сохранение параметров работы с модемом
if RadioButton1.Checked then
ConfigFile.WriteBool('DeviceMode','AutoAnswer',true)
else
ConfigFile.WriteBool('DeviceMode','AutoAnswer',false);
if CheckBox1.Checked then ConfigFile.WriteBool('DeviceMode','Pulse',true)
else
ConfigFile.WriteBool('DeviceMode','Pulse',false);
ConfigFile.WriteInteger('DeviceMode','NumRings',StrToInt(MaskEdit1.Text));
ConfigFile.WriteInteger('DeviceMode','TimeReg',StrToInt(MaskEdit2.Text));
//настройки телефонной гарнитуры
ConfigFile.WriteInteger('VolGain','HeadSetVolume',HeadSetVolume.Position);
ConfigFile.WriteInteger('VolGain','HeadSetGain',HeadSetGain.Position);
ConfigFile.WriteInteger('VolGain','HandSetVolume',HandSetVolume.Position);
ConfigFile.WriteInteger('VolGain','HandSetGain',HandSetGain.Position);
ConfigFile.Free;
SaveConf.Enabled:=false;
except
errormsg('Ошибка
сохранения настройки конфигурации!');
end;
end;
////////////////////////////////////////////////////////////////////////////
//проигрывание и пауза выбранного файла
procedure TSysWaves.PlayClick(Sender: TObject);
begin
if (Play.Caption = 'Пауза') and (FRecorderMode =
recModePlay) then begin
Play.Caption:='Играть';
waveOutPause(FWaveOut);
Timer1.Enabled:=false;
exit;
end;
if (Play.Caption = 'Играть') and (FRecorderMode =
recModePlay) then begin
waveOutRestart(FWaveOut);
Timer1.Enabled:=true;
Play.Caption:='Пауза';
exit;
end;
if (Play.Caption = 'Играть') and (FRecorderMode =
recModeOff) then begin
//если чтение wav файла
прошло успешно, то
if ReadWaveFile=0 then begin
Select.Enabled:=false;//блокирует кнопку отбора
NoSelect.Enabled:=false;//блокирует кнопку Отмены
отбора
DelTrack.Enabled:=false;//блокирует кнопку удаления записи
Stop.Enabled:=true;//разблокирует кнопку останова
Play.Caption:='Пауза';// кнопку проигрывания
StartWavePlay
//Подготовка заголовков, добавление буферов, и начинаем проигрывание.
end ;
end;
end;
{******************таймеры используемые в
программе********************************}
/////////////////////////////////////////////////////////////////////////////
//Таймер для обновления позиции trackbar1 и времени проигрывания
procedure TSysWaves.Timer1Timer(Sender: TObject);
var
min,sec:integer;
begin
min:=0;//обнуление
кол-ва минут
trackbar1.Position:=trackbar1.Position+1;//увеличение
позиции trackbar1 на 1
//обработка времени проигрывания для приемлего
представления его на форме
sec:=trackbar1.Position;
if sec/60 >= 1 then begin
Min:=trunc(Sec/60);
Sec:=trunc((Sec/60-Min)*60);
end;
Label11.Caption :=Format('%.2d:%.2d',[Min,Sec]);
end;
/////////////////////////////////////////////////////////////////////////////
//таймер для подсчета времени с начала
состояния Connected
procedure TSysWaves.Timer3Timer(Sender: TObject);
begin
inc(FTimeCounter);//увеличиваем счетчик времени на 1 секунду
if FRecorderMode = recModeRecord then
UpdateRecordDisplay
end;
{****************************************************************************}
//Включить отбор записей
procedure TSysWaves.SelectClick(Sender: TObject);
begin
Datamodule1.WavBase.SetRangeStart;
Datamodule1.WavBase.FieldByName('DateName').AsDateTime:=DateTimePicker1.Date;
Datamodule1.WavBase.SetRangeEnd;
Datamodule1.WavBase.FieldByName('DateName').AsDateTime:=DateTimePicker2.Date;
Datamodule1.WavBase.ApplyRange;
end;
//отменить отбор
procedure TSysWaves.NoSelectClick(Sender: TObject);
begin
Datamodule1.WavBase.CancelRange;
end;
//удаление из базы текущей записи
procedure TSysWaves.DelTrackClick(Sender: TObject);
begin
FFileName:=
IncludeTrailingBackslash(ExtractFilePath(Application.ExeName)) +'WavBase\'+
datamodule1.WavBase.FieldByName('FileName').AsString;
if FileExists(FFileName) then DeleteFile(FFileName);
Datamodule1.WavBase.Delete;
end;
//При закрытии формы закрытие базы данных
procedure TSysWaves.FormClose(Sender: TObject; var Action:
TCloseAction);
begin
Datamodule1.WavBase.Close;
end;
//при изменении обьема звука наушников
procedure TSysWaves.HeadSetVolUpDownChangingEx(Sender:
TObject;
var AllowChange: Boolean; NewValue: Smallint;
Direction: TUpDownDirection);
begin
HeadSetVolume.Position:=2*NewValue;
SaveConf.Enabled:=true;
end;
//при изменении коэффициента усиления звука
наушников
procedure TSysWaves.HeadSetGainUpDownChangingEx(Sender:
TObject;
var AllowChange: Boolean; NewValue: Smallint;
Direction: TUpDownDirection);
begin
HeadSetGain.Position:=2*NewValue;
SaveConf.Enabled:=true;
end;
//при изменении обьема звука микрофона
procedure TSysWaves.HandSetVolUpDownChangingEx(Sender:
TObject;
var AllowChange: Boolean; NewValue: Smallint;
Direction: TUpDownDirection);
begin
HandSetVolume.Position:=2*NewValue;
SaveConf.Enabled:=true;
end;
//при изменении коэффициента усиления звука
микрофона
procedure TSysWaves.HandSetGainUpDownChangingEx(Sender:
TObject;
var AllowChange: Boolean; NewValue: Smallint;
Direction: TUpDownDirection);
begin
HandSetGain.Position:=2*NewValue;
SaveConf.Enabled:=true;
end;
end.
Модуль данных
unit DataMode;
interface
uses
SysUtils, Classes, DB, DBTables,bde;
type
TDataModule1 = class(TDataModule)
WavBase: TTable;
DataSource1: TDataSource;
WavBaseID: TAutoIncField;
WavBaseDateName: TDateField;
WavBaseTimeName: TTimeField;
WavBaseUserName: TStringField;
WavBaseFileName: TStringField;
procedure WavBaseAfterCancel(DataSet: TDataSet);
private
{ Private declarations }
public
{ Public declarations }
end;
var
DataModule1: TDataModule1;
implementation
{$R *.dfm}
//сброс кэша на диск с помощью механизма BDE
procedure TDataModule1.WavBaseAfterCancel(DataSet:
TDataSet);
begin
Check(dbiSaveChanges(WavBase.Handle));
end;
end.
Модуль со справочной информацией
unit About;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TAbouts = class(TForm)
Panel1: TPanel;
ProductName: TLabel;
Version: TLabel;
Copyright: TLabel;
Label2: TLabel;
OKButton: TButton;
ProgramIcon: TImage;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Abouts: TAbouts;
implementation
{$R *.dfm}
//При нажатии кнопки 'Ок'
procedure TAbouts.OKButtonClick(Sender: TObject);
begin
close;
end;
end.
Модуль выбора интерфейса
unit VarTo;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TVarS = class(TForm)
GroupBox1: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
UserName: TEdit;
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
VarS: TVarS;
implementation
{$R *.dfm}
//При нажатии кнопки 'Выход'
procedure TVarS.BitBtn2Click(Sender: TObject);
begin
Application.Terminate;
end;
//При нажатии кнопки 'Вход'
procedure TVarS.BitBtn1Click(Sender: TObject);
begin
if RadioButton1.Checked then VarS.Tag:=1;
if RadioButton2.Checked then VarS.Tag:=2;
close;
end;
//При выборе интерфейса - администратор
procedure TVarS.RadioButton2Click(Sender: TObject);
begin
UserName.Enabled:=false;
end;
//При выборе интерфейса - пользователь
procedure TVarS.RadioButton1Click(Sender: TObject);
begin
UserName.Enabled:=true;
end;
end.