线程

Delphi主线程重入而导致程序卡死的解决方案

Delphi的线程可以通过调用AThread.Synchronize(AProc),可以将Proc放入主线程中同步运行，此时AThread将挂起，直到主线程执行完AProc。

如果有BThread，调用了BThread.Synchronize(BProc)，而BProc中释放了AThread

procedure TBThread.BProc
begin
  AThread.Terminate;
  AThread.WaitFor;
  AThread.Free;
end;

此时我们的程序将会卡死，下面的代码可以避免死锁，是通用的线程等待结束代码。

    AThread.Terminate;
    while not AThread.Finished do
    begin
      if GetCurrentThreadID = MainThreadID then  //由于是通过Synchronize同步到主线程执行，所以调用CheckSynchronize，防止死锁
        CheckSynchronize(0);

      Sleep(1);
    end;
    FreeAndNil(AThread);

 如果以前没注意此重入问题，请修改你的代码吧。因为不能保证我们的代码被其他人用时不会出现重入。

此代码既支持Windows，也支持Android

不过包含的单元不一样：

uses System.SyncObjs,
{$ifdef MSWINDOWS}
Windows;
{$endif}
{$ifdef POSIX}
Posix.Pthread;
{$endif}

Delphi写的DLL，OCX中多线程一个同步问题

Delphi写的DLL，OCX中如果使用了TThread.Synchronze(Proc)，可能导致线程死锁，原因是无法唤醒EXE中主线程，

Synchronze并不会进入EXE主线程消息队列.

下面的程序自动解决此问题，只需要加入DLL，OCX工程文件中，在DLL，OCX中便可以使用TThread.Synchronze(Proc)了，无需再写一行代码。

//解决Delphi编译的DLL,OCX文件中的线程调用 TThread.Synchronize后挂起无法再激活问题
//调用了TThread.Synchronize函数的所有工程请包含此文件
//仅需将此单元包含到工程文件即可

unit Lib.Common.DLLThread;

interface


implementation

uses Classes, Windows, Messages;

type

  { TDLLSystemController }

  TDLLSystemController = class
  private
    FHandle: HWND;
    FPrevWakeMainThread: TNotifyEvent;
    procedure WakeMainThread(Sender: TObject);
    procedure HookSynchronizeWakeup;
    procedure UnhookSynchronizeWakeup;
  protected
    procedure WndProc(var Message: TMessage);
  public
    constructor Create;
    destructor Destroy; override;
  end;

var
  FDLLController:TDLLSystemController;

{ TDLLSystemController }

constructor TDLLSystemController.Create;
begin
  inherited;
  if IsLibrary then
  begin
    FHandle := AllocateHWnd(WndProc);
    HookSynchronizeWakeup;
  end;
end;

destructor TDLLSystemController.Destroy;
begin
  if IsLibrary then
  begin
    DeallocateHWnd(FHandle);
    UnhookSynchronizeWakeup;
  end;
  inherited;
end;

procedure TDLLSystemController.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_NULL: CheckSynchronize;
  else
    Message.Result := DefWindowProc(FHandle, Message.Msg, Message.wParam, Message.lParam);
  end;
end;

procedure TDLLSystemController.WakeMainThread(Sender: TObject);
begin
  PostMessage(FHandle, WM_NULL, 0, 0);
end;

procedure TDLLSystemController.HookSynchronizeWakeup;
begin
  FPrevWakeMainThread := Classes.WakeMainThread;
  Classes.WakeMainThread := WakeMainThread;
end;

procedure TDLLSystemController.UnhookSynchronizeWakeup;
begin
  Classes.WakeMainThread := FPrevWakeMainThread;
end;


initialization
  if IsLibrary then FDLLController := TDLLSystemController.Create
    else FDLLController:=nil;
finalization
  if Assigned(FDLLController) then FDLLController.Free;
end.

Delphi跨平台下的GetTickCount,GetCurrentThreadID

在Windows下只要uses Windows,就有这两个API可调用GetTickCount,GetCurrentThreadID

如果我们需要跨平台使用这两个函数，就不能仅仅Uses Windows了。

如果需要跨平台使用GetTickCount,可以uses System.Classes，然后使用类方法：TThread.GetTickCount

如果需要跨平台使用GetCurrentThreadID,则仅需引用不同的单元即可：

uses 
{$ifdef MSWINDOWS}
Windows;
{$endif}
{$ifdef POSIX}
Posix.Pthread;
{$endif}

Delphi Firemonkey在主线程 异步调用函数（延迟调用）

先看下面的FMX.Layouts.pas中一段代码

1
2
3
4
5
6
7
8
9
10
11
procedure TCustomScrollBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Single);
begin
  FMouseEvents := True;
  inherited;
  if (Button = TMouseButton.mbLeft) then
  begin
    MousePosToAni(X, Y);
    AniMouseDown(ssTouch in Shift, X, Y);
  end;
end;
在执行Inherited;这行时可能会调用控件的OnDblClick事件，如果此时在OnDblClick中将Form或控件释放了，后面调用MousePosToAni可能就会造成内存访问异常

因此最好能够在UI线程（主线程)中执行MouseDown完全后，再调用Form或控件的释放，如下面


procedure TForm1.OnListBox1Item1DblClick(Sender:TObject);
begin
  ....//处理一些事情
  AsyncCallInUIThread(
    procedure
    begin
      Self.DisposeOf; //延迟释放，防止内存访问异常
    end);
end;
　　

下面是AsyncCallInUIThread的实现：

procedure AsyncCallInUIThread(Proc: TProc);
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      Sleep(0);
      TThread.Synchronize(nil,
        procedure
        begin
          Proc;
        end);
    end).Start;
end;

unit UnitFormWait;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TThreadCount1 = class(TThread)
    procedure Execute; override;
  end;

  TThreadCount2 = class(TThread)
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  Count1: TThreadCount1;
  Count2: TThreadCount2;
  Event:TEvent;

implementation

{$R *.dfm}

{ TThreadCount1 }

procedure TThreadCount1.Execute;
var
  i:Integer;
begin
  for i := 0 to 1000 do
  begin
    Form1.Label1.Caption := IntTostr(i);
    if i = 10 then
       Event.SetEvent;
    sleep(1000);
  end;
end;
{ TThreadCount2 }

procedure TThreadCount2.Execute;
var
  i:Integer;
  WaitVar:TWaitResult;
begin
  WaitVar := Event.WaitFor(15000);
  if  WaitVar  = wrSignaled then
  begin
    for i := 0 to 1000 do
    begin
      Form1.Label2.Caption := IntTostr(i);
      sleep(1000);
    end;
  end
  else if WaitVar = wrTimeout then
      ShowMessage('½Ã°£ÃÊ°ú');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Event := TEvent.Create(nil, False, True, '');
  Event.ResetEvent;
  Count1 := TThreadCount1.Create(False);
  Count2 := TThreadCount2.Create(False);
end;

end.
有待测试