Пауза и остановка процедуры

MrDiG · #1 14.10.2010, 09:42

Есть процедура. Которая может выполняться ну очень долго в силу большого объёма исходного материала. Ну например, какое-нибудь копирование, парсинг, постинг.

Так вот вопрос - как поставить выполнение на паузу, и как остановить. В качестве примера, приведу код процедуры с которой мне вчера помогли - копирование с задержкой:

Код:

procedure TForm1.FakeCheck;
var i:integer;
begin
for i := 0 to Memo3.Lines.Count - 1 do begin
StatusBar1.Panels.Items[0].Text:= Memo3.Lines[i];
delay(2); //тут задержка в секундах
ProgressBar1.Position:=Round(1000 * i/Memo3.Lines.Count-1);
end;
end;

Нужно обрабатывать её тремя кнопками.
Запуск, Пауза, Стоп

Если с запуском, всё прозрачно, то как её остановить, или прервать - только мысли.
Например, использовать конструкцию вроде Form1.Tag := 0; при запуске. По нажатию на кнопку паузы менять значение допустим на единицу, ну а при 2 - останавливать.

NumLock · #2 14.10.2010, 10:34

TThread: Create, Suspend, Resume, Terminate

friz · #3 14.10.2010, 10:35

хм...
а если что-нить такое:

Код:

for i:=1 to zu do
begin
  if action=3 then break;
  if action=2 then delay(2);
  if action=1 then 
                     begin
                        выполняем что-то
                     end;
end;

ну и при клике на старт action=1 при клике на стоп action=3 и т.п.

MrDiG · #4 14.10.2010, 11:23

Цитата:

Сообщение от NumLock

TThread: Create, Suspend, Resume, Terminate

Код:

 {Определение класса TMyThread}
 type
   TMyThread = class(TThread)
   private
     { Private declarations }
   protected
     procedure DoWork;
     procedure Execute; override;
   end;

 implementation

 procedure TMyThread.Execute;
 begin
 Synchronize(DoWork);
 end;

 procedure TMyThread.DoWork;
 begin
 {Сюда, как я понимаю код своей процедуры?}
 end;

На кнопочки вешаем:

TMyThread.Execute; //запуск
TMyThread.Suspend; //пауза
TMyThread.Resume; //продолжить
TMyThread.Terminate; //остановить

Я всё правильно понял?

2 friz, спасибо. Буду проверять и более простой вариант.

NumLock · #5 14.10.2010, 11:46

Код:

 procedure TMyThread.Execute;
 begin
 DoWork;
 end;

MrDiG · #6 14.10.2010, 12:04

Цитата:

Сообщение от NumLock

Код:

 procedure TMyThread.Execute;
 begin
 DoWork;
 end;

Ну почему без Synchronize я кажется понимаю - это тупо гарантия, что к каждому объекту VCL одновременно имеет доступ только один поток. А т.к. поток пока один - то и думать не нужно.

Теперь ещё более нубский вопрос - по структуре программы. Дело в том, что ковыряюсь я с дельфи - где-то неделю и ещё много пробелов.

Цитата:

type
TMyThread = class(TThread)
private
{ Private declarations }
protected
procedure DoWork;
procedure Execute; override;
end;

Нужно размещать после:

unit
interface
uses

И перед:

type
TForm1 = class(TForm)
?

Насколько я знаю, type определяет новую категорию переменной или процесса. А чем этот блок type должен завершаться? implementation?
Каждый блок или все?

NumLock · #7 14.10.2010, 13:20

1. не совсем так про Synchronize. как раз наоборот: все потоки могут одновременно обращаться к VCL (в данном случае основной поток и TMyThread) и из-за этого и возникают пролемы. Synchronize для этого и нужен - вызывать метод в основном потоке VCL, что гарантирует безопасное обращение.
2. описание класса в секции interface, реализация в implementation:

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms;

type
  TMyThread = class(TThread)
  public
    constructor Create();
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyThread }

constructor TMyThread.Create;
begin
  inherited Create(False);
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  //
end;

end.

MrDiG · #8 14.10.2010, 15:57

Очень сильно извиняюсь. Пересмотрел кучу примеров, самые толковые из которых:
http://www.codingrus.ru/readarticle.php?article_id=1999
http://www.delphi.int.ru/articles/39/
http://www.codenet.ru/progr/delphi/stat/d_http.php

И всё-таки я жутко туплю. Попробую попунктно:

1). Уже создан проект. Начало листинга:

Код:

unit vk;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,   StdCtrls, ExtDlgs, ComCtrls, CheckLst, Math;

type
    TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Edit1: TEdit;
    Edit2: TEdit;
    Label3: TLabel;
    Label2: TLabel;
    Label1: TLabel;
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Button3: TButton;
    OpenDialog2: TOpenDialog;
    Edit3: TEdit;
    Button4: TButton;
    Label4: TLabel;
    CheckListBox1: TCheckListBox;
    Button5: TButton;
    Memo3: TMemo;
    Label5: TLabel;
    Button6: TButton;
    Label6: TLabel;
    StatusBar1: TStatusBar;
    ProgressBar1: TProgressBar;
    Button7: TButton;
    TabSheet4: TTabSheet;
    Edit4: TEdit;
    Button8: TButton;
    Memo4: TMemo;
    Label7: TLabel;
    ProgressBar2: TProgressBar;
    Label8: TLabel;
    Button9: TButton;
    Label9: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    private
    { Private declarations }
  public
    { Public declarations }
  procedure Delay (const Seconds: Real);
  procedure FakeCheck;

  end;

