Многопоточность. Ошибка продолжения (возобновления) потока.

[RobSys]

Здравствуйте.
Знакомплюсь с многопоточным программированием в Delphi.
Первая лабораторная ознакомительного рода: создание потоков средствами API.

Кнопки, реализующие методы создание поточного вывода (Создание потока) и вывода в общем потоке работают (Без потока). А после нажатия по кнопке приостановки потока (приостановить) приложение перестает отвечать на запросы.

Прошу, пожалуйста, указать на то, что реализовано мною не верно.
Delphi 7, Windows 7

unit u1;

interface

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

type
  TForm1 = class(TForm)
    bCreate: TButton;
    bSuspend: TButton;
    bResume: TButton;
    bSimple: TButton;
    procedure bCreateClick(Sender: TObject);
    procedure bSuspendClick(Sender: TObject);
    procedure bResumeClick(Sender: TObject);
    procedure bSimpleClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

var
  hThread: Thandle;  //Дескриптор потока
  ThreadID: DWord;   //Идентификатор потока

{$R *.dfm}

//Процедура, использующаяся внутри потока
procedure Func;
var
  i: integer;
  dc: hDc;  //Дескриптор формы
  s: string;
begin
  dc:=GetDc(Form1.Handle);  //Получение дескриптора формы
  for i:=0 to 1000000 do
      begin
        s:=IntToStr(i);  //Вывод числа, используя функцию API
        TextOut(dc,10,10,pchar(s),length(s));
      end;
  ReleaseDC(Form1.Handle,dc);  //Освобождение дескриптора
end;

//Вызов процедуры Func в составе потока.
//Для этого создается поток и передается в него адрес процедуры
procedure TForm1.bCreateClick(Sender: TObject);
begin
  hThread:=CreateThread(Nil,0,@Func,Nil,0,ThreadID);
  if hThread=0 then
      ShowMessage('No Thread');
end;

//Приостановка потока
procedure TForm1.bSuspendClick(Sender: TObject);
begin
  SuspendThread(hThread);
end;

//Продолжение потока
procedure TForm1.bResumeClick(Sender: TObject);
begin
  ResumeThread(hThread);
end;

//Вызов процедуры обычным способом
procedure TForm1.bSimpleClick(Sender: TObject);
begin
  Func;
end;

end.

[Человек_Борща]

Это правится при помощи Application.ProcessMessages
добавь это перед приостановкой потока. т.е. так:

//Приостановка потока
procedure TForm1.bSuspendClick(Sender: TObject);
begin
  Application.ProcessMessages;
  SuspendThread(hThread);
end;

и все будет работать!

[Пепел Феникса]

procedure Func;

а теперь почитайте про CreateThread и найдите сами ошибку в том какого типа должна быть ThreadFunc(потоковая функция)

[RobSys]

Человек_Борща, к сожалению, добавление данного метода не изменило ситуации. Немного почитал о нем: как я понял, он используется для зазграничения действий в одном потоке: приостанавливает одно и выполняет другое. У меня же вывод на форму и так происходит в отдельном потоке.

[RobSys]

Пепел Феникса, так понимаю, что типа longint, тк один из параметров CreateThread - есть адресное значение процедуры Func. Я правильно понял?

[Пепел Феникса]

нет.

тк один из параметров CreateThread - есть адресное значение процедуры Func.

причем тут вообще адресное значение?(это тип pointer если не вкурсе)
я про прототип функции потока, а то потом будет веселые ошибки стека ловить.
а функция должна иметь вид

DWORD WINAPI ThreadFunc( LPVOID );

это на плюсах.
на делфи

function ThreadFunc(data:pointer):DWORD;stdcall;

А после нажатия по кнопке приостановки потока (приостановить) приложение перестает отвечать на запросы.

и не удивительно, форма то блокирована остается.
поток не должен перерисовывать сам форму.
правильно делать так чтоб поток слал форме сообщение(и форма уже в ответ на это сообщение перерисовывалась так как надо)

[RobSys]

Пепел Феникса, так понял, что TextOut не должен выполняться в самой потоковой функции. Но реализация этого не понятна...

[Пепел Феникса]

unit u1;

interface

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

type
  TForm1 = class(TForm)
    bCreate: TButton;
    bSuspend: TButton;
    bResume: TButton;
    bSimple: TButton;
    Label1:TLabel;//на форму надо кинуть Label
    procedure bCreateClick(Sender: TObject);
    procedure bSuspendClick(Sender: TObject);
    procedure bResumeClick(Sender: TObject);
    procedure bSimpleClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MyMess(Mes:TMessage);message WM_USER;//вроде так, я чего то подзабыл как верно обрабатывать сообщения
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

var
  hThread: Thandle;  //Дескриптор потока
  ThreadID: DWord;   //Идентификатор потока

{$R *.dfm}

//Процедура, использующаяся внутри потока
function Func(data:pointer):DWORD;stdcall;
var
  i: integer;
begin
  for i:=0 to 1000000 do
      begin
        SendMessage(Form1.Handle,WM_USER,i,0);
      end;
end;

procedure TForm1.MyMess;
begin
 Label1.Caption:=Mes.wParam;
end;

//Вызов процедуры Func в составе потока.
//Для этого создается поток и передается в него адрес процедуры
procedure TForm1.bCreateClick(Sender: TObject);
begin
  hThread:=CreateThread(Nil,0,@Func,Nil,0,ThreadID);
  if hThread=0 then
      ShowMessage('No Thread');
end;

//Приостановка потока
procedure TForm1.bSuspendClick(Sender: TObject);
begin
  SuspendThread(hThread);
end;

//Продолжение потока
procedure TForm1.bResumeClick(Sender: TObject);
begin
  ResumeThread(hThread);
end;

//Вызов процедуры обычным способом
procedure TForm1.bSimpleClick(Sender: TObject);
begin
  Func;
end;

end.

например так(вроде должно скомпилится, не проверял, я сейчас сонный)

[RobSys]

Почитал немного на тему отправки сообщений. Подправил Ваш предложенный вариант кода. Получилось вот что:

unit kom_SPPO_6_lab1;

interface

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

type
  TForm1 = class(TForm)
    bCreate: TButton;
    bSuspend: TButton;
    bResume: TButton;
    bSimple: TButton;
    Label1: TLabel;
    procedure bCreateClick(Sender: TObject);
    procedure bSuspendClick(Sender: TObject);
    procedure bResumeClick(Sender: TObject);
    procedure bSimpleClick(Sender: TObject);
    procedure MyMess (var Mes: TMessage); message WM_USER;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

var
  hThread: Thandle; 
  ThreadID: DWord;   

{$R *.dfm}


function Func (data: pointer): DWORD; stdcall;
var
  i: integer;
begin
  for i:=0 to 1000000 do
      SendMessage(Form1.Handle,WM_USER,i,0);
end;

procedure TForm1.MyMess;
begin
 Label1.Caption:=IntToStr(Mes.wParam);
end;

procedure TForm1.bCreateClick(Sender: TObject);
begin
  hThread:=CreateThread(Nil,0,@Func,Nil,0,ThreadID);
  if hThread=0 then
      ShowMessage('No Thread');
end;

procedure TForm1.bSuspendClick(Sender: TObject);
begin
  SuspendThread(hThread);
end;

procedure TForm1.bResumeClick(Sender: TObject);
begin
  ResumeThread(hThread);
end;

procedure TForm1.bSimpleClick(Sender: TObject);
begin
  Func(nil);
end;

end.

Но теперь не реализуется вариант Без потока...