Проблемы с потоком - Общие вопросы Delphi - Страница 2

evg_m · 21.06.2011, 10:00

Цитата:

Скопируй все действия, которые ты выполняешь в потоке в созданную процедуру,

1. копроватть нужно только тот фрагмент что работает с формой иначе зачем тогда потоки.
т.е. все что касается progressbar и label.
2. В параметрах PostMessage надо передавать данные о состоянии дел.

за основу взят ваш первоначальный код

Код:

procedure TMyThread.Execute;
var p,m,ii:integer;
begin
p:=0;
for ii:=1 to 10 do
begin
if unit2.stat=0 then
 begin
   p:=p+1;
   postmessage(.WM_USER+1, p, unit2.stat); //   statysbusy.ProgressBar1.Position:= p;
     if i=0 then
       begin
//         statysbusy.label1.Caption:='Посылаем данные о подключении.';
         i:=1;
       end;
     if i=1 then
       begin
//         statysbusy.label1.Caption:='Посылаем данные о подключении..';
         i:=2;
       end;
     if i=2 then
       begin
//         statysbusy.label1.Caption:='Посылаем данные о подключении...';
         i:=0;
       end;
end
  else if unit2.stat=1 then
    begin
   postmessage(.WM_USER+1, p, unot2.stat); //   statysbusy.ProgressBar1.Position:= p;
     if i=0 then
       begin
  //       statysbusy.label1.Caption:='Информируем о выходе.';
         i:=1;
       end;
     if i=1 then
       begin
//        statysbusy.label1.Caption:='Информируем о выходе..';
         i:=2;
       end;
     if i=2 then
       begin
  //       statysbusy.label1.Caption:='Информируем о выходе...';
         i:=0;
       end;
  //удаление моего письма
     end
  else if unit7.stat=3 then
     begin
   p:=p+1;
   postmessage(.WM_USER+1, p, unit2.stat); //   statysbusy.ProgressBar1.Position:= p;
   statysbusy.ProgressBar1.Position:= p;
     if i=0 then
       begin
//         statysbusy.label1.Caption:='Формируем список.';
         i:=1;
       end;
     if i=1 then
       begin
//         statysbusy.label1.Caption:='Формируем список..';
         i:=2;
       end;
     if i=2 then
       begin
//         statysbusy.label1.Caption:='Формируем список...';
         i:=0;
       end;
end;
 
sleep(500);
end;
 

procedure Tstatysbusy.OnMyMess(var Mess: TMessage);
///  надо передавать данные о состоянии дел.
//   postmessage(.WM_USER+1, p, unit2.stat); 
// p это Wparam 
// unit2.stat это Lparam
// на основании параметром (данные о состоянии дел заполняем 
//  progressbar и label
begin
  case mess.Lparam of
  0: begin 
        statysbusy.label1.Caption:='Посылаем данные о подключении.';
        statysbusy.ProgressBar1.Position:= mess.wparam;        
      end;
  1: begin 
         statysbusy.label1.Caption:='Информируем о выходе.';
      end;
  2: begin
         statysbusy.label1.Caption:='Формируем список..';
         statysbusy.ProgressBar1.Position:= mess.wparam;        
     end;
  end;
end;

 
end;

spydark91 · 22.06.2011, 22:21

Код:

unit Unit1;

interface

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

type
  Tstatysbusy = class(TForm)
  ProgressBar1: TProgressBar;
  Label1: TLabel;
    Button1: TButton;
    Button2: TButton;

    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }
  end;
type
  TMyThread = class(TThread)


  protected
    procedure Execute; override;
    procedure OnMyMess(var Mess: TMessage);message WM_USER+1;

  end;

var
  statysbusy: Tstatysbusy;
  i,c:integer;
  MyThread: TMyThread;

implementation
uses unit2, Unit7;

{$R *.dfm}
procedure TMyThread.Execute;
var p,m,ii:integer;
begin
for ii:=1 to 8 do
begin
if unit2.stat=0 then
 begin
   p:=p+1;
   postmessage(.WM_USER+1, p, unit2.stat);
     if i=0 then
       begin
         //statysbusy.label1.Caption:='Ïîñûëàåì äàííûå î ïîäêëþ÷åíèè.';
         i:=1;
       end;
     if i=1 then
       begin
         //statysbusy.label1.Caption:='Ïîñûëàåì äàííûå î ïîäêëþ÷åíèè..';
         i:=2;
       end;
     if i=2 then
       begin
        // statysbusy.label1.Caption:='Ïîñûëàåì äàííûå î ïîäêëþ÷åíèè...';
         i:=0;
       end;
end
  else if unit2.stat=1 then
    begin
     p:=p+1;
     postmessage(.WM_USER+1, p, unit2.stat);
     if i=0 then
       begin
         //statysbusy.label1.Caption:='Èíôîðìèðóåì î âûõîäå.';
         i:=1;
       end;
     if i=1 then
       begin
       // statysbusy.label1.Caption:='Èíôîðìèðóåì î âûõîäå..';
         i:=2;
       end;
     if i=2 then
       begin
        // statysbusy.label1.Caption:='Èíôîðìèðóåì î âûõîäå...';
         i:=0;
       end;
  //óäàëåíèå ìîåãî ïèñüìà
     end
  else if unit7.stat=3 then
     begin
   p:=p+1;
   postmessage(.WM_USER+1, p, unit2.stat);
     if i=0 then
       begin
         //statysbusy.label1.Caption:='Ôîðìèðóåì ñïèñîê.';
         i:=1;
       end;
     if i=1 then
       begin
        // statysbusy.label1.Caption:='Ôîðìèðóåì ñïèñîê..';
         i:=2;
       end;
     if i=2 then
       begin
         //statysbusy.label1.Caption:='Ôîðìèðóåì ñïèñîê...';
         i:=0;
       end;

     sleep(250);
     end;

end;

end;

procedure Tstatysbusy.FormCreate(Sender: TObject);
begin
i:=0;
end;




procedure Tstatysbusy.Button1Click(Sender: TObject);
begin
mythread:=tmythread.Create(false);
end;

procedure Tstatysbusy.Button2Click(Sender: TObject);
begin
 mythread.Suspend;
end;

procedure Tstatysbusy.OnMyMess(var Mess: TMessage);
begin
  case mess.Lparam of
  0: begin 
        statysbusy.label1.Caption:='Ïîñûëàåì äàííûå î ïîäêëþ÷åíèè.';
        statysbusy.ProgressBar1.Position:= mess.wparam;        
      end;
  1: begin 
         statysbusy.label1.Caption:='Èíôîðìèðóåì î âûõîäå.';
      end;
  2: begin
         statysbusy.label1.Caption:='Ôîðìèðóåì ñïèñîê..';
         statysbusy.ProgressBar1.Position:= mess.wparam;        
     end;
  end;
end;
end.

ошибка [Error] Unit1.pas(52): Not enough actual parameters на строкеpostmessage(.WM_USER+1, p, unit2.stat);

spydark91 · 22.06.2011, 22:30

и что это за точка?раскажите пожалуйста,первый раз встречаю эту функцию

Aliens_wolfs · 22.06.2011, 22:31

Извиняюсь что влез в беседу.
В потоке нельзя на прямую обращаться к визуальным объектам будет ошибка.
Попробуй так может поможет этот код

Код:

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
 public
    procedure OnTimer(Sender: TObject);
  end;

  //Поток
TTimer = class(TThread)
//Событие
FOnTimer:TNotifyEvent;
protected
procedure Execute; override;
//Функция события
procedure DoTimer; virtual;
public
constructor Create; virtual;
destructor Destroy; override;
published
property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
end;

var
  Form1: TForm1;
Timers: TTimer; //Имя потока

implementation

{$R *.dfm}

constructor TTimer.Create;
begin
inherited Create(True);
FreeOnTerminate := True; //Для уничтожения потока когда он остановлен
resume; //запускаем поток
end;

destructor TTimer.Destroy;
begin
Terminate;
inherited;
end;

procedure TTimer.Execute;
begin
//Крутим поток
while not Terminated do
begin
//Вызываем функцию
Synchronize(DoTimer);
sleep(500);
end;
end;

procedure TTimer.DoTimer;
begin
//Вызываем событие
if Assigned(FOnTimer) then
FOnTimer(Self);
end;

//Событие
procedure TForm1.OnTimer(Sender: TObject);
var p,m: Integer;
begin
//Ваш код
if unit2.stat=0 then
 begin
   p:=p+1;
   ProgressBar1.Position:= p;
     if i=0 then
       begin
         label1.Caption:='Посылаем данные о подключении.';
         i:=1;
       end;
     if i=1 then
       begin
         label1.Caption:='Посылаем данные о подключении..';
         i:=2;
       end;
     if i=2 then
       begin
         label1.Caption:='Посылаем данные о подключении...';
         i:=0;
       end;
end
  else if unit2.stat=1 then
    begin
     if i=0 then
       begin
         label1.Caption:='Информируем о выходе.';
         i:=1;
       end;
     if i=1 then
       begin
         label1.Caption:='Информируем о выходе..';
         i:=2;
       end;
     if i=2 then
       begin
         label1.Caption:='Информируем о выходе...';
         i:=0;
       end;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
//Создаем и запускаем поток
Timers :=TTimer.Create;
Timers.OnTimer:=OnTimer; //перенаправить событие в TForm1
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//Останавливаем поток
Timers.Terminate;
end;

spydark91 · 22.06.2011, 22:47

Код:

unit Unit1;

interface

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

type
  Tstatysbusy = class(TForm)
  ProgressBar1: TProgressBar;
  Label1: TLabel;
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;

    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations } procedure OnTimer(Sender: TObject);
  end;
type
  TMyThread = class(TThread)



  protected



  end;
type
   //Ïîòîê
TTimer = class(TThread)
//Ñîáûòèå
FOnTimer:TNotifyEvent;
protected
procedure Execute; override;
//Ôóíêöèÿ ñîáûòèÿ
procedure DoTimer; virtual;
public
constructor Create; virtual;
destructor Destroy; override;
published
property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
end;

var
  statysbusy: Tstatysbusy;
  i,c:integer;
  MyThread: TMyThread;
  Timers: TTimer;

implementation
uses unit2, Unit7;

{$R *.dfm}
constructor TTimer.Create;
begin
inherited Create(True);
FreeOnTerminate := True; //Äëÿ óíè÷òîæåíèÿ ïîòîêà êîãäà îí îñòàíîâëåí
resume; //çàïóñêàåì ïîòîê
end;
procedure TTimer.Execute;
begin
//Êðóòèì ïîòîê
while not Terminated do
begin
//Âûçûâàåì ôóíêöèþ
DoTimer;
sleep(5); //ïðåðûâàíèå èíà÷å áóäåò ãðóçèòü ñèñòåìó
end;
end;
procedure TTimer.DoTimer;
begin
//Âûçûâàåì ñîáûòèå
if Assigned(FOnTimer) then
FOnTimer(Self);
end;
procedure Tstatysbusy.OnTimer(Sender: TObject);
var p,m,ii:integer;
begin
//Âàø êîä
for ii:=1 to 10 do
begin
if unit2.stat=0 then
 begin
   p:=p+1;
   ProgressBar1.Position:= p;
     if i=0 then
       begin
         label1.Caption:='Ïîñûëàåì äàííûå î ïîäêëþ÷åíèè.';
         i:=1;
       end;
     if i=1 then
       begin
         label1.Caption:='Ïîñûëàåì äàííûå î ïîäêëþ÷åíèè..';
         i:=2;
       end;
     if i=2 then
       begin
         label1.Caption:='Ïîñûëàåì äàííûå î ïîäêëþ÷åíèè...';
         i:=0;
       end;
end
  else if unit2.stat=1 then
    begin
     if i=0 then
       begin
         label1.Caption:='Èíôîðìèðóåì î âûõîäå.';
         i:=1;
       end;
     if i=1 then
       begin
         label1.Caption:='Èíôîðìèðóåì î âûõîäå..';
         i:=2;
       end;
     if i=2 then
       begin
         label1.Caption:='Èíôîðìèðóåì î âûõîäå...';
         i:=0;
       end;
    end;
    sleep(500);
end;


end;

procedure Tstatysbusy.FormCreate(Sender: TObject);
begin
i:=0;
end;




procedure Tstatysbusy.Button1Click(Sender: TObject);
begin
Timers :=TTimer.Create;
Timers.OnTimer:=OnTimer;
end;

procedure Tstatysbusy.Button2Click(Sender: TObject);
begin
Timers.Terminate;
end;

end.

ошибка destructor Destroy; override; [Error] Unit1.pas(47): Unsatisfied forward or external declaration: 'TTimer.Destroy'

spydark91 · 22.06.2011, 22:50

а если просто наделать процедур и использовать Synchronize? как тут