var
  Form1: TForm1;



implementation

{$R *.dfm}

type
TMyThread = class(TThread)
private
{ Private declarations }
protected
procedure FakeCheck;
procedure Execute; override;
end;

Тут FakeCheck эта та самая длительная процедура.
По ctrl+shift+c создалось следующее:

Код:

{ TMyThread }

procedure TMyThread.Execute;
begin
inherited;

end;

procedure TMyThread.FakeCheck;
begin

end;

Добавлю четыре кнопки:
btnExecute, btnSuspend, btnResume,btnTerminate

Как сделать чтобы:

Цитата:

procedure TForm1.btnStartClick(Sender: TObject);
begin
//Запускаем FakeCheck;
end;

procedure TForm1.btnSuspendClick(Sender: TObject);
begin
//FakeCheck; на паузу
end;

procedure TForm1.btnResumeClick(Sender: TObject);
begin
//FakeCheck; с паузы
end;

procedure TForm1.btnTerminateClick(Sender: TObject);
begin
//Останавливаем FakeCheck;
end;

NumLock · #9 14.10.2010, 17:20

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type

  TMyThread = class(TThread)
  private
    str: String;
  protected
    procedure Execute; override;
    procedure Updt;
  public
    constructor Create;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    FMyThread: TMyThread;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyThread }

constructor TMyThread.Create;
begin
  FreeOnTerminate:=True;
  inherited Create(False);
end;

procedure TMyThread.Execute;
begin
  str:='begin';
  // в Label1 записываем текст в синхронизированом вызове Updt
  Synchronize(Updt);
  // крутим цикл пока не послан сигнал Terminate
  while not Terminated do
  begin
    Sleep(100);
    str:=IntToStr(GetTickCount div 100);
    // в Label1 записываем текст в синхронизированом вызове Updt
    Synchronize(Updt);
  end;
  str:='end';
  // в Label1 записываем текст в синхронизированом вызове Updt
  Synchronize(Updt);
end;

procedure TMyThread.Updt;
begin
  // этот метод вызывается в основном потоке VLC 
  // в Label1 записываем текст
  Form1.Label1.Caption:=str;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  // создаем поток
  if not Assigned(FMyThread) then FMyThread:=TMyThread.Create;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  // приостанавливаем выполнение
  if Assigned(FMyThread) then FMyThread.Suspend;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  // возобновляем выполнение
  if Assigned(FMyThread) then FMyThread.Resume;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  // прерываем выполнение
  if Assigned(FMyThread) then FMyThread.Terminate;
end;

end.

http://data.cod.ru/71347

MrDiG · #10 14.10.2010, 17:25

Супер! Спасибо!

MrDiG · #11 14.10.2010, 20:00

Только два момента меня смущают...
Судя по этому
FreeOnTerminate:=True;

Когда нажата четвёртая кнопка - завершение процесса - идёт зачистка потока, и его можно запускать заново. Однако при попытке запустить снова - кидается ошибкой Неверный дескриптор (6); Отчего сие происходит? Вроде бы ресурсы освобождены...

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

NumLock · #12 14.10.2010, 20:45

1.

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type

  TMyThread = class(TThread)
  private
    str: String;
  protected
    procedure Execute; override;
    procedure Updt;
  public
    constructor Create;
    destructor Destroy; override;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    FMyThread: TMyThread;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TMyThread }

constructor TMyThread.Create;
begin
  FreeOnTerminate:=True;
  inherited Create(False);
end;

destructor TMyThread.Destroy;
begin
  Form1.FMyThread:=nil;
  inherited Destroy;
end;

procedure TMyThread.Execute;
begin
  str:='begin';
  // в Label1 записываем текст в синхронизированом вызове Updt
  Synchronize(Updt);
  // крутим цикл пока не послан сигнал Terminate
  while not Terminated do
  begin
    Sleep(100);
    str:=IntToStr(GetTickCount div 100);
    // в Label1 записываем текст в синхронизированом вызове Updt
    Synchronize(Updt);
  end;
  str:='end';
  // в Label1 записываем текст в синхронизированом вызове Updt
  Synchronize(Updt);
end;

procedure TMyThread.Updt;
begin
  // этот метод вызывается в основном потоке VLC 
  // в Label1 записываем текст
  Form1.Label1.Caption:=str;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  // создаем поток
  if not Assigned(FMyThread) then FMyThread:=TMyThread.Create;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  // приостанавливаем выполнение
  if Assigned(FMyThread) then FMyThread.Suspend;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  // возобновляем выполнение
  if Assigned(FMyThread) then FMyThread.Resume;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  // прерываем выполнение
  if Assigned(FMyThread) then FMyThread.Terminate;
end;

end.

2. грубо читать данные из TMemo (и вообще любого другого если пользователь во время работы не изменяет данные) можно и не в Synchronize, но писать лучше в Synchronize. тут проблема еще в отображении может быть. например windows отрисовывает progressbar, когда поток в нем меняет что-то, на экране может смотреться не красиво.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты