david
7ebea5ffa7
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@12 7f62d464-2af8-f54e-996c-e91b33f51cbe
1226 lines
36 KiB
ObjectPascal
1226 lines
36 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvThread.PAS, released on 2001-02-28.
|
|
|
|
The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]
|
|
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s): Michael Beck [mbeck att bigfoot dott com].
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.sourceforge.net
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvThread.pas 11813 2008-06-09 23:16:17Z jfudickar $
|
|
|
|
unit JvThread;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
SysUtils, Classes, Syncobjs,
|
|
{$IFDEF MSWINDOWS}
|
|
Windows, Controls, ExtCtrls,
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF UNIX}
|
|
QWindows,
|
|
{$ENDIF UNIX}
|
|
Forms, Dialogs,
|
|
JvTypes, JvComponentBase, JvComponent;
|
|
|
|
type
|
|
TJvCustomThreadDialog = class;
|
|
TJvCustomThreadDialogForm = class;
|
|
TJvThread = class;
|
|
|
|
TJvCustomThreadDialogFormEvent = procedure(DialogForm: TJvCustomThreadDialogForm) of object;
|
|
TJvThreadCancelEvent = procedure(CurrentThread : TJvThread) of object;
|
|
|
|
TJvCustomThreadDialogOptions = class(TPersistent)
|
|
private
|
|
FFormStyle: TFormStyle;
|
|
FOwner: TJvCustomThreadDialog;
|
|
FShowDelay: Integer;
|
|
FShowDialog: Boolean;
|
|
FShowModal: Boolean;
|
|
procedure SetShowDelay(const Value: Integer);
|
|
procedure SetShowDialog(Value: Boolean);
|
|
procedure SetShowModal(Value: Boolean);
|
|
public
|
|
constructor Create(AOwner: TJvCustomThreadDialog); virtual;
|
|
published
|
|
property FormStyle: TFormStyle read FFormStyle write FFormStyle;
|
|
//1 Delay in milliseconds for starting the thread dialog
|
|
property ShowDelay: Integer read FShowDelay write SetShowDelay default 0;
|
|
//1 Flag if there should be a dialog which shows the thread status
|
|
property ShowDialog: Boolean read FShowDialog write SetShowDialog default False;
|
|
//1 Flag if the status dialog is modal
|
|
property ShowModal: Boolean read FShowModal write SetShowModal default True;
|
|
end;
|
|
|
|
TJvCustomThreadDialogForm = class(TJvForm)
|
|
private
|
|
FConnectedDataComponent: TComponent;
|
|
FConnectedDataObject: TObject;
|
|
FConnectedThread: TJvThread;
|
|
FDialogOptions: TJvCustomThreadDialogOptions;
|
|
FFormIsShown: Boolean;
|
|
FInternalShowDelay: Integer;
|
|
FInternalTimer: TTimer;
|
|
FInternalTimerInterval: Integer;
|
|
FOnClose: TCloseEvent;
|
|
FOnCloseQuery: TCloseQueryEvent;
|
|
FOnPressCancel: TJvThreadCancelEvent;
|
|
FOnShow: TNotifyEvent;
|
|
FParentHandle: HWND;
|
|
procedure CloseThreadForm;
|
|
procedure SetConnectedDataComponent(Value: TComponent);
|
|
procedure SetConnectedDataObject(Value: TObject);
|
|
procedure SetInternalTimerInterval(Value: Integer);
|
|
procedure SetOnClose(Value: TCloseEvent);
|
|
procedure OnInternalTimer(Sender: TObject); virtual;
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure InitializeFormContents; virtual;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure TransferDialogOptions; virtual;
|
|
procedure UpdateFormContents; virtual;
|
|
property FormIsShown: Boolean read FFormIsShown default False;
|
|
property OnPressCancel: TJvThreadCancelEvent read FOnPressCancel
|
|
write FOnPressCancel;
|
|
public
|
|
constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0); override;
|
|
constructor CreateNewFormStyle(AOwner: TJvThread; FormStyle: TFormStyle;
|
|
Parent: TWinControl = nil); virtual;
|
|
destructor Destroy; override;
|
|
procedure DefaultCancelBtnClick(Sender: TObject);
|
|
procedure ReplaceFormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure ReplaceFormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
procedure ReplaceFormShow(Sender: TObject);
|
|
property ConnectedDataComponent: TComponent read FConnectedDataComponent write SetConnectedDataComponent;
|
|
property ConnectedDataObject: TObject read FConnectedDataObject write SetConnectedDataObject;
|
|
property ConnectedThread: TJvThread read FConnectedThread;
|
|
property DialogOptions: TJvCustomThreadDialogOptions read FDialogOptions write
|
|
FDialogOptions;
|
|
property InternalTimerInterval: Integer read FInternalTimerInterval write SetInternalTimerInterval;
|
|
published
|
|
property OnClose: TCloseEvent read FOnClose write SetOnClose;
|
|
property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
|
|
property OnShow: TNotifyEvent read FOnShow write FOnShow;
|
|
end;
|
|
|
|
TJvCustomThreadDialog = class(TJvComponent)
|
|
private
|
|
FDialogOptions: TJvCustomThreadDialogOptions;
|
|
FOnPressCancel: TJvThreadCancelEvent;
|
|
protected
|
|
function CreateDialogOptions: TJvCustomThreadDialogOptions; virtual; abstract;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function CreateThreadDialogForm(ConnectedThread: TJvThread): TJvCustomThreadDialogForm; virtual; abstract;
|
|
published
|
|
property DialogOptions: TJvCustomThreadDialogOptions read FDialogOptions write FDialogOptions;
|
|
property OnPressCancel: TJvThreadCancelEvent read FOnPressCancel
|
|
write FOnPressCancel;
|
|
end;
|
|
|
|
TJvThreadShowMessageDlgEvent = procedure(const Msg: string; AType: TMsgDlgType;
|
|
AButtons: TMsgDlgButtons; HelpCtx: Longint; var DlgResult : Word) of object;
|
|
|
|
TJvBaseThread = class(TThread)
|
|
private
|
|
FException: Exception;
|
|
FExceptionAddr: Pointer;
|
|
FInternalTerminate: Boolean;
|
|
FExecuteEvent: TJvNotifyParamsEvent;
|
|
FOnResumeDone: Boolean;
|
|
FExecuteIsActive: Boolean;
|
|
FFinished: Boolean;
|
|
FOnShowMessageDlgEvent: TJvThreadShowMessageDlgEvent;
|
|
FParams: Pointer;
|
|
FSender: TObject;
|
|
FSynchAButtons: TMsgDlgButtons;
|
|
FSynchAType: TMsgDlgType;
|
|
FSynchHelpCtx: Longint;
|
|
FSynchMessageDlgResult: Word;
|
|
FSynchMsg: string;
|
|
procedure ExceptionHandler;
|
|
protected
|
|
procedure InternalMessageDlg;
|
|
public
|
|
constructor Create(Sender: TObject; Event: TJvNotifyParamsEvent; Params:
|
|
Pointer); virtual;
|
|
destructor Destroy; override;
|
|
procedure Resume;
|
|
procedure Execute; override;
|
|
procedure Synchronize(Method: TThreadMethod);
|
|
function SynchMessageDlg(const Msg: string; AType: TMsgDlgType;
|
|
AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;
|
|
property Container: TObject read FSender;
|
|
property ExecuteIsActive: Boolean read FExecuteIsActive;
|
|
property Finished: Boolean read FFinished;
|
|
property Terminated;
|
|
property Params: Pointer read FParams;
|
|
property ReturnValue;
|
|
property OnShowMessageDlgEvent: TJvThreadShowMessageDlgEvent
|
|
read FOnShowMessageDlgEvent write FOnShowMessageDlgEvent;
|
|
end;
|
|
|
|
TJvThread = class(TJvComponent)
|
|
private
|
|
FAfterCreateDialogForm: TJvCustomThreadDialogFormEvent;
|
|
FBeforeResume: TNotifyEvent;
|
|
FDisalbeDialogShowDelayCounter: Integer;
|
|
FThreads: TThreadList;
|
|
FListLocker: TCriticalSection;
|
|
FLockedList: TList;
|
|
FExclusive: Boolean;
|
|
FMaxCount: Integer;
|
|
FRunOnCreate: Boolean;
|
|
FOnBegin: TNotifyEvent;
|
|
FOnExecute: TJvNotifyParamsEvent;
|
|
FOnFinish: TNotifyEvent;
|
|
FOnFinishAll: TNotifyEvent;
|
|
FFreeOnTerminate: Boolean;
|
|
FOnCancelExecute: TJvThreadCancelEvent;
|
|
FOnShowMessageDlgEvent: TJvThreadShowMessageDlgEvent;
|
|
FPriority: TThreadPriority;
|
|
FThreadDialog: TJvCustomThreadDialog;
|
|
FThreadDialogAllowed: Boolean;
|
|
FThreadDialogForm: TJvCustomThreadDialogForm;
|
|
procedure DoBegin;
|
|
procedure DoTerminate(Sender: TObject);
|
|
function GetCount: Integer;
|
|
function GetThreads(Index: Integer): TJvBaseThread;
|
|
function GetTerminated: Boolean; // in context of thread in list - for itself; in others - for all threads in list
|
|
procedure SetReturnValue(RetVal: Integer); // in context of thread in list - set return value (slower)
|
|
function GetReturnValue: Integer; // in context of thread in list - get return value (slower)
|
|
procedure CreateThreadDialogForm;
|
|
procedure CloseThreadDialogForm;
|
|
function GetCurrentThread: TJvBaseThread;
|
|
procedure ShowThreadDialogForm;
|
|
protected
|
|
procedure InternalAfterCreateDialogForm(DialogForm: TJvCustomThreadDialogForm); virtual;
|
|
function GetOneThreadIsRunning: Boolean;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure CancelExecute; virtual;
|
|
function Execute(P: Pointer): TJvBaseThread;
|
|
procedure ExecuteAndWait(P: Pointer); // wait for all threads in list
|
|
procedure ExecuteThreadAndWait(P: Pointer); // wait only this thread
|
|
procedure ExecuteWithDialog(P: Pointer);
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
|
|
procedure Synchronize(Method: TThreadMethod); // (slower)
|
|
function SynchMessageDlg(const Msg: string; AType: TMsgDlgType;
|
|
AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;
|
|
|
|
procedure Lock; // for safe use of property Threads[]
|
|
procedure Unlock;
|
|
|
|
property Count: Integer read GetCount;
|
|
property Threads[Index: Integer]: TJvBaseThread read GetThreads;
|
|
property LastThread: TJvBaseThread read GetCurrentThread; //GetLastThread;
|
|
property Terminated: Boolean read GetTerminated; // in context of thread in list - for itself; in others - for all threads in list
|
|
property ReturnValue: Integer read GetReturnValue write SetReturnValue; // in context of thread in list - set return value (slower)
|
|
property OneThreadIsRunning: Boolean read GetOneThreadIsRunning;
|
|
//1 Property to allow/disallow the thread dialog form
|
|
property ThreadDialogAllowed: Boolean read FThreadDialogAllowed write
|
|
FThreadDialogAllowed default True;
|
|
property ThreadDialogForm: TJvCustomThreadDialogForm read FThreadDialogForm;
|
|
(*
|
|
function GetPriority(Thread: THandle): TThreadPriority;
|
|
procedure SetPriority(Thread: THandle; Priority: TThreadPriority);
|
|
{$IFDEF UNIX}
|
|
function GetPolicy(Thread: THandle): Integer;
|
|
procedure SetPolicy(Thread: THandle; Policy: Integer);
|
|
procedure SetPolicyAll(Policy: Integer);
|
|
{$ENDIF UNIX}
|
|
procedure QuitThread(Thread: THandle);
|
|
procedure Suspend(Thread: THandle); // should not be used
|
|
procedure Resume(Thread: THandle); overload;
|
|
*)
|
|
{$IFDEF UNIX}
|
|
procedure SetPolicy(Policy: Integer); // [not tested] in context of thread in list - for itself; in other contexts - for all threads in list
|
|
{$ENDIF UNIX}
|
|
//1 Disables the delayed showing of the thread dialog
|
|
procedure DisableDialogShowDelay;
|
|
//1 Enables the delayed showing of the thread dialog
|
|
procedure EnableDialogShowDelay;
|
|
//1 Is the delayed showing of the thread dialog disabled
|
|
function IsDialogShowDelayDisabled: Boolean;
|
|
procedure SetPriority(NewPriority: TThreadPriority); // in context of thread in list - for itself; in other contexts - for all threads in list
|
|
procedure Resume(BaseThread: TJvBaseThread); overload;
|
|
procedure Resume; overload; // resumes all threads including deferred (RunOnCreate=false)
|
|
procedure Suspend; // in context of thread in list - for itself; in other contexts - for all threads in list
|
|
procedure Terminate; // terminates all threads
|
|
procedure WaitFor; // wait for all threads
|
|
procedure RemoveZombie(BaseThread: TJvBaseThread); overload; // remove finished thread (where FreeOnTerminate was false)
|
|
procedure RemoveZombie; overload; // remove all finished threads (where FreeOnTerminate was false)
|
|
//1 //Combination of Terminate and WaitFor, optional RemoveZombie
|
|
procedure TerminateWaitFor(iRemoveZombies: Boolean = true);
|
|
published
|
|
property Exclusive: Boolean read FExclusive write FExclusive;
|
|
property MaxCount: Integer read FMaxCount write FMaxCount;
|
|
property RunOnCreate: Boolean read FRunOnCreate write FRunOnCreate;
|
|
property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
|
|
property Priority: TThreadPriority read FPriority write FPriority default tpNormal;
|
|
property ThreadDialog: TJvCustomThreadDialog read FThreadDialog write FThreadDialog;
|
|
property AfterCreateDialogForm: TJvCustomThreadDialogFormEvent
|
|
read FAfterCreateDialogForm write FAfterCreateDialogForm;
|
|
property BeforeResume: TNotifyEvent read FBeforeResume write FBeforeResume;
|
|
property OnBegin: TNotifyEvent read FOnBegin write FOnBegin;
|
|
property OnCancelExecute: TJvThreadCancelEvent read FOnCancelExecute write
|
|
FOnCancelExecute;
|
|
property OnExecute: TJvNotifyParamsEvent read FOnExecute write FOnExecute;
|
|
property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
|
|
property OnFinishAll: TNotifyEvent read FOnFinishAll write FOnFinishAll;
|
|
property OnShowMessageDlgEvent: TJvThreadShowMessageDlgEvent read
|
|
FOnShowMessageDlgEvent write FOnShowMessageDlgEvent;
|
|
end;
|
|
|
|
// Cannot be synchronized to the MainThread (VCL)
|
|
// (rom) why are these in the interface section?
|
|
procedure Synchronize(Method: TNotifyEvent);
|
|
procedure SynchronizeParams(Method: TJvNotifyParamsEvent; P: Pointer);
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/branches/JVCL3_36_PREPARATION/run/JvThread.pas $';
|
|
Revision: '$Revision: 11813 $';
|
|
Date: '$Date: 2008-06-10 01:16:17 +0200 (mar., 10 juin 2008) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
JvResources;
|
|
|
|
var
|
|
SyncMtx: THandle = 0;
|
|
|
|
procedure Synchronize(Method: TNotifyEvent);
|
|
begin
|
|
WaitForSingleObject(SyncMtx, INFINITE);
|
|
try
|
|
Method(nil);
|
|
finally
|
|
ReleaseMutex(SyncMtx);
|
|
end;
|
|
end;
|
|
|
|
procedure SynchronizeParams(Method: TJvNotifyParamsEvent; P: Pointer);
|
|
begin
|
|
WaitForSingleObject(SyncMtx, INFINITE);
|
|
try
|
|
Method(nil, P);
|
|
finally
|
|
ReleaseMutex(SyncMtx);
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvCustomThreadDialogOptions } =======================================
|
|
|
|
constructor TJvCustomThreadDialogOptions.Create(AOwner: TJvCustomThreadDialog);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
FShowDialog := False;
|
|
FShowModal := True;
|
|
FShowDelay := 0;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogOptions.SetShowDelay(const Value: Integer);
|
|
begin
|
|
FShowDelay := Value;
|
|
if FShowDelay < 0 then
|
|
FShowDelay := 0;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogOptions.SetShowDialog(Value: Boolean);
|
|
begin
|
|
FShowDialog := Value;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogOptions.SetShowModal(Value: Boolean);
|
|
begin
|
|
FShowModal := Value;
|
|
end;
|
|
|
|
//=== { TJvCustomThreadDialogForm } ==========================================
|
|
|
|
constructor TJvCustomThreadDialogForm.CreateNew(AOwner: TComponent; Dummy:
|
|
Integer = 0);
|
|
begin
|
|
inherited CreateNew(AOwner, Dummy);
|
|
FInternalTimerInterval := 500;
|
|
if AOwner is TJvThread then
|
|
FConnectedThread := TJvThread(AOwner)
|
|
else
|
|
raise EJVCLException.CreateRes(@RsENotATJvThread);
|
|
inherited OnShow := ReplaceFormShow;
|
|
inherited OnClose := ReplaceFormClose;
|
|
inherited OnCloseQuery := ReplaceFormCloseQuery;
|
|
FInternalTimer := TTimer.Create(Self);
|
|
FInternalTimer.OnTimer := OnInternalTimer;
|
|
FInternalTimer.Interval := FInternalTimerInterval;
|
|
FInternalShowDelay := 0;
|
|
FFormIsShown := False;
|
|
end;
|
|
|
|
constructor TJvCustomThreadDialogForm.CreateNewFormStyle(AOwner: TJvThread; FormStyle: TFormStyle;
|
|
Parent: TWinControl = nil);
|
|
begin
|
|
if FormStyle <> fsStayOnTop then
|
|
if Assigned(Parent) then
|
|
FParentHandle := Parent.Handle
|
|
else
|
|
FParentHandle := 0;
|
|
CreateNew(AOwner);
|
|
end;
|
|
|
|
destructor TJvCustomThreadDialogForm.Destroy;
|
|
begin
|
|
FreeAndNil(FInternalTimer);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.CloseThreadForm;
|
|
begin
|
|
if fsModal in FormState then
|
|
ModalResult := mrCancel
|
|
else
|
|
Close;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
if FParentHandle <> 0 then
|
|
Params.WndParent := FParentHandle;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.DefaultCancelBtnClick(Sender: TObject);
|
|
begin
|
|
if Assigned(FOnPressCancel) then
|
|
FOnPressCancel(FConnectedThread)
|
|
else
|
|
if Assigned(FConnectedThread) then
|
|
FConnectedThread.CancelExecute;
|
|
ModalResult := mrNone;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.InitializeFormContents;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then
|
|
if AComponent = FConnectedDataComponent then
|
|
FConnectedDataComponent := nil;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.OnInternalTimer(Sender: TObject);
|
|
begin
|
|
if not (csDestroying in ComponentState) then
|
|
begin
|
|
if not Assigned(ConnectedThread) then
|
|
begin
|
|
Hide; // no connected component
|
|
CloseThreadForm;
|
|
end
|
|
else // connected component present
|
|
if ConnectedThread.Terminated or not ConnectedThread.OneThreadIsRunning then
|
|
begin
|
|
if FormIsShown then
|
|
begin
|
|
Hide;
|
|
CloseThreadForm;
|
|
end;
|
|
end
|
|
else // not terminated
|
|
begin
|
|
if FInternalShowDelay > 0 then // Dialog is not shown until yet
|
|
FInternalShowDelay := FInternalShowDelay - FInternalTimerInterval
|
|
else
|
|
if not FormIsShown then
|
|
begin
|
|
if ConnectedThread.ThreadDialogAllowed and not ConnectedThread.IsDialogShowDelayDisabled then
|
|
begin
|
|
if DialogOptions.ShowModal then
|
|
ShowModal
|
|
else
|
|
Show;
|
|
end;
|
|
end
|
|
else
|
|
if ConnectedThread.ThreadDialogAllowed then
|
|
UpdateFormContents;
|
|
end; // not terminated
|
|
end; // if not (csDestroying in ComponentState) then
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.ReplaceFormClose(Sender: TObject; var Action: TCloseAction);
|
|
begin
|
|
FFormIsShown := False;
|
|
if Assigned(FInternalTimer) then
|
|
FInternalTimer.Enabled := False;
|
|
Action := caFree;
|
|
if Assigned(FOnClose) then
|
|
FOnClose(Sender, Action);
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.ReplaceFormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
|
begin
|
|
if Assigned(FConnectedThread) then
|
|
CanClose := not FConnectedThread.OneThreadIsRunning
|
|
else
|
|
CanClose := True;
|
|
if CanClose then
|
|
if Assigned(FOnCloseQuery) then
|
|
FOnCloseQuery(Sender, CanClose);
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.ReplaceFormShow(Sender: TObject);
|
|
begin
|
|
FFormIsShown := True;
|
|
InitializeFormContents;
|
|
UpdateFormContents;
|
|
FInternalTimer.Enabled := True;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.TransferDialogOptions;
|
|
begin
|
|
if Assigned(DialogOptions) then
|
|
fInternalShowDelay := DialogOptions.ShowDelay;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.UpdateFormContents;
|
|
begin
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.SetConnectedDataComponent(Value: TComponent);
|
|
begin
|
|
FConnectedDataComponent := Value;
|
|
if Assigned(Value) then
|
|
FreeNotification(Value);
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.SetConnectedDataObject(Value: TObject);
|
|
begin
|
|
FConnectedDataObject := Value;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.SetInternalTimerInterval(Value: Integer);
|
|
begin
|
|
if Value < 1 then
|
|
Value := 1;
|
|
FInternalTimerInterval := Value;
|
|
FInternalTimer.Interval := Value;
|
|
end;
|
|
|
|
procedure TJvCustomThreadDialogForm.SetOnClose(Value: TCloseEvent);
|
|
begin
|
|
FOnClose := Value;
|
|
end;
|
|
|
|
//=== { TJvCustomThreadDialog } ==============================================
|
|
|
|
constructor TJvCustomThreadDialog.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FDialogOptions := CreateDialogOptions;
|
|
end;
|
|
|
|
destructor TJvCustomThreadDialog.Destroy;
|
|
begin
|
|
FDialogOptions.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
//=== { TJvThread } ==========================================================
|
|
|
|
constructor TJvThread.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FRunOnCreate := True;
|
|
FExclusive := True;
|
|
FFreeOnTerminate := True;
|
|
FThreads := TThreadList.Create;
|
|
FListLocker := TCriticalSection.Create;
|
|
FPriority := tpNormal;
|
|
FThreadDialogAllowed := True;
|
|
FDisalbeDialogShowDelayCounter := 0;
|
|
end;
|
|
|
|
destructor TJvThread.Destroy;
|
|
begin
|
|
Terminate;
|
|
while OneThreadIsRunning do
|
|
begin
|
|
Sleep(1);
|
|
{$IFDEF COMPILER6_UP}
|
|
// Delphi 5 uses SendMessage -> no need for this code
|
|
// Delphi 6+ uses an event and CheckSynchronize
|
|
CheckSynchronize; // TThread.OnTerminate is synchronized
|
|
{$ENDIF COMPILER6_UP}
|
|
end;
|
|
FThreads.Free;
|
|
FListLocker.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvThread.Notification(AComponent: TComponent; Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if Operation = opRemove then
|
|
if AComponent = FThreadDialog then
|
|
FThreadDialog := nil
|
|
else
|
|
if AComponent = FThreadDialogForm then
|
|
FThreadDialogForm := nil
|
|
end;
|
|
|
|
function TJvThread.Execute(P: Pointer): TJvBaseThread;
|
|
var
|
|
BaseThread: TJvBaseThread;
|
|
begin
|
|
BaseThread := nil;
|
|
if not ((Exclusive and OneThreadIsRunning) or ((FMaxCount > 0) and (Count >= FMaxCount))) and
|
|
Assigned(FOnExecute) then
|
|
begin
|
|
try
|
|
BaseThread := TJvBaseThread.Create(Self, FOnExecute, P);
|
|
BaseThread.FreeOnTerminate := FFreeOnTerminate;
|
|
BaseThread.OnShowMessageDlgEvent := OnShowMessageDlgEvent;
|
|
BaseThread.Priority := Priority;
|
|
BaseThread.OnTerminate := DoTerminate;
|
|
FThreads.Add(BaseThread);
|
|
DoBegin;
|
|
except
|
|
// We can't terminate right now due to discrepancy between old and recent versions of TThread
|
|
if Assigned(BaseThread) then
|
|
BaseThread.FInternalTerminate := True;
|
|
end;
|
|
|
|
if FRunOnCreate and Assigned(BaseThread) then
|
|
Resume(BaseThread);
|
|
end;
|
|
Result := BaseThread;
|
|
end;
|
|
|
|
procedure TJvThread.DoBegin;
|
|
begin
|
|
if Assigned(FOnBegin) then
|
|
FOnBegin(Self);
|
|
end;
|
|
|
|
procedure TJvThread.ExecuteAndWait(P: Pointer);
|
|
var
|
|
B: Boolean;
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
B := FRunOnCreate;
|
|
FRunOnCreate := True;
|
|
try
|
|
Thread := Execute(P);
|
|
finally
|
|
FRunOnCreate := B;
|
|
end;
|
|
|
|
if Assigned(Thread) then
|
|
WaitFor; // all threads in list
|
|
end;
|
|
|
|
procedure TJvThread.ExecuteThreadAndWait(P: Pointer);
|
|
var
|
|
B: Boolean;
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
B := FRunOnCreate;
|
|
FRunOnCreate := True;
|
|
try
|
|
Thread := Execute(P);
|
|
finally
|
|
FRunOnCreate := B;
|
|
end;
|
|
if Assigned(Thread) then
|
|
while (not Thread.Finished) do // wait for this thread
|
|
Application.HandleMessage;
|
|
end;
|
|
|
|
procedure TJvThread.Resume(BaseThread: TJvBaseThread);
|
|
var
|
|
B: Boolean;
|
|
begin
|
|
if Assigned(BaseThread) then
|
|
begin
|
|
CreateThreadDialogForm;
|
|
B := BaseThread.FOnResumeDone;
|
|
BaseThread.Resume;
|
|
if (not B) and
|
|
(not BaseThread.FInternalTerminate) and
|
|
(not BaseThread.Finished) then
|
|
begin
|
|
ShowThreadDialogForm;
|
|
end;
|
|
end
|
|
else
|
|
Resume; // no target, resume all
|
|
end;
|
|
|
|
procedure TJvThread.Resume; // All
|
|
var
|
|
List: TList;
|
|
I: Integer;
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
List := FThreads.LockList;
|
|
try
|
|
for I := 0 to List.Count - 1 do
|
|
begin
|
|
Thread := TJvBaseThread(List[I]);
|
|
while Thread.Suspended do
|
|
Resume(Thread);
|
|
end;
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.Suspend;
|
|
var
|
|
List: TList;
|
|
I: Integer;
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
Thread := GetCurrentThread;
|
|
if Assigned(Thread) then
|
|
Thread.Suspend // suspend itself
|
|
else
|
|
begin
|
|
List := FThreads.LockList; // suspend all
|
|
try
|
|
for I := 0 to List.Count - 1 do
|
|
try // against "Access denied" for already finished threads
|
|
Thread := TJvBaseThread(List[I]);
|
|
if not Thread.Finished then // it's faster (prevents raising exceptions in most cases)
|
|
Thread.Suspend;
|
|
except
|
|
end;
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.Terminate;
|
|
var
|
|
List: TList;
|
|
I: Integer;
|
|
begin
|
|
List := FThreads.LockList;
|
|
try
|
|
for I := 0 to List.Count - 1 do
|
|
TJvBaseThread(List[I]).Terminate;
|
|
Resume; // All
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.CancelExecute;
|
|
begin
|
|
if Assigned(fOnCancelExecute) then
|
|
fOnCancelExecute (Self)
|
|
else
|
|
Terminate;
|
|
end;
|
|
|
|
procedure TJvThread.DoTerminate(Sender: TObject);
|
|
begin
|
|
TJvBaseThread(Sender).FExecuteIsActive := False;
|
|
if Assigned(FOnFinish) then
|
|
try
|
|
FOnFinish(Sender);
|
|
except
|
|
// DoTerminate is part of destructor; destructor should not raise exceptions
|
|
end;
|
|
|
|
if TJvBaseThread(Sender).FreeOnTerminate then
|
|
FThreads.Remove(Sender);
|
|
TJvBaseThread(Sender).FFinished := True;
|
|
|
|
if Count = 0 then
|
|
begin
|
|
CloseThreadDialogForm;
|
|
if Assigned(FOnFinishAll) then
|
|
try
|
|
FOnFinishAll(Self);
|
|
except
|
|
// DoTerminate is part of destructor; destructor should not raise exceptions
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.RemoveZombie(BaseThread: TJvBaseThread); // remove finished thread (where FreeOnTerminate was false)
|
|
begin
|
|
if Assigned(BaseThread) then
|
|
begin
|
|
if BaseThread.FFinished and (not BaseThread.FreeOnTerminate) then
|
|
begin
|
|
FThreads.Remove(BaseThread);
|
|
BaseThread.Free;
|
|
end;
|
|
end
|
|
else
|
|
RemoveZombie; // no target, do for all
|
|
end;
|
|
|
|
procedure TJvThread.RemoveZombie; // remove all finished threads (where FreeOnTerminate was false)
|
|
var
|
|
List: TList;
|
|
I: Integer;
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
List := FThreads.LockList;
|
|
try
|
|
for I := List.Count - 1 downto 0 do
|
|
begin
|
|
Thread := TJvBaseThread(List[I]);
|
|
if Thread.FFinished and (not Thread.FreeOnTerminate) then
|
|
begin
|
|
FThreads.Remove(Thread);
|
|
Thread.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
function TJvThread.GetTerminated: Boolean;
|
|
var
|
|
H: DWORD;
|
|
List: TList;
|
|
I: Integer;
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
H := GetCurrentThreadID;
|
|
Result := True;
|
|
List:=FThreads.LockList;
|
|
try
|
|
for I := 0 to List.Count - 1 do
|
|
begin
|
|
Thread := TJvBaseThread(List[I]);
|
|
if Thread.ThreadID = H then
|
|
begin
|
|
Result := Thread.Terminated; // context of thread in list
|
|
Break;
|
|
end
|
|
else
|
|
Result := Result and Thread.Terminated; // context of all other threads
|
|
end;
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.WaitFor;
|
|
begin
|
|
while OneThreadIsRunning do
|
|
Application.HandleMessage;
|
|
end;
|
|
|
|
procedure TJvThread.SetReturnValue(RetVal: Integer);
|
|
var
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
Thread := GetCurrentThread;
|
|
if Assigned(Thread) then
|
|
Thread.ReturnValue := RetVal;
|
|
end;
|
|
|
|
function TJvThread.GetReturnValue: Integer;
|
|
var
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
Thread := GetCurrentThread;
|
|
if Assigned(Thread) then
|
|
Result := Thread.ReturnValue
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TJvThread.GetCount: Integer;
|
|
var
|
|
List: TList;
|
|
begin
|
|
List := FThreads.LockList;
|
|
try
|
|
Result := List.Count;
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
function TJvThread.GetCurrentThread: TJvBaseThread;
|
|
var
|
|
H: DWORD;
|
|
List: TList;
|
|
I: Integer;
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
Result := nil;
|
|
H := GetCurrentThreadID;
|
|
List := FThreads.LockList;
|
|
try
|
|
for I := 0 to List.Count - 1 do
|
|
begin
|
|
Thread := TJvBaseThread(List[I]);
|
|
if Thread.ThreadID = H then
|
|
begin
|
|
Result := Thread;
|
|
Break;
|
|
end;
|
|
end;
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
function TJvThread.GetOneThreadIsRunning: Boolean;
|
|
var
|
|
I: Integer;
|
|
List: TList;
|
|
begin
|
|
Result := False;
|
|
List := FThreads.LockList;
|
|
try
|
|
for I := 0 to List.Count - 1 do
|
|
begin
|
|
Result := not TJvBaseThread(List[I]).Finished;
|
|
if Result then
|
|
Break;
|
|
end;
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.Lock; // for safe use of property Threads[]
|
|
begin
|
|
FListLocker.Acquire;
|
|
try
|
|
if not Assigned(FLockedList) then
|
|
FLockedList := FThreads.LockList;
|
|
except
|
|
FListLocker.Release;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
function TJvThread.GetThreads(Index: Integer): TJvBaseThread;
|
|
begin
|
|
FListLocker.Acquire;
|
|
try
|
|
if Assigned(FLockedList) then
|
|
Result := TJvBaseThread(FLockedList[Index])
|
|
else
|
|
Result := nil;
|
|
finally
|
|
FListLocker.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.Unlock;
|
|
begin
|
|
try
|
|
if Assigned(FLockedList) then
|
|
begin
|
|
FThreads.UnlockList;
|
|
FLockedList := nil;
|
|
end;
|
|
finally
|
|
FListLocker.Release;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.Synchronize(Method: TThreadMethod);
|
|
var
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
DisableDialogShowDelay;
|
|
try
|
|
Thread := GetCurrentThread;
|
|
if Assigned(Thread) then
|
|
Thread.Synchronize(Method)
|
|
else
|
|
Method;
|
|
finally
|
|
EnableDialogShowDelay;
|
|
end;
|
|
end;
|
|
|
|
function TJvThread.SynchMessageDlg(const Msg: string; AType: TMsgDlgType;
|
|
AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;
|
|
var
|
|
Thread: TJvBaseThread;
|
|
begin
|
|
DisableDialogShowDelay;
|
|
try
|
|
Thread := GetCurrentThread;
|
|
if Assigned(Thread) then
|
|
Result := Thread.SynchMessageDlg(Msg, AType, AButtons, HelpCtx)
|
|
else
|
|
if Assigned(OnShowMessageDlgEvent) then
|
|
OnShowMessageDlgEvent(Msg, AType,
|
|
AButtons, HelpCtx, Result)
|
|
else
|
|
Result := MessageDlg(Msg, AType, AButtons, HelpCtx);
|
|
finally
|
|
EnableDialogShowDelay;
|
|
end;
|
|
end;
|
|
|
|
// new
|
|
{$IFDEF UNIX}
|
|
// not tested
|
|
procedure TJvThread.SetPolicy(Policy: Integer);
|
|
var
|
|
List: TList;
|
|
Thread: TJvBaseThread;
|
|
I: Integer;
|
|
begin
|
|
List := FThreads.LockList;
|
|
try
|
|
Thread := GetCurrentThread;
|
|
if Assigned(Thread) then
|
|
SetThreadPolicy(Thread.Handle, Policy) // context of thread in list
|
|
else
|
|
for I := 0 to List.Count - 1 do // context of all other threads
|
|
SetThreadPolicy(TJvBaseThread(List[I]).Handle, Policy);
|
|
end;
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
{$ENDIF UNIX}
|
|
|
|
procedure TJvThread.SetPriority(NewPriority: TThreadPriority);
|
|
var
|
|
List: TList;
|
|
Thread: TJvBaseThread;
|
|
I: Integer;
|
|
begin
|
|
List := FThreads.LockList;
|
|
try
|
|
Thread := GetCurrentThread;
|
|
if Assigned(Thread) then
|
|
Thread.Priority := NewPriority // context of thread in list
|
|
else
|
|
begin
|
|
for I := 0 to List.Count - 1 do // context of all other threads
|
|
TJvBaseThread(List[I]).Priority := NewPriority;
|
|
Priority := NewPriority;
|
|
end;
|
|
finally
|
|
FThreads.UnlockList;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.CreateThreadDialogForm;
|
|
begin
|
|
if Assigned(ThreadDialog) and not Assigned(FThreadDialogForm) then
|
|
begin
|
|
FThreadDialogForm := ThreadDialog.CreateThreadDialogForm(Self);
|
|
if Assigned(FThreadDialogForm) then
|
|
begin
|
|
FreeNotification(FThreadDialogForm);
|
|
FThreadDialogForm.TransferDialogOptions;
|
|
InternalAfterCreateDialogForm(FThreadDialogForm);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.DisableDialogShowDelay;
|
|
begin
|
|
Inc(FDisalbeDialogShowDelayCounter);
|
|
end;
|
|
|
|
procedure TJvThread.EnableDialogShowDelay;
|
|
begin
|
|
Dec(FDisalbeDialogShowDelayCounter);
|
|
end;
|
|
|
|
procedure TJvThread.ExecuteWithDialog(P: Pointer);
|
|
begin
|
|
if Assigned(ThreadDialog) and ThreadDialog.DialogOptions.ShowDialog and
|
|
ThreadDialog.DialogOptions.ShowModal then
|
|
ExecuteAndWait(P)
|
|
else
|
|
Execute(P);
|
|
end;
|
|
|
|
procedure TJvThread.CloseThreadDialogForm;
|
|
begin
|
|
if Assigned(ThreadDialogForm) then
|
|
begin
|
|
while Assigned(ThreadDialogForm) AND ThreadDialogForm.Visible do
|
|
begin
|
|
ThreadDialogForm.CloseThreadForm;
|
|
Application.HandleMessage;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.InternalAfterCreateDialogForm(DialogForm: TJvCustomThreadDialogForm);
|
|
begin
|
|
if Assigned(FAfterCreateDialogForm) then
|
|
FAfterCreateDialogForm(DialogForm);
|
|
end;
|
|
|
|
function TJvThread.IsDialogShowDelayDisabled: Boolean;
|
|
begin
|
|
Result := FDisalbeDialogShowDelayCounter > 0;
|
|
end;
|
|
|
|
procedure TJvThread.ShowThreadDialogForm;
|
|
begin
|
|
if Assigned (ThreadDialog) and Assigned(FThreadDialogForm) then
|
|
if ThreadDialog.DialogOptions.ShowDelay <= 0 then
|
|
begin
|
|
if ThreadDialog.DialogOptions.ShowModal then
|
|
FThreadDialogForm.ShowModal
|
|
else
|
|
FThreadDialogForm.Show;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvThread.TerminateWaitFor(iRemoveZombies: Boolean = true);
|
|
begin
|
|
Terminate;
|
|
WaitFor;
|
|
if iRemoveZombies then
|
|
RemoveZombie;
|
|
end;
|
|
|
|
//=== { TJvBaseThread } ======================================================
|
|
|
|
constructor TJvBaseThread.Create(Sender: TObject; Event: TJvNotifyParamsEvent;
|
|
Params: Pointer);
|
|
begin
|
|
inherited Create(True);
|
|
FSender := Sender;
|
|
FExecuteEvent := Event;
|
|
FParams := Params;
|
|
end;
|
|
|
|
destructor TJvBaseThread.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvBaseThread.ExceptionHandler;
|
|
begin
|
|
ShowException(FException, FExceptionAddr);
|
|
end;
|
|
|
|
procedure TJvBaseThread.Resume;
|
|
begin
|
|
if not FOnResumeDone then
|
|
begin
|
|
// the first resume (perhaps deferred)
|
|
FOnResumeDone := True;
|
|
if (FSender is TJvThread) and Assigned(TJvThread(FSender).BeforeResume) then
|
|
try
|
|
TJvThread(FSender).BeforeResume(Self);
|
|
except
|
|
// Self.Terminate;
|
|
// We can't terminate right now due to discrepancy between old and recent versions TThread
|
|
FInternalTerminate := True;
|
|
end;
|
|
FExecuteIsActive := True;
|
|
end;
|
|
inherited Resume; // after suspend too
|
|
end;
|
|
|
|
procedure TJvBaseThread.Execute;
|
|
begin
|
|
try
|
|
FExecuteIsActive := True;
|
|
if FInternalTerminate then
|
|
Self.Terminate;
|
|
FExecuteEvent(Self, FParams);
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
FException := E;
|
|
FExceptionAddr := ExceptAddr;
|
|
Self.Synchronize(ExceptionHandler);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvBaseThread.Synchronize(Method: TThreadMethod);
|
|
begin
|
|
inherited Synchronize(Method);
|
|
end;
|
|
|
|
procedure TJvBaseThread.InternalMessageDlg;
|
|
begin
|
|
if Assigned(OnShowMessageDlgEvent) then
|
|
OnShowMessageDlgEvent(FSynchMsg, FSynchAType,
|
|
FSynchAButtons, FSynchHelpCtx, FSynchMessageDlgResult)
|
|
else
|
|
FSynchMessageDlgResult := MessageDlg(FSynchMsg, FSynchAType, FSynchAButtons, FSynchHelpCtx);
|
|
end;
|
|
|
|
function TJvBaseThread.SynchMessageDlg(const Msg: string; AType: TMsgDlgType;
|
|
AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;
|
|
begin
|
|
FSynchMsg := Msg;
|
|
FSynchAType := AType;
|
|
FSynchAButtons := AButtons;
|
|
FSynchHelpCtx := HelpCtx;
|
|
Self.Synchronize(InternalMessageDlg);
|
|
Result := FSynchMessageDlgResult;
|
|
end;
|
|
|
|
initialization
|
|
{$IFDEF UNITVERSIONING}
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
{$ENDIF UNITVERSIONING}
|
|
SyncMtx := CreateMutex(nil, False, 'VCLJvThreadMutex');
|
|
|
|
finalization
|
|
CloseHandle(SyncMtx);
|
|
SyncMtx := 0;
|
|
{$IFDEF UNITVERSIONING}
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|