Код HTML:

unit Unit10;
 
interface
 
uses
  Classes,Windows;
 
type
  MyBut = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;
 
implementation
uses unit8,unit2;
{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,
 
      Synchronize(UpdateCaption);
 
  and UpdateCaption could look like,
 
    procedure MyBut.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }
 
{ MyBut }
procedure b6;
begin
form2.SpeedButton6.Click;
end;
 
procedure b5;
begin
form2.SpeedButton5.Click;
end;
 
 
procedure MyBut.Execute;
var esc,q,w:boolean;
begin
repeat
if getasynckeystate($1b) <> 0 then esc:=true;
if getasynckeystate($51)<>0 then q:=true;
if getasynckeystate($57)<>0 then w:=true;
if settings.CheckBox7.Checked=true then
  begin
    if (esc=true) and (w=true) then
      Synchronize(b6);
  end;
if (esc=true) and(q=true) then
  Synchronize(b5);
sleep(100);
 
until true;
end;
 
end.

кстати тоже не работает,но если поставить это на таймер,то все ок

Пепел Феникса · 22.06.2011, 22:53

там должна быть не процедура а метод.
MyBut.UpdateCaption;

Aliens_wolfs · 22.06.2011, 22:53

Кое что подправил посмотри мой код еще раз
в procedure TTimer.DoTimer; и в procedure TTimer.Execute;

Цитата:

ошибка destructor Destroy; override; [Error] Unit1.pas(47): Unsatisfied forward or external declaration: 'TTimer.Destroy'

События нет в вашем коде а в моем есть его нужно добавить в проект

Код:

destructor TTimer.Destroy;
begin
Terminate;
inherited;
end;

spydark91 · 22.06.2011, 23:01

так чтоли?
основная форма

Код:

public
         procedure Busy(Busy: boolean);
         procedure b5;
         procedure b6;


  end;

var
  Form2: TForm2;
  c,tim:boolean;
  Preobr:TStringStream;
  s,nick,ip:string;
  stat:integer;

implementation
uses unit1,unit3,unit4,unit5, Unit7, Unit8, Unit9,unit10;

 
procedure TForm2.b6;
begin
form2.SpeedButton6.Click;
end;

procedure TForm2.b5;
begin
form2.SpeedButton5.Click;
end;

поток--

Код:

unit Unit10;

interface

uses
  Classes,Windows;

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

implementation
uses unit8,unit2;
{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure MyBut.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ MyBut }



procedure MyBut.Execute;
var esc,q,w:boolean;
begin
repeat
if getasynckeystate($1b) <> 0 then esc:=true;
if getasynckeystate($51)<>0 then q:=true;
if getasynckeystate($57)<>0 then w:=true;
if settings.CheckBox7.Checked=true then
  begin
    if (esc=true) and (w=true) then
      Synchronize(form2.b6);
  end;
if (esc=true) and(q=true) then
  Synchronize(form2.b5);
sleep(100);

until true;
end;

end.

spydark91 · 22.06.2011, 23:06

огромное спасибо,бар катается
но label вообще пропало
можешь объяснить код,а то я не очень понимаю его(

22.06.2011, 22:53	#17
Пепел Феникса Старожил Регистрация: 28.01.2009 Сообщений: 21,000	там должна быть не процедура а метод. MyBut.UpdateCaption; Хорошо поставленный вопрос это уже половина ответа. \| Каков вопрос, таков ответ. Программа делает то что написал программист, а не то что он хотел. Функции/утилиты ждут в параметрах то что им надо, а не то что вы хотите.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Работа с потоком	Yur@	Общие вопросы Delphi	3	02.06.2011 12:46
Проблема с потоком	timur oO	Помощь студентам	2	14.04.2010 17:02
Delphi Проблема с потоком	TreadProblem	Помощь студентам	1	07.03.2010 17:59
Проблема с потоком	Araver	Общие вопросы Delphi	4	16.10.2007 04:30

22.06.2011, 22:30	#13
spydark91 Форумчанин Регистрация: 01.06.2011 Сообщений: 215	и что это за точка?раскажите пожалуйста,первый раз встречаю эту функцию

22.06.2011, 23:06	#20
spydark91 Форумчанин Регистрация: 01.06.2011 Сообщений: 215	огромное спасибо,бар катается но label вообще пропало можешь объяснить код,а то я не очень понимаю его(