Загрузка процессора

← →
Реактор © (2004-05-03 18:39) [0]

Когда запускаю свою программу (написанною мной на дельфях разумеется), то в момент сложных и долгих математических вычислений она забирает все ресурсы процессора. Пока программа не закончит вычисления я не могу пользоваться компом. Как сделать так, что бы прога оставляла и другим программам хоть чуть чуть?
И еще один вопрос. Как реализовать выход из процедуры по событию (нажатие клавиши, клик мышки и т.п.). Типа как раньше писали if keypressed then exit;

← →
div © (2004-05-03 18:54) [1]

(ИМХО) Вынести процедуру вычислений в отдельный поток (TThread). Это даст так же возможность управлять приоритетом твоего потока вычислений.

← →
Реактор © (2004-05-03 19:21) [2]

Еще варианты есть? Не совсем то, что хотелось бы, хотя вариант конечно.

← →
Palladin © (2004-05-03 19:22) [3]

А что хотелось бы? На рынке чтоли?

← →
begin...end © (2004-05-03 19:23) [4]

> Реактор © (03.05.04 18:39)

> Как реализовать выход из процедуры по событию (нажатие клавиши, клик мышки и т.п.)

var DoExit: Boolean; procedure TForm1.Form(Sender: TObject); begin DoExit := True; end; procedure MyProcedure; begin DoExit := False; repeat ... until DoExit; end;

← →
begin...end © (2004-05-03 19:24) [5]

Глюк...

TForm1.Button1Click(Sender: TObject), имелось в виду.

← →
Реактор © (2004-05-03 21:10) [6]

To begin ... end

Так ведь если процедура MyProcedure уже работает, то никакое нажатие кнопки не заставит запуститься Button1Click, до тех пор пока MyProcedure не закончит работу.

← →
Romkin © (2004-05-03 21:26) [7]

Вообще говоря, работать обычно можно. Если хочешь комфорта, то цикл вычислений надо прерывать.
Есть два пути:
Application.ProcessMessages - но учти, что пойдет обработка всех событий, и кнопки будут нажиматься, и тд.
sleep(1) - просто передача управления другим потокам, отдается таймслот.

← →
Реактор © (2004-05-03 21:35) [8]

А сделать так, что бы нажималась только одна кнопка и больше ничего не нажималось нельзя (в момент работы MyProcedure)?

← →
TButton © (2004-05-03 22:23) [9]

за disable"ить остальные.
или в обработчике он клик делать проверку идет вычисление или нет. т.е.
var DoExit: Boolean; DoCalc: Boolean; procedure TForm1.btnCancel(Sender: TObject); begin DoExit := True; end; procedure TForm1.btnOther(Sender: TObject); begin if DoCalc then Exit; ... end; procedure MyProcedure; begin DoExit := False; DoCalc := True; repeat ... until DoExit; DoCalc := False; end;

← →
Реактор © (2004-05-03 22:38) [10]

