Componentes.Terceros.jvcl/official/3.00/run/JvThread.pas

784 lines
22 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,v 1.44 2005/12/11 16:14:17 jfudickar Exp $
unit JvThread;
{$I jvcl.inc}
interface
uses
{$IFDEF UNITVERSIONING}
JclUnitVersioning,
{$ENDIF UNITVERSIONING}
SysUtils, Classes,
{$IFDEF MSWINDOWS}
Windows, Controls, ExtCtrls,
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
QWindows, QControls, QExtCtrls,
{$ENDIF UNIX}
Forms, Dialogs,
JvTypes, JvComponentBase, JvComponent;
type
TJvCustomThreadDialog = class;
TJvCustomThreadDialogForm = class;
TJvThread = class;
TJvCustomThreadDialogFormEvent = procedure(DialogForm: TJvCustomThreadDialogForm) of object;
TJvCustomThreadDialogOptions = class(TPersistent)
private
FFormStyle: TFormStyle;
FOwner: TJvCustomThreadDialog;
FShowDialog: Boolean;
FShowModal: Boolean;
protected
procedure SetShowDialog(Value: Boolean);
procedure SetShowModal(Value: Boolean);
public
constructor Create(AOwner: TJvCustomThreadDialog); virtual;
published
property FormStyle: TFormStyle read FFormStyle write FFormStyle;
property ShowDialog: Boolean read FShowDialog write SetShowDialog default False;
property ShowModal: Boolean read FShowModal write SetShowModal default True;
end;
TJvCustomThreadDialogForm = class(TJvForm)
private
FConnectedDataComponent: TComponent;
FConnectedDataObject: TObject;
FConnectedThread: TJvThread;
FDialogOptions: TJvCustomThreadDialogOptions;
FInternalTimer: TTimer;
FInternalTimerInterval: Integer;
FOnClose: TCloseEvent;
FOnCloseQuery: TCloseQueryEvent;
FOnShow: TNotifyEvent;
FParentHandle: HWND;
procedure SetConnectedDataComponent(Value: TComponent);
procedure SetConnectedDataObject(Value: TObject);
procedure SetInternalTimerInterval(Value: Integer);
procedure SetOnClose(Value: TCloseEvent);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure InitializeFormContents; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure OnInternalTimer(Sender: TObject); virtual;
procedure TransferDialogOptions; virtual;
procedure UpdateFormContents; virtual;
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: TNotifyEvent;
FThreadStatusDialog: TJvCustomThreadDialogForm;
protected
function CreateDialogOptions: TJvCustomThreadDialogOptions; virtual; abstract;
// property ThreadStatusDialog: TJvCustomThreadDialogForm
// read FThreadStatusDialog write FThreadStatusDialog;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CloseThreadDialogForm;
function CreateThreadDialogForm(ConnectedThread: TJvThread): TJvCustomThreadDialogForm; virtual; abstract;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
published
property DialogOptions: TJvCustomThreadDialogOptions read FDialogOptions write FDialogOptions;
property OnPressCancel: TNotifyEvent read FOnPressCancel write FOnPressCancel;
end;
TJvBaseThread = class(TThread)
private
FException: Exception;
FExceptionAddr: Pointer;
FExecuteEvent: TJvNotifyParamsEvent;
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;
procedure Execute; override;
function SynchMessageDlg(const Msg: string; AType: TMsgDlgType;
AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;
end;
TJvThread = class(TJvComponent)
private
FAfterCreateDialogForm: TJvCustomThreadDialogFormEvent;
FThreadCount: Integer;
FThreads: TThreadList;
FExclusive: Boolean;
FRunOnCreate: Boolean;
FOnBegin: TNotifyEvent;
FOnExecute: TJvNotifyParamsEvent;
FOnFinish: TNotifyEvent;
FOnFinishAll: TNotifyEvent;
FFreeOnTerminate: Boolean;
FThreadDialog: TJvCustomThreadDialog;
FThreadDialogForm: TJvCustomThreadDialogForm;
procedure DoCreate;
procedure DoTerminate(Sender: TObject);
function GetCount: Integer;
function GetThreads(Index: Integer): TJvBaseThread;
function GetTerminated: Boolean;
procedure CreateThreadDialogForm;
function GetLastThread: TJvBaseThread;
protected
procedure intAfterCreateDialogForm(DialogForm: TJvCustomThreadDialogForm); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CancelExecute; virtual;
function Execute(P: Pointer): THandle;
procedure ExecuteAndWait(P: Pointer);
procedure ExecuteWithDialog(P: Pointer);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Synchronize(Method: TThreadMethod);
function SynchMessageDlg(const Msg: string; AType: TMsgDlgType;
AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;
property Count: Integer read GetCount;
property Threads[Index: Integer]: TJvBaseThread read GetThreads;
property LastThread: TJvBaseThread read GetLastThread;
property ThreadDialogForm: TJvCustomThreadDialogForm read FThreadDialogForm;
published
function OneThreadIsRunning: Boolean;
function GetPriority(Thread: THandle): TThreadPriority;
procedure SetPriority(Thread: THandle; Priority: TThreadPriority);
{$IFDEF UNIX}
function GetPolicy(Thread: THandle): Integer;
procedure SetPolicy(Thread: THandle; Policy: Integer);
{$ENDIF UNIX}
procedure QuitThread(Thread: THandle);
procedure Suspend(Thread: THandle); // should not be used
procedure Resume(Thread: THandle);
procedure Terminate; // terminates all running threads
property Terminated: Boolean read GetTerminated;
property Exclusive: Boolean read FExclusive write FExclusive;
property RunOnCreate: Boolean read FRunOnCreate write FRunOnCreate;
property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
property ThreadDialog: TJvCustomThreadDialog read FThreadDialog write FThreadDialog;
property AfterCreateDialogForm: TJvCustomThreadDialogFormEvent
read FAfterCreateDialogForm write FAfterCreateDialogForm;
property OnBegin: TNotifyEvent read FOnBegin write FOnBegin;
property OnExecute: TJvNotifyParamsEvent read FOnExecute write FOnExecute;
property OnFinish: TNotifyEvent read FOnFinish write FOnFinish;
property OnFinishAll: TNotifyEvent read FOnFinishAll write FOnFinishAll;
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: '$RCSfile: JvThread.pas,v $';
Revision: '$Revision: 1.44 $';
Date: '$Date: 2005/12/11 16:14:17 $';
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;
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 := 250;
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;
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.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
if FParentHandle <> 0 then
Params.WndParent := FParentHandle;
end;
procedure TJvCustomThreadDialogForm.DefaultCancelBtnClick(Sender: TObject);
begin
if Assigned(ConnectedThread) then
ConnectedThread.CancelExecute;
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
if Assigned(ConnectedThread) and ConnectedThread.Terminated then
Close
else
if not Assigned(ConnectedThread) then
Close
else
UpdateFormContents;
end;
procedure TJvCustomThreadDialogForm.ReplaceFormClose(Sender: TObject; var Action: TCloseAction);
begin
FInternalTimer.OnTimer := nil;
FInternalTimer.Enabled := False;
Action := caFree;
if Assigned(FOnClose) then
FOnClose(Sender, Action);
end;
procedure TJvCustomThreadDialogForm.ReplaceFormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if Assigned(ConnectedThread) then
CanClose := ConnectedThread.Terminated
else
CanClose := True;
if CanClose then
if Assigned(FOnCloseQuery) then
FOnCloseQuery(Sender, CanClose);
end;
procedure TJvCustomThreadDialogForm.ReplaceFormShow(Sender: TObject);
begin
InitializeFormContents;
OnInternalTimer(nil);
FInternalTimer.Enabled := True;
end;
procedure TJvCustomThreadDialogForm.TransferDialogOptions;
begin
end;
procedure TJvCustomThreadDialogForm.UpdateFormContents;
begin
end;
procedure TJvCustomThreadDialogForm.SetConnectedDataComponent(Value: TComponent);
begin
FConnectedDataComponent := Value;
FreeNotification(Value);
end;
procedure TJvCustomThreadDialogForm.SetConnectedDataObject(Value: TObject);
begin
FConnectedDataObject := Value;
end;
procedure TJvCustomThreadDialogForm.SetInternalTimerInterval(Value: Integer);
begin
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;
procedure TJvCustomThreadDialog.CloseThreadDialogForm;
begin
if Assigned(FThreadStatusDialog) and not (csDestroying in ComponentState) then
begin
FThreadStatusDialog.Close;
Application.HandleMessage;
end;
end;
procedure TJvCustomThreadDialog.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if Operation = opRemove then
if AComponent = FThreadStatusDialog then
FThreadStatusDialog := nil;
end;
//=== { TJvThread } ==========================================================
constructor TJvThread.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FThreadCount := 0;
FRunOnCreate := True;
FExclusive := True;
FFreeOnTerminate := True;
FThreads := TThreadList.Create;
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;
inherited Destroy;
end;
procedure TJvThread.CancelExecute;
begin
Terminate;
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;
procedure TJvThread.Synchronize(Method: TThreadMethod);
begin
if Assigned(LastThread) then
LastThread.Synchronize(Method);
end;
function TJvThread.SynchMessageDlg(const Msg: string; AType: TMsgDlgType;
AButtons: TMsgDlgButtons; HelpCtx: Longint): Word;
begin
if Assigned(LastThread) then
Result := LastThread.SynchMessageDlg(Msg, AType, AButtons, HelpCtx)
else
Result := 0;
end;
function TJvThread.Execute(P: Pointer): THandle;
var
BaseThread: TJvBaseThread;
begin
Result := 0;
if Exclusive and OneThreadIsRunning then
Exit;
if Assigned(FOnExecute) then
begin
Inc(FThreadCount);
BaseThread := TJvBaseThread.Create(Self, FOnExecute, P);
try
BaseThread.FreeOnTerminate := FFreeOnTerminate;
BaseThread.OnTerminate := DoTerminate;
FThreads.Add(BaseThread);
DoCreate;
except
BaseThread.Free;
raise;
end;
if FRunOnCreate then
begin
BaseThread.Resume;
CreateThreadDialogForm;
end;
Result := BaseThread.ThreadID;
end;
end;
procedure TJvThread.ExecuteAndWait(P: Pointer);
begin
Execute(P);
while OneThreadIsRunning do
Application.HandleMessage;
end;
function TJvThread.GetPriority(Thread: THandle): TThreadPriority;
begin
{$IFDEF MSWINDOWS}
Result := tpIdle;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
Result := 0;
{$ENDIF UNIX}
if Thread <> 0 then
Result := TThreadPriority(GetThreadPriority(Thread));
end;
procedure TJvThread.SetPriority(Thread: THandle; Priority: TThreadPriority);
begin
SetThreadPriority(Thread, Integer(Priority));
end;
{$IFDEF UNIX}
function TJvThread.GetPolicy(Thread: THandle): Integer;
begin
Result := 0;
if Thread <> 0 then
Result := GetThreadPolicy(Thread);
end;
procedure TJvThread.SetPolicy(Thread: THandle; Policy: Integer);
begin
if Thread <> 0 then
SetThreadPriority(Thread, Policy);
end;
{$ENDIF UNIX}
procedure TJvThread.QuitThread(Thread: THandle);
begin
TerminateThread(Thread, 0);
end;
procedure TJvThread.Suspend(Thread: THandle);
begin
SuspendThread(Thread);
end;
procedure TJvThread.Resume(Thread: THandle);
begin
ResumeThread(Thread);
CreateThreadDialogForm;
end;
procedure TJvThread.DoCreate;
begin
if Assigned(FOnBegin) then
FOnBegin(Self);
end;
procedure TJvThread.DoTerminate(Sender: TObject);
begin
Dec(FThreadCount);
FThreads.Remove(Sender);
try
if Assigned(FOnFinish) then
FOnFinish(Self);
finally
if FThreadCount = 0 then
begin
if Assigned(ThreadDialogForm) then
ThreadDialogForm.Close;
if Assigned(FOnFinishAll) then
FOnFinishAll(Self);
end;
end;
end;
function TJvThread.OneThreadIsRunning: Boolean;
begin
Result := FThreadCount > 0;
end;
procedure TJvThread.Terminate;
var
List: TList;
I: Integer;
begin
List := FThreads.LockList;
try
for I := 0 to List.Count - 1 do
begin
TJvBaseThread(List[I]).Terminate;
if TJvBaseThread(List[I]).Suspended then
TJvBaseThread(List[I]).Resume;
end;
finally
FThreads.UnlockList;
end;
end;
function TJvThread.GetCount: Integer;
var
List: TList;
begin
List := FThreads.LockList;
try
Result := List.Count;
finally
FThreads.UnlockList;
end;
end;
function TJvThread.GetThreads(Index: Integer): TJvBaseThread;
var
List: TList;
begin
List := FThreads.LockList;
try
Result := TJvBaseThread(List[Index]);
finally
FThreads.UnlockList;
end;
end;
function TJvThread.GetTerminated: Boolean;
var
I: Integer;
List: TList;
begin
Result := True;
List := FThreads.LockList;
try
for I := 0 to List.Count - 1 do
begin
Result := Result and TJvBaseThread(List[I]).Terminated;
if not Result then
Break;
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;
intAfterCreateDialogForm(FThreadDialogForm);
if ThreadDialog.DialogOptions.ShowModal then
FThreadDialogForm.ShowModal
else
FThreadDialogForm.Show;
end;
end;
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;
function TJvThread.GetLastThread: TJvBaseThread;
begin
if Count > 0 then
Result := Threads[Count - 1]
else
Result := nil;
end;
procedure TJvThread.intAfterCreateDialogForm(DialogForm: TJvCustomThreadDialogForm);
begin
if Assigned(FAfterCreateDialogForm) then
FAfterCreateDialogForm(DialogForm);
end;
//=== { TJvBaseThread } ======================================================
constructor TJvBaseThread.Create(Sender: TObject; Event: TJvNotifyParamsEvent; Params: Pointer);
begin
inherited Create(True);
FSender := Sender;
FExecuteEvent := Event;
FParams := Params;
end;
procedure TJvBaseThread.ExceptionHandler;
begin
ShowException(FException, FExceptionAddr);
end;
procedure TJvBaseThread.Execute;
begin
try
FExecuteEvent(FSender, FParams);
except
on E: Exception do
begin
FException := E;
FExceptionAddr := ExceptAddr;
Self.Synchronize(ExceptionHandler);
end;
end;
end;
procedure TJvBaseThread.InternalMessageDlg;
begin
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;
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.