以这种方式创建臭名昭著的线程不安全 VCL 表单是不可行的,(请注意 - 不仅限于 Delphi - 所有我见过的 GUI 开发都有此限制)。要么使用 TThread.Synchronize 信号主线程来创建表单,要么使用其他信号机制,如 PostMessage() API。
总体而言,尽可能将 GUI 相关内容保持在主线程之内。次要线程最好用于非 GUI I/O 和/或 CPU 密集型操作(尤其是如果可以分割并并行执行)。
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}
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;
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.
TThread.Queue()
,它类似于PostMessage()
的TThread
等效方式,而无需窗口。 - Remy Lebeau