Вот только дизаблить и остается :(

← →
Реактор © (2004-05-03 22:42) [11]

К слову - то, что написал ТButton работать не будет. Тут действительно остается только THread и дизабл всех остальных кнопок.

← →
DrPass © (2004-05-03 22:48) [12]

> TButton © (03.05.04 22:23) [9]

Это сможет работать только в том случае, если MyProcedure будет выполняться в другом потоке программы.

← →
Реактор © (2004-05-03 22:56) [13]

Вот в том вся и проблема, что не хочу я делить на потоки.

← →
DrPass © (2004-05-03 23:00) [14]

Непонятно, почему? Потому что лень разбираться в этом? Тогда ты можешь поставить пониже приоритет основному потоку своей программы

← →
Реактор © (2004-05-03 23:20) [15]

Я объясню. У меня в общей сложности на экране только одних кнопок более 200. А вся соль лишь в одной процедуре, которую просто надо как-то останавливать. На потоки делить даже нечего. Причем если в момент выполнения процедуры будет нажата какая-либо другая кнопка ( и не только кнопка), то ее выполнение станет некорректным.
Я вот думаю, а нет ли доступа к буферу куда попадает нажатие клавиши в момент выполнения процедуры. Неужели нет никакой альтернативы функциям Keypressed и ReadKey?

← →
Юрий Зотов © (2004-05-03 23:53) [16]

> Реактор © (03.05.04 18:39)
> Как сделать так, что бы прога оставляла и другим программам
> хоть чуть чуть?

Не трогать приоритеты. В Win32 вытесняющая мультизадачность, она все сделает сама.

> Реактор © (03.05.04 22:42) [11]
> остается только THread и дизабл всех остальных кнопок.

Самое грамотное решение.

> Реактор © (03.05.04 23:20) [15]
> На потоки делить даже нечего.

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

Альтернатива второму потоку - периодический вызов Application.ProcessMessages в коде вычислений. Но тогда вычисления замедлятся.

← →
DrPass © (2004-05-03 23:54) [17]

Альтернатива есть. Даже несколько:
1. Использование потоков. Отправить эту процедуру в другой поток - вполне разумный вариант.
2. Application.ProcessMessages. Если нажатие на другие кнопки во время выполнения вредит - просто отключи их при входе в процедуру.
3. PeekMessage. Позволяет заглянуть в очередь сообщений (аналогично KeyPressed). Естественно, сообщения тоже кто-то должен (или что-то должно) посылать.
P.S. 200 кнопок на экране - это нечто

← →
Anatoly Podgoretsky © (2004-05-04 08:55) [18]

Реактор © (03.05.04 23:20) [15]
Процедуру выполнять в модальной форме.

← →
KSergey © (2004-05-04 09:34) [19]

Я уже как-то приводил здесь этот код... Мастера др головке не погладят, конечно, за подход, но работает
Вся идея - на отдельной форме индикатора прогресса (строим по вкусу) и на периодических вызовах Application.ProcessMessages внутри "длинного" цикла.
Активной оставляем лишь кнопку "стоп" на индикаторе.

TProgressForm = class(TForm) ... private { Private declarations } FWindowList: Pointer; FSaveCursor: TCursor; FActiveWindow: HWnd; FIsAborted: Boolean; function GetIsAborted: Boolean; ... public property IsAborted: Boolean read GetIsAborted write FIsAborted; procedure InitializeProgress(...); ... end; ..................... function TProgressForm.GetIsAborted: Boolean; begin Result := FIsAborted OR Application.Terminated; end; procedure TProgressForm.InitializeProgress(...некие параметры отображения...); begin // проверка - индикатор уже инициализирован? if Visible then Exit; // уже и так индикатор активен - выход // настраиваем параметры отображения ...... isAborted:=false; //--- дальнейший код взят из TCustomForm.ShowModal и несколько урезан CancelDrag; if GetCapture <> 0 then SendMessage(GetCapture, WM_CANCELMODE, 0, 0); ReleaseCapture; Include(FFormState, fsModal); FActiveWindow := GetActiveWindow; FSaveCursor := Screen.Cursor; Screen.Cursor := crDefault; FWindowList := DisableTaskWindows(0); Show; SendMessage(Handle, CM_ACTIVATE, 0, 0); //-- конец кода из TCustomFirm.ShowModal Application.ProcessMessages; end; procedure TProgressForm.EndProgress(...); begin ....... // всякие настройкм вида //--- дальнейший код взят из TCustomForm.ShowModal и несколько урезан if GetActiveWindow <> Handle then FActiveWindow := (0); Hide; Screen.Cursor := FSaveCursor; EnableTaskWindows(FWindowList); if FActiveWindow <> 0 then SetActiveWindow(FActiveWindow); Exclude(FFormState, fsModal); //--- конец кода, взятого из TCustomForm.ShowModal end; // обработчик кнопки "стоп" procedure TProgressForm.btnCloseClick(Sender: TObject); begin isAborted:=true; end;

Программа:

ProgressForm.InitializeProgress(...); ...цикл... Application.ProcessMessages; // до проверки! if ProgressForm.isAborted then Break; ...конец цикла... ProgressForm.EndProgress(...);
Не плохо, конечно, try/finally навернуть, чтобы EndProgress гарантированно вызвалось, а то получим задизабленное приложение.
Разумеется, что Application.ProcessMessages надо вызывать не слишком часто. Короче все, как обычно с ним.

To Юрий Зотов.
win32 почему-то это не делает. Я запускаю программу, она забирает 100% загрузки процессора и комп висит, пока программа не закончит работу.

Забирает 100% - это понятно. Но уж так ли уж весь комп висит??
Хотя, признаю, я давно на NT-плтформе, возможно забыл как оно было на Win9x. У вас OC какая?

Народ. Спасибо большое. Я все понял. Придется конечно помучатся, так как из более 300 объектов на экране некоторые задизаблены, придется запоминать какие из них живые перед тем как дизаблить всех. Тут правда еще одна проблема нашлась, но это наверное от моего незнания. Из процедуры TMyThread.MyProc не могу вызвать процедуру Form1.MyProc(Sender). Ругается насчет параметров. Так что придется делать через Application.
Старый я просто, когда в институте учился никакого объектно-ориентированного программирования слыхом не слыхивали. Года еще нет, как заставил себя на дельфи переориентировать.
Спасибо всем еще раз. Если что, я уж кВам. Больше спросить некого.

> Из процедуры TMyThread.MyProc не могу вызвать процедуру
> Form1.MyProc(Sender).

Я конечно не знаю начинку Form1.MyProc(Sender), но что-то страшно мне заранее за такой код...

> так как из более 300 объектов на экране некоторые задизаблены,
> придется запоминать какие из них живые перед тем как дизаблить
> всех.

Не надо запоминать!! См. мой код. Да, там отдельная форма (что намного проще в реализации), ну да кому она мешает? С потоком все равно придется модальную скорее всего городить, если нет необходимости параллельно считать и что-то делать.

To Реактор
Сочувствую, но придется. А также полностью переписать процедуру и передавыть ей значения в большом рекорде.

... FLockCnt:integer; FLockList:TList; ... FLockList := TList.Create; ... FreeAndNil(FLockList); ... procedure TCkgFromAdapter.LockIn; Procedure DisableControls(const c:TWidgetControl); overload; var i:integer; begin for i:= 0 to c.ControlCount -1 do begin if c.Controls[i].Enabled then begin FLockList.Add(c.Controls[i]); c.Controls[i].Enabled := false; end; if c.Controls[i] is TWidgetControl then DisableControls(TWidgetControl(c.Controls[i])); end; end; begin if (csCreating in form.ControlState) then exit; if FLockCnt = 0 then begin FLockList.Clear; DisableControls(form); end; inc(FLockCnt); end; procedure TCkgFromAdapter.LockOut; Procedure EnableControls(const c:TWidgetControl); overload; var i:integer; begin for i:= 0 to c.ControlCount -1 do begin if not c.Controls[i].Enabled then if FLockList.IndexOf(c.Controls[i]) <> -1 then c.Controls[i].Enabled := true; if c.Controls[i] is TWidgetControl then EnableControls(TWidgetControl(c.Controls[i])); end; end; begin if (csCreating in form.ControlState) then exit; dec(FLockCnt); if FLockCnt = 0 then begin EnableControls(form); FLockList.Clear end; end;

Звиняюсь что кинул код без коментариев, этот код дизаблит контролы. Код цликсный для vcl заменить twidgetcontrol на twincontrol.

Загрузка процессора Найти похожие ветки