initial commit from lost SVN repo

common/frmprogress.pas

@@ -0,0 +1,198 @@
+{
+********************************************************************************
+
+SPackGui (common files)
+Copyright (C) 2007-2013 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
+Copyright (C) <date> <add your name and mail address here>
+
+http://0.tuxfamilly.org/
+http://www.geoffray-levasseur.org/
+
+This software is governed by the CeCILL license under French law and
+abiding by the rules of distribution of free software.  You can  use,
+modify and/ or redistribute the software under the terms of the CeCILL
+license as circulated by CEA, CNRS and INRIA at the following URL
+"http://www.cecill.info".
+
+As a counterpart to the access to the source code and  rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty  and the software's author,  the holder of the
+economic rights,  and the successive licensors  have only  limited
+liability.
+
+In this respect, the user's attention is drawn to the risks associated
+with loading,  using,  modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean  that it is complicated to manipulate,  and  that  also
+therefore means  that it is reserved for developers  and  experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or
+data to be ensured and,  more generally, to use and operate it in the
+same conditions as regards security.
+
+The fact that you are presently reading this means that you have had
+knowledge of the CeCILL license and that you accept its terms.
+
+********************************************************************************
+
+Description:
+  progression dialog (this is standard and can be reused easyly)
+
+********************************************************************************
+}
+unit frmProgress;
+
+{$include defines.inc}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  ComCtrls, Buttons;
+
+type
+
+  { TfProgress }
+
+  TfProgress = class(TForm)
+    btnCancel: TBitBtn;
+    lbProgressionMessage: TLabel;
+    lbProgressionMessage2: TLabel;
+    ProgressBar: TProgressBar;
+    ProgressBar2: TProgressBar;
+    procedure btnCancelClick(Sender: TObject);
+    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
+    procedure FormCreate(Sender: TObject);
+  private
+    { private declarations }
+    FCanCancel: Boolean;
+    FCancelPressed: Boolean;
+    FDoubleBar: Boolean;
+    procedure SetCanCancel(const Value: Boolean);
+    procedure SetDoubleBar(const Value: Boolean);
+  public
+    { public declarations }
+    constructor Create(TheOwner: TComponent); override;
+    property CancelPressed: Boolean read FCancelPressed default False;
+    property CanCancel: Boolean read FCanCancel write SetCanCancel default True;
+    property DoubleBar: Boolean read FDoubleBar write SetDoubleBar
+      default False;
+    procedure ForceCancel; //this force a cancel pressed event despite CanCancel state
+    procedure CancelCancellation;
+  end;
+
+
+function CreateProgress(const Title, Message: string;
+  const Min, Max: integer): TfProgress;
+
+function CreateProgress(const Title, Msg1, Msg2: string;
+  const Min1, Max1, Min2, Max2: integer): TfProgress;
+
+
+implementation
+
+{$R *.lfm}
+
+uses
+  uIconManager;
+
+resourcestring
+  rsExceptNotCancelled = 'The expected "Cancel" event was not triggered.';
+
+{ TfProgress }
+
+function CreateProgress(const Title, Message: string;
+  const Min, Max: integer): TfProgress;
+begin
+  Result := TfProgress.Create(Application);
+  Result.lbProgressionMessage.Caption := Message;
+  Result.Caption := Title;
+  Result.ProgressBar.Min := Min;
+  Result.ProgressBar.Max := Max;
+  Result.ProgressBar.Position := Min;
+end;
+
+
+function CreateProgress(const Title, Msg1, Msg2: string;
+  const Min1, Max1, Min2, Max2: integer): TfProgress;
+begin
+  Result := CreateProgress(Title, Msg1, Min1, Max1);
+  Result.DoubleBar := True;
+  Result.lbProgressionMessage2.Caption := Msg2;
+  Result.ProgressBar2.Min := Min2;
+  Result.ProgressBar2.Max := Max2;
+  Result.ProgressBar2.Position := Min2;
+end;
+
+
+constructor TfProgress.Create(TheOwner: TComponent);
+begin
+  inherited Create(Owner);
+  SetDoubleBar(False);
+end;
+
+
+procedure TfProgress.SetDoubleBar(const Value: Boolean);
+begin
+  if Value then
+  begin
+    Height := 166;
+    btnCancel.Top := 128;
+    lbProgressionMessage2.Visible := True;
+    ProgressBar2.Visible := True;
+  end else
+  begin
+    Height := 103;
+    btnCancel.Top := 64;
+    lbProgressionMessage2.Visible := False;
+    ProgressBar2.Visible := False;
+  end;
+  FDoubleBar := Value;
+end;
+
+
+procedure TfProgress.SetCanCancel(const Value: Boolean);
+begin
+  FCanCancel := Value;
+  btnCancel.Enabled := FCanCancel;
+end;
+
+procedure TfProgress.ForceCancel;
+begin
+  FCancelPressed := True;
+end;
+
+procedure TfProgress.CancelCancellation;
+begin
+  if FCancelPressed then
+    FCancelPressed := False
+  else
+    Exception.Create(rsExceptNotCancelled);
+end;
+
+procedure TfProgress.FormCreate(Sender: TObject);
+begin
+  inherited;
+  try
+    btnCancel.Tag := icCancel;
+    InitBtnGlyphs(Self);
+  finally
+    FCancelPressed := False;
+  end;
+end;
+
+procedure TfProgress.btnCancelClick(Sender: TObject);
+begin
+  if FCanCancel then
+    FCancelPressed := True;
+end;
+
+procedure TfProgress.FormCloseQuery(Sender: TObject; var CanClose: boolean);
+begin
+  CanClose := False; //this window can't be closed manually
+  if FCanCancel then
+    fCancelPressed := True; //...but this is equivalent to a cancel event
+end;
+
+end.