Форум: "Основная";
Текущий архив: 2003.07.07;
Скачать: [xml.tar.bz2];

Вниз

Если приложение в цикле, как прервать этот цикл?   Найти похожие ветки 

← →
delphimun   (2003-06-23 20:40) [0]

Например такой цикл: while true do form1.caption := inttostr(i);
Можно ли прирвать этот цикл, если пользователь нажмет отмену.
Я пробовал вот так:
Основная:

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses unit2;
procedure TForm1.Button1Click(Sender: TObject);
var
th:abc;
begin
if button1.caption = "Start" then begin
th := abc.create(false);
button1.caption := "Stop";
end else begin
th := abc.create(true);
button1.caption := "Start";
end;
end;
end.

Поток:

unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,unit1;
type
abc = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure a;
end;
implementation
procedure abc.a;
var
i:integer;
begin
i := 0;
while true do begin
form1.Caption := inttostr(i);
i := i+1;
end;
end;
procedure abc.Execute;
begin
Synchronize(a);
end;
end.
Но кнопка "Stop" не работает(не нажимается)
Заранее благодарен.

---

← →
Palladin   (2003-06-23 20:49) [1]

какой смысл в этом потоке скажи мне?

---

← →
TsvIlya   (2003-06-24 07:54) [2]

> Synchronize(a);


Synchronize используется для синхронизации с основным потоком программы. В этом случае Synchronize нужно использовать так:

type
abc = class(TThread)
private
Fi: Integer;
protected
procedure Execute; override;
procedure a;
end;

implementation

procedure abc.a;
begin
form1.Caption := inttostr( Fi);
end;

procedure abc.Execute;
begin
Fi := 0;
while true do begin
Fi := Fi + 1;
// Сюда лучше добавить длительных действий
Synchronize(a);
end;

end;

Как я уже сказал, в тело цикла лучше добавить чего-нибудь долгоисполняющегося, а то возможно не будет видно эффекта от многопоточности.

---

← →
Bel   (2003-06-24 10:03) [3]

Прервать цикл - Break.
А кнопка Stop не нажимается потому, что основной поток у тебя зависает, т.к. в нём выполняется твой бесконечный цикл. Чтобы этого не было, см. TsvIlya (24.06.03 07:54) - синхронизировать надо только непосредственно присвоение Caption.

---

← →
Bel   (2003-06-24 10:10) [4]

Кроме того, у тебя при нажатии на кнопку Stop запускается ещё один процесс. Если тебе надо остановить существующий, то надо писать th.Terminate. А в потоке проверять if Terminated then Break.
А вообще, почитай книжку про потоки. Хотя, если ты даже не знаешь как прервать цикл, тогда начни с основ языка.

---

← →
Семен Сорокин   (2003-06-24 10:16) [5]

2TsvIlya
В твоем случае еще не помешает
FreeOnTerminate := true;

---

← →
delphimun   (2003-06-24 12:20) [6]

Я попробовал так:
Основной:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses unit2;
procedure TForm1.Button1Click(Sender: TObject);
var
th:abc;
begin
if button1.caption = "Start" then begin
th := abc.create(false);
button1.caption := "Stop";
end else begin
th.Terminate;
button1.caption := "Start";
end;
end;
end.

Поток:

unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,unit1;
type
abc = class(TThread)
private
Fi: Integer;
protected
procedure Execute; override;
procedure a;
end;
implementation
procedure abc.a;
begin
form1.Caption := inttostr(Fi);
end;
procedure abc.Execute;
begin
FreeOnTerminate := true;
Fi := 0;
while true do begin
Fi := Fi + 1;
if Terminated then
Break;
Synchronize(a);
end;
end;
end.
Но при нажатии на Stop Вылетает ошибка и цикл продолжается

---

← →
TsvIlya   (2003-06-24 13:21) [7]

У тебя th - локальная переменная в procedure TForm1.Button1Click(Sender: TObject); Эта переменная создается только на время исполнения этой процедуры, а потом освобождается. Поэтому, когда ты снова вызываешь Button1Click, th = nil.
Вынеси её, как переменную модуля:

implementation
{$R *.dfm}
uses unit2;

var
th: Tabc;

НО, измени имя класса с "abc" хотя бы на "Tabc", а то лично у меня какой-то конфликт возник.
Если используешь

if Terminated then
Break;

, то FreeOnTerminate := true не надо.

---

← →
TsvIlya   (2003-06-24 13:22) [8]

И было бы вообще замечательно, если бы ты перед тем как задавать вопрос, посторался решить его сам... :)

---

← →
delphimun   (2003-06-24 13:48) [9]

TsvIlya> Большое спасибо, просто бошка уже забилась и от невнимательности не заметил, что переменную локально объявил

---

← →
panov   (2003-06-24 13:54) [10]

if Terminated then
Break;

, то FreeOnTerminate := true не надо.

FreeOnTerminate := True;

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

Если же использоется TMyThread.Free, то тогда не нужно устанавливать это свойство в потоке.

---

← →
TsvIlya   (2003-06-24 13:58) [11]

> panov © (24.06.03 13:54)

Спасибо за замечание... :)

---

← →
Leshiy   (2003-06-24 14:46) [12]

var
Form1: TForm1;
work:boolean;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
work:=true;
i:=0;
while work do
begin
inc(i);
Label1.Caption:=IntToStr(i);
Application.ProcessMessages;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
work:=false;
end;

end.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.07.07;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.008 c