unit LongOperations;

interface

uses
	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
	StdCtrls, ComCtrls, ExtCtrls;

type
	TLongOperationForm = class(TForm)
		TextPanel: TPanel;
		OperationName: TLabel;
		Animate: TAnimate;
		ControlPanel: TPanel;
		TerminateButton: TButton;
		procedure FormDestroy(Sender: TObject);
    procedure TerminateButtonClick(Sender: TObject);
	protected
		FTerminated: Boolean;
		procedure CreateParams(var p: TCreateParams); override;
	public
		property Terminated: Boolean read FTerminated;
	end;

var
	LongOperationMode: (lomFree, lomHide, lomNone) = lomFree;
	LongOperationForm: TLongOperationForm = nil;

	procedure BeginLongOperation(aWithTerminateButton: Boolean = False);
	procedure BeginLongOperationText(const s: String; aWithTerminateButton: Boolean = False);
	procedure BeginLongOperationFmt(const s: String; const args: array of const; aWithTerminateButton: Boolean = False);
	function  LongOperationTerminated: Boolean;
	procedure LongOperationText(const s: String);
	procedure LongOperationFmt(const s: String; const args: array of const);
	procedure ProcessLongOperation;
	procedure EndLongOperation;
	procedure SetLongOperationParentWnd(aWnd: HWND);

	function IsInLongOperations: Boolean;

implementation

{$R *.DFM}

const
	ProcessMessagesIntervalInMSec = 500;

var
	NameStack: TStringList = nil;
	FParentWnd: HWND = 0;
	FLastProcessMessagesTime: Double;

procedure BeginLongOperation(aWithTerminateButton: Boolean = False);
begin
	if LongOperationMode = lomNone then
		Exit;

	if not Assigned(LongOperationForm) then begin
		LongOperationForm := TLongOperationForm.Create(Application);
		if aWithTerminateButton then begin
			LongOperationForm.ClientHeight := LongOperationForm.ClientHeight + LongOperationForm.ControlPanel.Height;
			LongOperationForm.ControlPanel.Visible := True;
			LongOperationForm.TerminateButton.Enabled := True;
			LongOperationForm.ActiveControl := LongOperationForm.TerminateButton;
		end;
	end;

	NameStack.Add(LongOperationForm.OperationName.Caption);
	if NameStack.Count = 1 then
		with LongOperationForm do begin
			OperationName.Caption := '';
			Animate.Active := True;
			Show;
		end;
end;

procedure EndLongOperation;
var
	s: String;
begin
	if LongOperationMode = lomNone then
		Exit;

	if not Assigned(LongOperationForm) or (NameStack.Count = 0) then
		Exit;

	s := NameStack[NameStack.Count - 1];
	NameStack.Delete(NameStack.Count - 1);
	if NameStack.Count = 0 then begin
		LongOperationForm.Animate.Active := False;
		if LongOperationMode = lomFree then begin
			LongOperationForm.Free
		end
		else begin
			LongOperationForm.Hide;
		end;
	end
	else begin
		LongOperationForm.OperationName.Caption := s;
	end;
end;

function IsInLongOperations: Boolean;
begin
	Result := Assigned(LongOperationForm) and
		LongOperationForm.Visible;
end;


procedure ProcessLongOperation;
var
	aCurrentTime: TDateTime;
begin
	if LongOperationMode = lomNone then
		Exit;

	aCurrentTime := Time;
	if Frac(Time - FLastProcessMessagesTime) > ProcessMessagesIntervalInMSec/(24*60*60*1000) then begin
		FLastProcessMessagesTime := aCurrentTime;
		Application.ProcessMessages;
	end;
end;


procedure LongOperationText(const s: String);
begin
	if LongOperationMode = lomNone then
		Exit;
		
	if not Assigned(LongOperationForm) or (NameStack.Count = 0) then
		Exit;

	with LongOperationForm do begin
		OperationName.Caption := s;
		Show;
		Update;
	end;
	ProcessLongOperation;
end;

procedure LongOperationFmt(const s: String; const args: array of const);
begin
	if LongOperationMode = lomNone then
		Exit;
		
	LongOperationText(Format(s, args));
end;

procedure BeginLongOperationText(const s: String; aWithTerminateButton: Boolean = False);
begin
	if LongOperationMode = lomNone then
		Exit;

	BeginLongOperation(aWithTerminateButton);
	LongOperationText(s);
end;

procedure BeginLongOperationFmt(const s: String; const args: array of const; aWithTerminateButton: Boolean = False);
begin
	if LongOperationMode = lomNone then
		Exit;
	BeginLongOperation(aWithTerminateButton);
	LongOperationFmt(s, args);
end;

procedure TLongOperationForm.CreateParams(var p: TCreateParams);
begin
	inherited;
	if FParentWnd <> 0 then
		p.WndParent := FParentWnd;
end;

procedure TLongOperationForm.FormDestroy(Sender: TObject);
begin
	if LongOperationForm = Self then
		LongOperationForm := nil;
end;

procedure SetLongOperationParentWnd(aWnd: HWND);
begin
	if aWnd <> FParentWnd then begin
		FreeAndNil(LongOperationForm);
		FParentWnd := aWnd
	end;
end;

function LongOperationTerminated: Boolean;
begin
	Result := not Assigned(LongOperationForm) or not LongOperationForm.Visible or
		LongOperationForm.Terminated;
end;

procedure TLongOperationForm.TerminateButtonClick(Sender: TObject);
begin
	if FTerminated then
		Exit;

	FTerminated := Application.MessageBox('Операция будет прервана. Завершить?', 'Предупреждение',
		MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2) = ID_YES;
end;

initialization
	NameStack := TStringList.Create;
finalization
	NameStack.Free;
end.
