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

Вниз

Потоки.   Найти похожие ветки 

← →
дед Маздай   (2008-11-12 22:57) [0]

Это моя первая, так сказать, проба пера. Посмотрите пожалуйста код.

unit Unit1;
...
type
 TForm1 = class(TForm)
   btn_StartThread1: TRzButton;
   btn_StartThread2: TRzButton;
   btn_StopThread1: TRzButton;
   btn_StopThread2: TRzButton;
   btn_PauseThread1: TRzButton;
   btn_PauseThread2: TRzButton;
   ProgressBar1: TProgressBar;
   ProgressBar2: TProgressBar;
   Label1: TLabel;
   Label2: TLabel;
...
var
 Form1: TForm1;
 Thread1, Thread2: TMyThread;

const
 MaxProgress = 1000;

implementation

procedure TForm1.btn_StartThread1Click(Sender: TObject);
begin
 btn_StartThread1.Enabled := False;
 Thread1 := TMyThread.Create(Label1, ProgressBar1, True);
 ProgressBar1.Position := 0;
 ProgressBar1.Max := MaxProgress;
 Thread1.Resume;
end;

procedure TForm1.btn_PauseThread1Click(Sender: TObject);
begin
 if Thread1.Suspended then begin
   Thread1.Resume;
   btn_PauseThread1.Caption := "Pause";
 end
 else begin
   Thread1.Suspend;
   btn_PauseThread1.Caption := "Resume";
 end;
end;

procedure TForm1.btn_StopThread1Click(Sender: TObject);
begin
 Thread1.Terminate;
 btn_StartThread1.Enabled := True;
end;

procedure TForm1.btn_StartThread2Click(Sender: TObject);
begin
 Thread2 := TMyThread.Create(Label2, ProgressBar2, True);
 btn_StartThread2.Enabled := False;
 ProgressBar2.Position := 0;
 ProgressBar2.Max := MaxProgress;
 Thread2.Resume;
end;

procedure TForm1.btn_PauseThread2Click(Sender: TObject);
begin
 if Thread2.Suspended then begin
   Thread2.Resume;
   btn_PauseThread2.Caption := "Pause";
 end
 else begin
   Thread2.Suspend;
   btn_PauseThread2.Caption := "Resume";
 end;
end;

procedure TForm1.btn_StopThread2Click(Sender: TObject);
begin
 Thread2.Terminate;
 btn_StartThread2.Enabled := True;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 if Thread1 <> nil then begin
   Thread1.Terminate;
 end;
 if Thread2 <> nil then begin
   Thread2.Terminate;
 end;
end;

------------
unit Unit2;
...
type
 TData = record
   dLabel: TLabel;
   dProgress: TProgressBar;
 end;

 TMyThread = class(TThread)
 private
   FData: TData;
   FLabelCaption: string;
   FProgresValue: Integer;
   procedure UpdateProgress;
   { Private declarations }
 protected
   procedure Execute; override;
 public
   constructor Create(Lab: TLabel; Progr: TProgressBar; CreateSuspended: Boolean);
 end;

implementation

uses
 Unit1;

constructor TMyThread.Create(Lab: TLabel; Progr: TProgressBar; CreateSuspended: Boolean);
begin
 inherited Create(CreateSuspended);
 FData.dLabel := Lab;
 FData.dProgress := Progr;
end;

procedure TMyThread.Execute;
var
 I: Integer;
begin
 FreeOnTerminate := True;
 for I := 0 to MaxProgress do begin
   sleep(10);
   FLabelCaption := "Значение: " + IntToStr(i);
   FProgresValue := i;
   Synchronize(UpdateProgress);
   if Terminated then
     Break;
 end;
end;

procedure TMyThread.UpdateProgress;
begin
 FData.dLabel.Caption := FLabelCaption;
 FData.dProgress.Position := FProgresValue;
end;


Всё ли правильно? Меня смущает один момент. Если поток поставлен на паузу ии происходит закрытие формы всё ли правильно закрывается?
Просто EurekaLog (http://www.eurekalog.com/) показывает "Memory Leak: Total size=102 - Count=2." если на паузе один поток и "Memory Leak: Total size=204 - Count=4.", если два. А если оба остановлены (кнопками btn_StopThread1 и btn_StopThread2 соответственно), то всё нормально.

---

← →
Loginov Dmitry ©   (2008-11-12 23:25) [1]

> показывает "Memory Leak: Total size=102 - Count=2." если
> на паузе один поток и "Memory Leak: Total size=204 - Count=4.",
> если два. А если оба остановлены (кнопками btn_StopThread1
> и btn_StopThread2 соответственно), то всё нормально.


А что собственно ожидалось? Потоки были созданы, затем их остановили!!! Поток не ме может завершиться в остановленном состоянии. Либо его завершать с помощью TThread.Free() (но перед этим следует сбросить FreeOnTerminate), либо выполнить TThread.Terminate, затем TThread.Resume, затем дождаться завершения его работы.

---

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

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

Наверх

Память: 0.46 MB
Время: 0.048 c