Нить открытые формы в Delphi - PullRequest
Новая
       31

Нить открытые формы в Delphi

9 голосов
/ 15 марта 2012

Я хочу создать новые экземпляры формы (и показать их) из потока. Но кажется, что это замораживает мое приложение и мой поток (мой поток становится потоком не синхронизирующим, и это замораживает мое приложение).

Как это (но это не делает то, что я ищу) 

procedure a.Execute;
var frForm:TForm;
    B:TCriticalSection;
begin
   b:=TCriticalSection.Create;
   while 1=1 do
   begin
     b.Enter;

        frForm:=TForm.Create(Application);
        frForm.Show;
     b.Leave;
     sleep(500); //this sleep with sleep my entire application and not only the thread.
      //sleep(1000);
   end;
end;

Я не хочу использовать Classes.TThread.Synchronize метод

Ответы [ 2 ]

19 голосов
/ 15 марта 2012

TThread.Synchronize() - самое простое решение: 

procedure a.Execute;
begin
  while not Terminated do
  begin
    Synchronize(CreateAndShowForm);
    Sleep(500);
  end;
end;

procedure a.CreateAndShowForm;
var
  frForm:TForm;
begin
  frForm:=TForm.Create(Application);
  frForm.Show;
end;

Если вы используете современную версию Delphi и вам не нужно ждать завершения создания TForm, прежде чем позволить потоку двигаться дальше, вы можете использовать TThread.Queue() вместо: 

procedure a.Execute;
begin
  while not Terminated do
  begin
    Queue(CreateAndShowForm);
    Sleep(500);
  end;
end;

Обновление: Если вы хотите использовать PostMessage(), самый безопасный вариант - отправлять сообщения в окно TApplicationили выделенное окно, созданное с помощью AllocateHWnd(), например: 

const
  WM_CREATE_SHOW_FORM = WM_USER + 1;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;

procedure TMainForm.AppMessage(var Msg: TMsg; var Handled: Boolean);
var
  frForm:TForm;
begin
  if Msg.message = WM_CREATE_SHOW_FORM then
  begin
    Handled := True;
    frForm := TForm.Create(Application);
    frForm.Show;
  end;
end;

procedure a.Execute;
begin
  while not Terminated do
  begin
    PostMessage(Application.Handle, WM_CREATE_SHOW_FORM, 0, 0);
    Sleep(500);
  end;
end;

. 

const
  WM_CREATE_SHOW_FORM = WM_USER + 1;

var
  ThreadWnd: HWND = 0;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  ThreadWnd := AllocateHWnd(ThreadWndProc);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  DeallocateHwnd(ThreadWnd);
  ThreadWnd := 0;
end;

procedure TMainForm.ThreadWndProc(var Message: TMessage);
var
  frForm:TForm;
begin
  if Message.Msg = WM_CREATE_SHOW_FORM then
  begin
    frForm := TForm.Create(Application);
    frForm.Show;
  end else
    Message.Result := DefWindowProc(ThreadWnd, Message.Msg, Message.WParam, Message.LParam);
end;

procedure a.Execute;
begin
  while not Terminated do
  begin
    PostMessage(ThreadWnd, WM_CREATE_SHOW_FORM, 0, 0);
    Sleep(500);
  end;
end;
15 голосов
/ 15 марта 2012

Таким способом нельзя создать заведомо небезопасную форму VCL (обратите внимание - это не просто Delphi - у всех разработок GUI, которые я видел, есть это ограничение). Либо используйте TThread.Synchronize, чтобы сообщить основному потоку о создании формы, либо используйте какой-либо другой механизм сигнализации, например API PostMessage ().

В целом, лучше постараться сохранить содержимое графического интерфейса из вторичных потоков, насколько это возможно. Вторичные потоки лучше использовать для операций ввода-вывода без графического интерфейса и / или операций, интенсивно использующих процессор (особенно, если они могут быть разделены и выполняться параллельно).

Пример PostMessage, (форма имеет только одну кнопку быстрого запуска): 

unit mainForm;

interface

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

const
  CM_OBJECTRX=$8FF0;

type
  EmainThreadCommand=(EmcMakeBlueForm,EmcMakeGreenForm,EmcMakeRedForm);

  TformMakerThread = class(TThread)
  protected
    procedure execute; override;
  public
    constructor create;
  end;

  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    procedure SpeedButton1Click(Sender: TObject);
  private
    myThread:TformMakerThread;
  protected
    procedure CMOBJECTRX(var message:Tmessage); message CM_OBJECTRX;
  end;

var
  Form1: TForm1;
  ThreadPostWindow:Thandle;

implementation


{$R *.dfm}

{ TForm1 }

procedure TForm1.CMOBJECTRX(var message: Tmessage);
var thisCommand:EmainThreadCommand;

  procedure makeForm(formColor:integer);
  var newForm:TForm1;
  begin
    newForm:=TForm1.Create(self);
    newForm.Color:=formColor;
    newForm.Show;
  end;

begin
  thisCommand:=EmainThreadCommand(message.lparam);
  case thisCommand of
    EmcMakeBlueForm:makeForm(clBlue);
    EmcMakeGreenForm:makeForm(clGreen);
    EmcMakeRedForm:makeForm(clRed);
  end;
end;

function postThreadWndProc(Window: HWND; Mess, wParam, lParam: Longint): Longint; stdcall;
begin
  result:=0;
  if (Mess=CM_OBJECTRX) then
  begin
    try
      TControl(wparam).Perform(CM_OBJECTRX,0,lParam);
      result:=-1;
    except
      on e:exception do application.messageBox(PChar(e.message),PChar('PostToMainThread perform error'),MB_OK);
    end;
  end
    else
      Result := DefWindowProc(Window, Mess, wParam, lParam);
end;

var
  ThreadPostWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @postThreadWndProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'TpostThreadWindow');

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  TformMakerThread.create;
end;

{ TformMakerThread }

constructor TformMakerThread.create;
begin
  inherited create(true);
  freeOnTerminate:=true;
  resume;
end;

procedure TformMakerThread.execute;
begin
  while(true) do
  begin
    postMessage(ThreadPostWindow,CM_OBJECTRX,integer(Form1),integer(EmcMakeBlueForm));
    sleep(1000);
    postMessage(ThreadPostWindow,CM_OBJECTRX,integer(Form1),integer(EmcMakeGreenForm));
    sleep(1000);
    postMessage(ThreadPostWindow,CM_OBJECTRX,integer(Form1),integer(EmcMakeRedForm));
    sleep(1000);
  end;
end;

initialization
  Windows.RegisterClass(ThreadPostWindowClass);
  ThreadPostWindow:=CreateWindow(ThreadPostWindowClass.lpszClassName, '', 0,
      0, 0, 0, 0, 0, 0, HInstance, nil);
finalization
  DestroyWindow(ThreadPostWindow);
end.
...