Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Как бороться с “thread creation error: Недостаточно памяти для…  (Прочитано 11814 раз)
0 Пользователей и 1 Гость смотрят эту тему.
msn777
Гость
« : 16-01-2005 18:33 » 


Мастера подскажите, как бороться с “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;
Записан
Серж
Гость
« Ответ #1 : 17-01-2005 07:55 » 

msn777, метод TThread.Terminate устанавливает переменную Terminated в True и больше не делает ничего. Поскольку эта переменная нигде в теле потока не проверяется, поток не заканчивается, а каждый раз создается новый, отсюда и нехватка памяти.
Записан
msn777
Гость
« Ответ #2 : 17-01-2005 18:26 » 

Поток является объектом, у которого есть функции создания и уничтожения потока, как известно поток живет до тех пор пока не вышли из метода Execute, т.е. проверять Terminated на True нужно только в том случае если поток будет останавливаться извне .Поэтому после генерации тона поток остановится – система и Delphi возьмут на себя обязанности освоить память и т.д.
Это полностью рабочий код, который перестал работать при добавлении элементов на форму, как это связано с thread creation error я и хочу узнать.
Записан
Unregistered
Гость
« Ответ #3 : 05-04-2005 04:27 » new

Организуй процедуру запуска потока по другому (читай "нормальному"). Если честно, то твой код (не смотря на простоту) читается с трудом. Зачем пишешь Terminate, если он и так терминируется? Что преследует переменная Play? Если тру, то дать директиву на завершение (на которую ему, судя по коду, абсолютно наплевать) и создать еще один поток..., а если фальш, то выход... Зачем Play?
Примерно, процедуру play_sound я бы написал так:

procedure TfmOSC_Buzzer.play_sound(AFrequency, ADuration,ACount: Integer);
begin
   if PlayToneSound<>nil then PlayToneThread.Terminate;
   While PlayToneSound<>nil do begin end;  //как способ подождать завршения потока
   
   PlayToneThread:=TPlayToneThread.Create(AFrecuency,ADuration,ACount)

end;


constructor TPlayToneThread.Create(AFrecuency,ADuration,ACount:integer);
begin
    inherited create(true);
       Frecuency:=AFrecuency;
       Duration:=ADuration;
       Count:=ACount;
       Resume;
end;

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

Переменные Frequency,Duration,Count описать в потоке;

Ну вот так попробуй. И еще совет, смотри на счетчик потоков своего приложения в диспетчере задач. при запуске будет один поток, при проигрывании два, после завершения - опять один. так можно проконтролировать, уничтожается у тебя поток или нет.
Надеюсь помог.
Записан
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines