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

Вниз

Прервать цикл   Найти похожие ветки 

← →
veb   (2006-01-25 23:03) [0]

Здравствуйте! Помогите остановить перебор по событию: например нажатия кнопки.

Смысл такой:
  в основной форме идет длинный цикл обработки файлов, на дочерней появляется прогрессбар, необходимо по нажатию на дочерней форме кнопки отмена прервать цикл на главной форме.

Как правильно это сделать?

---

← →
Джо ©   (2006-01-25 23:13) [1]

цикл прерывается оператором break.

---

← →
BOOLEAN   (2006-01-25 23:16) [2]

Вот пример:

VAR STOP:BOOLEAN;

procedure TForm1.Button2Click(Sender: TObject);
VAR I,K:INTEGER;
begin
 K:=0;
 FOR I:=0 TO 100000000 DO
 BEGIN
  Application.ProcessMessages;
  IF STOP THEN BREAK;
  K:=K+1;
 END;
 CAPTION:=IntToStr(k);
 STOP:=FALSE;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 STOP:=TRUE;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 STOP:=FALSE;
end;


---

← →
veb   (2006-01-25 23:28) [3]

как только вставляю  строку
 Application.ProcessMessages;

в свой цикл получаю "Access Violation"

---

← →
Gero ©   (2006-01-25 23:31) [4]

> veb   (25.01.06 23:28)

Показывай.

---

← →
veb   (2006-01-25 23:36) [5]

procedure TfmDisks.acScanDiskExecute(Sender: TObject);
Var
 fmDialog     : TfmChooseDir;
 srAvi, srMpg : TSearchRec;
 FileAttrs    : Integer;
 InfoAvi      : TInfoAvi;
begin
 grDisksExit( Sender);
 fmDialog := TfmChooseDir.Create( Self);
 fmDialog.ShowModal;
 if fmDialog.ModalResult = mrOK then begin
   FileAttrs := SysUtils.faAnyFile;
   if FindFirst( fmDialog.lbDirectory.Directory + "\*.avi", FileAttrs, srAvi) = 0 then begin
     fmProgressBar.Visible := true;
     repeat
       Application.ProcessMessages;
       fmProgressBar.ProgressBar.Position := fmProgressBar.ProgressBar.Position + 1;
       InfoAvi := GetInfoAvi( fmDialog.lbDirectory.Directory + "\" + srAvi.Name); // ERROR
       if not dmSource.FindValue("Films", "FileName", InfoAvi.FileName, "AND IdDisk = " + dmSource.tbDisks.FieldByName("Id").AsString) then begin
         dmSource.tbMovies.Insert;
         PutInfo( InfoAvi, dmSource.tbMovies);
         dmSource.tbMovies.Post;
       end;

      if not fmProgressBar.Visible then Break;
     until FindNext(srAvi) <> 0;
     FindClose(srAvi);
     fmProgressBar.Visible := false;
   end;
 end;
end;

---

← →
veb   (2006-01-25 23:38) [6]

без нее работает отлично!
:(

---

← →
ANB ©   (2006-01-26 00:01) [7]

> veb   (25.01.06 23:38) [6]

Ты еще здесь ?
Где то в коде что то потерял.
Сначала опробуй в этой же форме пример [2].
Потом ищи косяк в своей процедуре.
ЗЫ. Обычно вот это :

> Application.ProcessMessages;
>        fmProgressBar.ProgressBar.Position := fmProgressBar.
> ProgressBar.Position + 1;

я ставлю в конец цикла. Перед

> if not fmProgressBar.Visible then Break;

---

← →
veb   (2006-01-26 00:59) [8]

спасибо всем!
заработало когда поменял цикл repeat на цикл for!
может и мои бока, лень разбираться.

Все же кажется неправильным, использовать ProcessMessages
по-моему это ОЧЕНЬ значительно замедляет работу цикла!

---

← →
ANB ©   (2006-01-26 01:21) [9]

> Все же кажется неправильным, использовать ProcessMessages
> по-моему это ОЧЕНЬ значительно замедляет работу цикла!

Либо скорость, либо живая форма. ProcessMessages можно, кстати, не каждый раз вызывать, если итерации очень быстрые.

---

← →
Fay ©   (2006-01-26 01:31) [10]

Не нужно вАщЕ запускать этот цикл в основном потоке.

---

← →
ANB ©   (2006-01-26 01:34) [11]

> Fay ©   (26.01.06 01:31) [10]

Использование дополнительного потока именно в этом случае слабо оправдано. Имхо.

---

← →
Плохиш ©   (2006-01-26 01:48) [12]

>       if not fmProgressBar.Visible then Break;
>      until FindNext(srAvi) <> 0;

Вот это я бы заменил на

      Application.ProcessMessages;
    until (FindNext(srAvi) <> 0) or (not fmProgressBar.Visible);

Убрав соответственно ProcessMessages из начала цикла.

> veb   (25.01.06 23:28) [3]
> как только вставляю  строку
>  Application.ProcessMessages;
> в свой цикл получаю "Access Violation"

Это не из-за этого, просто в обработчике кнопки "отменить" или как она там у тебя называется, ты обращаешься к несуществующему объекту. Даже догадываюсь к которому :-) Приводи код, а ещё лучше сам пройдись отладчиком.

---

← →
Fay ©   (2006-01-26 01:58) [13]

2 ANB ©   (26.01.06 1:34) [11]

А для чего же тогда нужны потоки?!

---

← →
Германн ©   (2006-01-26 02:12) [14]

> Fay ©   (26.01.06 01:58) [13]
>
> 2 ANB ©   (26.01.06 1:34) [11]
>
> А для чего же тогда нужны потоки?!

Имхо, в основном для выполнения длительных операций не связанных или слабо связанных с "визуальным отображением состояния" сих операций в окне основного потока. Ещё раз имхо.

---

← →
Fay ©   (2006-01-26 02:48) [15]

Я тут накидал... По разным формам раскидывать не стал - лениво 8)
unit Unit2;

interface

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

type
 TForm1 = class(TForm)
   ProgressBar1 : TProgressBar;
   Button1 : TButton;
   Button2 : TButton;
   procedure Button1Click(Sender : TObject);
   procedure Button2Click(Sender : TObject);
 private
   FEvent : DWORD;
 public
   procedure DefaultHandler(var Message); override;
   constructor Create(AOwner : TComponent); override;
   destructor Destroy; override;
 end;

var
 Form1 : TForm1;

implementation

{$R *.dfm}

type
 TLoopThread = class(TThread)
 private
   FWnd, FEvent : HWND;
   FStartPath : string;
   function _Basta : Boolean;
 public
   procedure Execute; override;
   constructor Create(AWnd, AEvent : DWORD; AStartPath : string); reintroduce;
 end;

var
 WM_ANYMSG : DWORD;

{ TForm1 }

constructor TForm1.Create(AOwner : TComponent);
begin
 inherited;
 Button1.Caption := "Start";
 Button2.Caption := "Stop";
 FEvent := CreateEvent(nil, True, False, nil);
end;

destructor TForm1.Destroy;
begin
 CloseHandle(FEvent);
 inherited;
end;

procedure TForm1.DefaultHandler(var Message);
begin
 with TMessage(Message) do
   if Msg = WM_ANYMSG then
     begin
       with ProgressBar1 do
         if Position >= ProgressBar1.Max then
           Position := 0
         else
           StepBy(1);
       Caption := PChar(lparam);
     end
   else
     inherited;
end;

{ TLoopThread }

constructor TLoopThread.Create(AWnd, AEvent : DWORD; AStartPath : string);
begin
 inherited Create(True);
 Priority := tpIdle;// Если очень хочется запустить несколько потоков, лучше так
 FreeOnTerminate := True;
 FStartPath := AStartPath;
 FWnd := AWnd;
 FEvent := AEvent;
end;

// {$DEFINE DUMMY_LOOP}

procedure TLoopThread.Execute;
{$IFNDEF DUMMY_LOOP}
 procedure _Internal(const cPath : string);
 var
   fh : THandle;
   fd : _WIN32_FIND_DATAA;
   s : string;
 begin
   if _Basta then Exit;
   fh := FindFirstFile(PChar(cPath + "*"), fd);
   if fh = INVALID_HANDLE_VALUE then
     Exit;
   repeat
     if _Basta then Exit;
     s := fd.cFileName;
     if (fd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
       SendMessage(FWnd, WM_ANYMSG, 0, Integer(PChar(cPath + s)))
     else
       begin
         if (s <> ".") and (s <> "..") then
           _Internal(cPath + s + "\");
       end;
   until not FindNextFile(fh, fd);
 end;
begin
 _Internal(FStartPath);
{$ELSE}
var
 i : Integer;
begin
 for i := 0 to 1000000 do
   if _Basta then
     Exit
   else
     SendMessage(FWnd, WM_ANYMSG, 0, Integer(PChar(IntToStr(i))));
{$ENDIF}
end;

procedure TForm1.Button1Click(Sender : TObject);
begin
 ResetEvent(FEvent);
 with TLoopThread.Create(Handle, FEvent, "c:\") do
   Resume;
end;

procedure TForm1.Button2Click(Sender : TObject);
begin
 SetEvent(FEvent);
end;

function TLoopThread._Basta : Boolean;
begin
 Result := WaitForSingleObject(FEvent, 0) <> WAIT_TIMEOUT
end;

initialization
 WM_ANYMSG := RegisterWindowMessage("{59370BC1-E425-40D2-A37D-6BC41F8C0F05");

end.


---

← →
veb   (2006-01-26 14:06) [16]

> Либо скорость, либо живая форма. ProcessMessages можно,
> кстати, не каждый раз вызывать, если итерации очень быстрые.
>


Но ведь живая форма и не нужна! Нужен только обработчик кнопки "отменить"! Нажав на которую, будет остановлен цикл.


> Это не из-за этого, просто в обработчике кнопки "отменить"
> или как она там у тебя называется, ты обращаешься к несуществующему
> объекту. Даже догадываюсь к которому :-) Приводи код, а
> ещё лучше сам пройдись отладчиком.

В обработчике кнопки "отменить" стоит оператор Close. Форма не динамическая, поэтому по оператору Close из памяти не удаляется, а просто становится не видимой.

---

← →
Плохиш ©   (2006-01-26 15:15) [17]

> В обработчике кнопки "отменить" стоит оператор Close. Форма
> не динамическая, поэтому по оператору Close из памяти не
> удаляется, а просто становится не видимой.

Никакой связи между этими фразами нет.

Что стоит в OnClose?

---

← →
veb   (2006-01-26 17:25) [18]

В OnClose ничего не стоит, потому как не обрабатывается событие.

Интересно, почему нет связи между фразами.

---

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

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

Наверх

Память: 0.5 MB
Время: 0.039 c