TThreadStatus =
(TError, TRun, TNotFree, TNull, TPause, TResume, TStop, TSuccessful);
TMessageEvent =
procedure(
var Message: TMessage)
of object;
TMForm =
class(TForm)
private
FMessageEvent: TMessageEvent;
procedure WndProc(
var Message: TMessage);
override;
public
property MessageEvent: TMessageEvent
read FMessageEvent
write FMessageEvent;
constructor Create(AOwner: TComponent);
end;
{ TMForm }
constructor TMForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
end;
procedure TMForm.WndProc(
var Message: TMessage);
begin
inherited;
if Assigned(FMessageEvent)
then
FMessageEvent(Message);
end;
TSuperTheard =
class(TThread)
private
MForm: TMForm;
MsgEvent: TMessageEvent;
function ReadStatus: Byte;
function ReadHandle : THandle;
protected
//
procedure ThreadTerminate(Sender: TObject);
//
procedure OnMessage(
var Message: TMessage);
procedure Wait(LatencyTime : Cardinal);
public
property MsgHandle: THandle
read ReadHandle;
property Status: Byte
read ReadStatus;
constructor Create(CreateSuspended: Boolean);
end;
{ TSuperTheard }
constructor TSuperTheard.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate :=
True;
MForm := TMForm.Create(
nil);
MForm.MessageEvent :=
MsgEvent;
end;
function TSuperTheard.ReadHandle: THandle;
begin
Result :=
MForm.Handle;
end;
function TSuperTheard.ReadStatus: Byte;
var
i: DWord;
IsQuit: Boolean;
begin
if Assigned(Self)
then
begin
IsQuit :=
GetExitCodeThread(Handle, i);
if IsQuit
then
begin
if i = STILL_ACTIVE
then
Result := IfThen(Suspended,
4,
1)
else
Result :=
2;
end
else
Result :=
0;
end
else
Result :=
3;
end;
procedure TSuperTheard.Wait(LatencyTime: Cardinal);
var
FirstTickCount: Longint;
begin
FirstTickCount :=
GetTickCount;
repeat
Application.ProcessMessages();
sleep(1);
until ((GetTickCount - FirstTickCount) >= Longint(LatencyTime))
or Terminated;
end;
转载于:https://www.cnblogs.com/jinqi/archive/2012/07/13/2589977.html
