| Вопрос: Помогите выдать сигнал на спиккер! (Beep) | Добавлено: 18.02.05 09:17 |
Автор вопроса:  AnGeR | ICQ: 174443367 |
|
У меня возникла проблема с выводом сигнала типа бип под 98 виндузой в ХР я делаю:
Private Declare Function APIBeep Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long Private Sub Command1_Click() APIBeep 300, 100 End Sub и все работает, а мне надо ПОЗАРЕЗ!!!! "пикать" под 98 |
| Ответы | Всего ответов: 9 |
|
Номер ответа: 1 Автор ответа:  cresta Вопросов: 117 Ответов: 1538 |
Профиль | | #1 | Добавлено: 18.02.05 10:22 |
| В 98 Beep не поддерживает частоту и длительность сигнала. | ||
|
Номер ответа: 2 Автор ответа: CyRax  Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #2 | Добавлено: 18.02.05 11:41 |
|
Можно попробовать API MessageBeep c параметром -1.
Не знаю то ли это что нужно, но во всяком случае пищит из динамика. |
||
|
Номер ответа: 3 Автор ответа:  someoneВопросов: 215 Ответов: 1596 |
Web-сайт: Профиль | | #3 | Добавлено: 18.02.05 12:52 |
|
у меня не пикает =(
а меня тоже этот вопрос интересует. |
||
|
Номер ответа: 4 Автор ответа: AnGeR ICQ: 174443367 Вопросов: 2 Ответов: 3 |
Профиль | | #4 | Добавлено: 18.02.05 16:38 |
|
все!!! сделал на асемблере. Для тех кому интересно вот асмский код:
Const Tone EQU [ebp+8] Const Number EQU [ebp+12] MOV EDX,Number MOV EAX,&h1000000 MOV EBX,Number MUL EBX Const K_B equ &h61 Const K_RUS equ &h43 Const T_2 equ &h42 Const US equ &b10100111 IN AL,K_B OR Al,3 OUT K_B,AL MOV AL,US OUT K_RUS,AL MOV AL,Tone OUT T_2,AL mov ecx,Eax abc: dec ecx Jnz abc IN AL,K_B AND AL,&hFC OUT K_B,AL вставить его в басик можно при помощи LocASM который в свою очередь можно качнуть из раздела полезные программы единственный недостаток в том что пока идет звук функция не возврощает управление и тормозит всю прогу можно доработать если разбить на две: 1) инициализация звука (до abc: dec ecx Jnz abc) и 2) и выключение звука (все что после этих строк) |
||
|
Номер ответа: 5 Автор ответа: crestaВопросов: 117 Ответов: 1538 |
Профиль | | #5 | Добавлено: 18.02.05 17:31 |
|
А для чего MOV EDX,Number ?
И что по адресам [ebp+12] и [ebp+8]? И то, что результат умножения содержимого[ebp+12] на h1000000 затем искажается командой in - ничего? Что-то непонятно 
Да и не работает - прога вылетает на первой же операции ввода. |
||
|
Номер ответа: 6 Автор ответа: AnGeRICQ: 174443367 Вопросов: 2 Ответов: 3 |
Профиль | | #6 | Добавлено: 18.02.05 19:07 |
MOV EDX,Numbe действительно не надо просто я правил другой файл и это осталось от старого  )
в [ebp+8] содержиться тон звука например 50 в [ebp+12] длительность например 10 а умножаеться на h1000000 для того чтобы не водить такие космические числа а например 5 не знаю почему у тебя не работает я перепроверил у меня все работает. Если что _des_@mail.ru |
||
|
Номер ответа: 7 Автор ответа: AnGeRICQ: 174443367 Вопросов: 2 Ответов: 3 |
Профиль | | #7 | Добавлено: 18.02.05 19:11 |
|
на всякий случай вот готовый басиковский модуль:
Option Explicit Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _ ByVal lpPrevWndFunc As Long, _ ByVal hwnd As Long, _ ByVal msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Private CodeArray() As Byte Private CodeArray_Ptr As Long Function Hex2Bin(ByRef Source As String) As String  im RetFunc As String
im Convert As Long
For Convert = 1 To Len(Source) Step 2 RetFunc = RetFunc & Chr$(Val("&H" & Mid$(Source, Convert, 2))) Next Convert Hex2Bin = RetFunc End Function Public Function ExecuteCode(ByVal StringToConvert As String, ByVal P1 As Long, ByVal P2 As Long, ByVal P3 As Long, ByVal P4 As Long, Optional ByVal FromHex As Boolean = False) im Sbgn As String, Send As String
im t1 As Single, t2 As Single
If FromHex Then StringToConvert = Hex2Bin(StringToConvert) ReDim CodeArray(Len(StringToConvert)) CodeArray = StrConv(StringToConvert, vbFromUnicode) CodeArray_Ptr = VarPtr(CodeArray(0)) ExecuteCode = CallWindowProc(CodeArray_Ptr, P1, P2, P3, P4) End Function Sub Main() Const HexCode As String = "5589E553565781EC0C000000B8000000018B5D0CF7E3E4610C" & _ "03E661B0A7E6438A4508E64289C1FFC90F85F8FFFFFFE46124" & _ "FCE66189EC81EC0C0000005F5E5B5DC21000" im BinSource As String: BinSource = Hex2Bin(HexCode)
On Error GoTo ErrASM im P1 As Long, P2 As Long, P3 As Long, P4 As Long
'Parameters to pass P1 = 50: P2 = 100: P3 = 0: P4 = 0 'Execute machine code from BinSource variable MsgBox "FUNCTION RETURN: " & ExecuteCode(BinSource, P1, P2, P3, P4) Exit Sub ErrASM: MsgBox "Ошибка в машинном коде", 48, Error$(Err) Resume Next End Sub |
||
|
Номер ответа: 8 Автор ответа: CyRax Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #8 | Добавлено: 21.02.05 14:33 |
|
AnGeR,
Уже есть обновления в Local Assembler. Добавлены директива #DEBUG и библиотека сопроцессора (неполная правда). Ну и исправлены кое какие ошибки. Если интересует - выложу на сайте. Да, и предупреждение всем кто ещё его использует. Инструкция BT не работает с регистрами - только с памятью. Постараюсь вскорости это исправить. |
||
|
Номер ответа: 9 Автор ответа: CyRax Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | | #9 | Добавлено: 22.02.05 15:59 |
|
Свежую версию качать здесь:
http://basicproduction.nm.ru/ASM/LocASM22.rar |
||
Страница: 1 |