Программирование потоков

← →
avch (2003-09-12 09:59) [0]

Привет всем...
Не могу понять почему возникает ошибка доступа к памяти
Вот рабочий проект(раьотает без ошибки), но если кнопку "Стоп"
переместить с главной формы на ту где ProgressBar, то возникает ошибка доступа, причем код остается совершенно такимже...
Помогите разобраться, плиз....

← →
avch (2003-09-12 10:02) [1]

Вот код:
program thread;

uses
Forms,
MainModule in "MainModule.pas" {MainForm},
ProgressModule in "ProgressModule.pas" {ProgressForm};

{$R *.RES}

begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
//--------------------------------------
unit MainModule;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ProgressModule, Buttons, SyncObjs, abfControls;

const
FormCount = 1500;

type

TCreateThread = class(TThread)
private
I: Integer;
public
ProgressForm: TProgressForm;
constructor Create;
destructor Destroy; override;
procedure Execute; override;
procedure DoProgress;
procedure OnThreadTerminate(Sender: TObject);
end;

TDestroyThread = class(TThread)
private
I: Integer;
public
ProgressForm: TProgressForm;
constructor Create;
destructor Destroy; override;
procedure Execute; override;
procedure DoProgress;
procedure OnThreadTerminate(Sender: TObject);
end;

TMainForm = class(TForm)
CreateBtn: TButton;
DestroyBtn: TButton;
SpeedButton1: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure CreateBtnClick(Sender: TObject);
procedure DestroyBtnClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
MainForm: TMainForm;
RealyCreated: Integer;
FormsArray: array[0..FormCount - 1] of TForm;
aCreateThread: TCreateThread;
aDestroyThread: TDestroyThread;

implementation

{$R *.DFM}

destructor TCreateThread.Destroy;
begin
if Assigned(ProgressForm) then
FreeAndNil(ProgressForm);
inherited Destroy;
end;

destructor TDestroyThread.Destroy;
begin
if Assigned(ProgressForm) then
FreeAndNil(ProgressForm);
inherited Destroy;
end;

constructor TCreateThread.Create;
begin
// FreeOnTerminate := True;
ProgressForm := TProgressForm.Create(Application);
ProgressForm.Show;
OnTerminate := OnThreadTerminate;
inherited Create(False);
end;

constructor TDestroyThread.Create;
begin
FreeOnTerminate := True;
ProgressForm := TProgressForm.Create(Application);
ProgressForm.Show;
OnTerminate := OnThreadTerminate;
inherited Create(False);
end;

procedure TCreateThread.OnThreadTerminate;
begin
FreeAndNil(ProgressForm);
end;

procedure TDestroyThread.OnThreadTerminate;
begin
FreeAndNil(ProgressForm);
end;

procedure TCreateThread.Execute;
begin
i := 0;
RealyCreated := 0;
while (not Terminated) and (i < FormCount) do
begin
Synchronize(Application.ProcessMessages);
Synchronize(DoProgress);
end;
end;

procedure TDestroyThread.Execute;
begin
I := RealyCreated - 1;
while I >= 0 do
begin
Synchronize(DoProgress);
end;
end;

procedure TCreateThread.DoProgress;
begin
FormsArray[I] := TForm.Create(nil);
FormsArray[I].Top := 10;
FormsArray[I].Left := 10;
FormsArray[I].Width := 100;
FormsArray[I].Height := 100;
FormsArray[I].Caption := IntToStr(I);
FormsArray[I].Show;
if Assigned(ProgressForm) then
begin
inc(i);
RealyCreated := I;
ProgressForm.Progress.Position := I;
ProgressForm.Repaint;
end;
end;

procedure TDestroyThread.DoProgress;
begin
Application.ProcessMessages;
FormsArray[I].Free;
Dec(I);
if Assigned(ProgressForm) then
begin
ProgressForm.Progress.Position := I;
ProgressForm.Repaint;
end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
CreateBtn.Caption := Format("Создать %u форм.", [FormCount]);
DestroyBtn.Caption := Format("Удалить %u форм.", [FormCount]);
SetThreadPriority(GetCurrentProcess, HIGH_PRIORITY_CLASS);
end;

procedure TMainForm.CreateBtnClick(Sender: TObject);
begin
aCreateThread := TCreateThread.Create;
end;

procedure TMainForm.DestroyBtnClick(Sender: TObject);
begin
aDestroyThread := TDestroyThread.Create;
end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
if Assigned(aCreateThread) then
begin
aCreateThread.Suspend;
if MessageDlg("Вы уверены?", mtConfirmation, [mbYes, mbNo], 0) = mrYes
then
begin
aCreateThread.Free;
end
else
aCreateThread.Resume;
end;
end;

end.
//------------------------------
unit ProgressModule;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Buttons, ExtCtrls, ImgList, ToolWin, abfControls;

type
TProgressForm = class(TForm)
Progress: TProgressBar;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const
ba: array[boolean] of byte = (0, 1);

implementation

uses MainModule;

{$R *.DFM}

procedure TProgressForm.FormCreate(Sender: TObject);
begin
Progress.Min := 0;
Progress.Max := FormCount;
end;

end.

← →
Nikolay M. (2003-09-12 10:03) [2]

В орешник? :)
Скоро там от ошибок в 17 строке деваться будет некуда :)

← →
Nikolay M. (2003-09-12 10:05) [3]

Sorry, после приведения кода мой сарказм неуместен :(

← →
panov (2003-09-12 10:35) [4]

А кнопка "Стоп" - это которая?

← →
Владислав (2003-09-12 10:52) [5]

Ну во-первых, на кой нужен в потоке Application.ProgressMessages?
Во-вторых, я бы тебе посоветовал не обращаться из потока к формам через переменные. Передавай в поток Handle окна прогресса, а из потока отправляй сообщения ему (PostMessage, например). Избавишься от лишних хлопот.
А при переносе кнопки в форму прогресса ошибка, скорее всего, происходит из-за того, что ты в обработчике кликанья по кнопке, убиваешь эту форму. Тут не Free надо вызывать, а Release.

← →
avch (2003-09-12 11:54) [6]

Application.ProgressMessages нужен для того чтоб приложение реагировало на события во время выполнения Execute потока...
Зачем сообщения...мне надо чтоб юзер кнопку нажал и поток обрубился...да и с прогресом у меня нормально работает..

← →
avch (2003-09-12 11:57) [7]

А вот Release действительно помог...сэнкс, ща почитаю чем Release от Free отличается...

← →
Verg (2003-09-12 12:06) [8]

> while (not Terminated) and (i < FormCount) do
> begin
> Synchronize(Application.ProcessMessages);
> Synchronize(DoProgress);
> end;

Тяжелый случай....

А зачем вообще потоки, если они все равно ничего не делают, а всю свою работу "поручают" делать одному - главному?

Всем:

Где в сети можно откопать книгу Дж. Рихтера "Windows для профессиоанлов"?
Имеется ввиду ее первое издание (именно первое, где-то годов 94-5 х, если не ошибаюсь).
Ну люди не въезжают в суть потоков!
А на страницах форума это все все равно объяснить невозможно - придется просто самому написать аналоги глав упомянутой книги....

← →
Владислав (2003-09-12 12:53) [9]

> avch (12.09.03 11:54) [6]

Ты понимаешь, как работает Synchronize?

PS.: С таким же успехом, ты можешь выполнять эту работу в основном потоке.

← →
Владислав (2003-09-12 12:54) [10]

> avch (12.09.03 11:57) [7]

Про потоки не забудь прочитать :)

Программирование потоков Найти похожие ветки