Как бороться с “thread creation error

Тема в разделе "Delphi - FAQ", создана пользователем msn777, 16 янв 2005.

Статус темы:
Закрыта.
  1. msn777

    msn777 Гость

    Мастера подскажите, как бороться с “thread creation error: Недостаточно памяти для обработки команды”, говорит, что, мол, мало памяти, хотя под стек выделено 256M {$M 16384,268435456}, на машине стоит 512М, в диспетчере задач приложение показывает, что для приложения выделено около 5M. Пишу на Delphi 7 под WinXP.
    Может, кто сталкивался с такой бедой, из каких соображений принимается решение, что не хватает памяти. До того как в проге было мало элементов (меньше сотни кнопок, меток и т.д.) такое сообщение не выскакивало, сейчас их несколько сотен, такое сообщение выскакивает, после того, как вызываю play_sound для проигрывания wav файла, но ф-н sndPlaySound все время выдает FALSE, хотя перенес этот модуль из старого проекта там все работало, а после этого еще раз play_sound но для пробирования тона, процесс (Thread) созданный sndPlaySound так и остается, а звука нет. Причем если вызывать sndPlaySound с тем же именем файла, но указанным как константа – звук есть, если же переменная (PChar) – звука нет.

    Содержание ComboBox’ов (ItemIndex = -1 если задал имя файла ):
    нет
    100 Гц, 1 гудок
    100 Гц, 2 гудка
    200 Гц, 1 гудок
    200 Гц, 2 гудка
    300 Гц, 1 гудок
    300 Гц, 2 гудка
    500 Гц, 1 гудок
    500 Гц, 2 гудка
    700 Гц, 1 гудок
    700 Гц, 2 гудка
    1000 Гц, 1 гудок
    1000 Гц, 2 гудка
    1500 Гц, 1 гудок
    1500 Гц, 2 гудка
    2000 Гц, 1 гудок
    2000 Гц, 2 гудка

    type
    TPlayToneThread = class(TThread) // Поток проигрывания тона
    private
    Frequency: integer; // Частота тона, Гц
    Duration: integer; // Длительность выдачи тона, мс
    Count: integer; // Кол-во выдаваемых тонов
    protected
    procedure Execute; override; // Исполняемая часть
    end;

    //----------------------------------- Выдать на динамик тон ----------------------------------------
    procedure Sound(Frequency, Duration: Integer);
    asm
    push edx
    push eax
    mov eax, Win32Platform
    cmp eax, VER_PLATFORM_WIN32_NT
    jne @@9X
    call Windows.Beep
    ret
    @@9X:
    pop eax
    pop edx
    push ebx
    push edx
    mov bx, ax
    mov ax, 34DDh
    mov dx, 0012h
    cmp dx, bx
    jnc @@2
    div bx
    mov bx, ax
    in al, 61h
    test al, 3
    jnz @@1
    or al, 3
    out 61h, al
    mov al, 0B6h
    out 43h, al
    @@1:
    mov al, bl
    out 42h, al
    mov al, bh
    out 42h, al
    call Windows.Sleep
    in al, 61h
    and al, 0FCh
    out 61h, al
    jmp @@3
    @@2:
    pop edx
    @@3:
    pop ebx
    end;


    //--------------------------------- Реализация потока проигрывания тона ----------------------------
    procedure TPlayToneThread.Execute;
    begin
    FreeOnTerminate:=True; // По завершению работы освободить память
    while Count>0 do
    begin
    Sound(Frequency,Duration);
    sleep(Duration);
    dec(Count);
    end;
    Terminate; // На всяк случай завершаем поток
    end;


    //--------------------------------- Процедура завершения потока ------------------------------------
    procedure TfmOSC_Buzzer.end_thread(Sender: TObject);
    begin
    PlayToneThread:=nil; // На всяк случай уничтожаем объект
    end;

    //-------------------------------------- Проиграть звук --------------------------------------------
    procedure TfmOSC_Buzzer.play_sound(cbSound: TComboBox; play: boolean = false);
    const
    Duration: integer = 75;
    var
    Frequency, Count: integer;
    begin
    if cbSound.ItemIndex=0 then exit; // Если нечего проигрывать то выходим

    if cbSound.ItemIndex<0 then // Если это *.wav файл
    try
    sndPlaySound(PChar(cbSound.Text),SND_ASYNC); // то просто проигрываем его
    except
    end
    else begin
    Frequency:=StrToInt(Trim(Copy(cbSound.Text,1,4))); // Определили частоту и кол-во гудков
    if Odd(cbSound.ItemIndex) then Count:=1 else Count:=2;
    if IsWindowsNT then
    begin
    {
    if PlayToneThread<>nil then // Если поток существует
    if not PlayToneThread.Terminated then // Да он еще и не завершен
    begin
    if play then // Если нужно проиграть
    PlayToneThread.Terminate // то завершили поток
    else // Если событие
    exit; // то выходим
    end;
    PlayToneThread:=TPlayToneThread.Create(true); // Создаем поток
    PlayToneThread.OnTerminate:=end_thread; // Задали процедуру завершения
    PlayToneThread.Priority:=tpNormal; // Задаем нормальный приоритет потоку
    PlayToneThread.Frequency:=Frequency;
    PlayToneThread.Duration:=Duration;
    PlayToneThread.Count:=Count;
    PlayToneThread.Resume; // Запускаем поток
    }
    {}
    while Count>0 do
    begin
    Sound(Frequency,Duration);
    sleep(Duration);
    dec(Count);
    end;
    {}
    end
    else begin
    while Count>0 do
    begin
    Sound(Frequency,Duration);
    sleep(Duration);
    dec(Count);
    end;
    end;
    end;
    end;
     
  2. Dico

    Dico Гость

    здесь по исходнику непонятно что именно занесли в регистр eax ( Win32Platform-что это за данные?)?
     
  3. Barmutik

    Barmutik Гость

    Просто так к вопросу: а чем не устраивает системная функция Beep для проигрывания ?
     
  4. zubr

    zubr Гость

    msn777
    1. В procedure Sound(Frequency, Duration: Integer) параметры Frequency, Duration нигде не используются.
    2. В procedure Sound(Frequency, Duration: Integer) ты обращаешся к системному спикеру, для чего и нужны параметры частота и длительность тона. И в тоже время выдаешь звук через динамики с помощью функции Beep.
    3. В procedure TfmOSC_Buzzer.play_sound(cbSound: TComboBox; play: boolean = false) procedure Sound(Frequency, Duration: Integer) выполняется не в потоке.
     
  5. Guest

    Guest Гость

    >здесь по исходнику непонятно что именно занесли в регистр eax ( Win32Platform-что это за данные?)?
    Это проверка какая платформа NT или нет.

    >Просто так к вопросу: а чем не устраивает системная функция Beep для проигрывания ?
    Потому что прога должна работать и под 98, а там нет ф-н. проигроваия тона на спикере.

    >1. В procedure Sound(Frequency, Duration: Integer) параметры Frequency, Duration нигде не используются.
    Есть в Delphi такая штука как соглашение о передаваемых параметрах так вот Frequency, Duration передаются в EAX и EDX.

    >2. В procedure Sound(Frequency, Duration: Integer) ты обращаешся к системному спикеру, для чего и нужны параметры частота и длительность тона. И в тоже время выдаешь звук через динамики с помощью функции Beep.
    call Windows.Beep – это обращение к спикеру по NT с Frequency Duration

    >3. В procedure TfmOSC_Buzzer.play_sound(cbSound: TComboBox; play: boolean = false) procedure Sound(Frequency, Duration: Integer) выполняется не в потоке.
    Да потому, что не работает почему-то в потоке после первого вызова sndPlaySound(PChar(cbSound.Text),SND_ASYNC);
     
  6. zubr

    zubr Гость

    Где ты вызываешь procedure TfmOSC_Buzzer.play_sound(cbSound: TComboBox; play: boolean = false)? Может в этом проблема.

    Еще можешь попробовать вместо sndPlaySound что то типа этого:
    Код (Text):
    procedure SoundWavFile(FileName:string);
    var
    format:TWaveFormatEx;
    hzv:HWaveOut;
    hider:WaveHdr;
    buf:PChar;
    fl:TMemoryStream;
    begin
    fl:=TMemoryStream.Create;
    fl.LoadFromFile(FileName);
    fl.Position:=0;
    buf:=StrAlloc(fl.Size);
    fl.Read(buf^, fl.Size);
    format.wFormatTag:=WAVE_FORMAT_PCM;
    format.nChannels:=2;
    format.nSamplesPerSec:=44100;
    format.nAvgBytesPerSec:=fl.Size;
    format.nBlockAlign:=4;
    format.wBitsPerSample:=16;
    format.cbSize:=0;
    waveOutOpen(@hzv, WAVE_MAPPER, @format, 0, 0, CALLBACK_NULL);
    hider.lpData:=@buf^;
    hider.dwBufferLength:=fl.Size;
    fl.Free;
    waveOutPrepareHeader(hzv, @hider, SizeOf(hider));
    waveOutWrite(hzv, @hider, SizeOf(hider));
    waveOutUnPrepareHeader(hzv, @hider, SizeOf(hider));
    waveOutClose(hzv);
    StrDispose(buf);
    end;
     
Загрузка...
Статус темы:
Закрыта.

Поделиться этой страницей