Открытые формы в Delphi

Question

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

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

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 методу

Answer 1

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

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

PostMessage пример (форма имеет только один SpeedButton на него):

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. 

Answer 2

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 и Дон» t необходимо дождаться завершения создания TForm, прежде чем разрешить движение нити, вы можете использовать TThread.Queue() вместо:

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

Update: Если вы хотите использовать 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;