{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       Progress dialog class (VCL)                     }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 25 Feb 2011                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrprogressdlg;
interface
uses  windows, classes;

  procedure ProgressShow(aMsg:string);
  procedure ProgressHide;

implementation
Uses sysutils, messages, nrwin32 {$IFNDEF GEN6}, forms{$ENDIF};

{$R '..\Res\nrprogressdlg.res'}

Const
  ID_DIALOG_RES           = 103;
  ID_DIALOG_PROGRESS_BAR  = 1001;
  ID_DIALOG_TEXT          = 1002;

  PBS_MARQUEE             = $08;
  PBM_SETMARQUEE          = (WM_USER + 10);

Type
  TnrProgreesssThread = class(TThread)
  private
    hWndProgress : dword;
    fMsg:string;
  public
    constructor Create(aMsg:string);
    procedure Terminate;
    procedure Execute; override;
    procedure UpdateText(aMsg:string);
  end;

Var
  threadProgress:TnrProgreesssThread = nil;

constructor TnrProgreesssThread.Create(aMsg:string);
begin
  inherited Create(True);
  FreeOnTerminate := True;
  fMsg := aMsg;
  Resume;
end;

procedure TnrProgreesssThread.Terminate;
begin
  PostMessage(hWndProgress, WM_CLOSE, 0,0);
end;

procedure TnrProgreesssThread.UpdateText(aMsg:string);
begin
  fMsg := aMsg;
  SetDlgItemText(hWndProgress, ID_DIALOG_TEXT, PChar(aMsg));
end;

function WinProc(hWnd:DWORD; uMsg:DWORD; wParam:DWORD; lParam:DWORD):DWORD; stdcall;
begin
  Result := 0;
  case uMsg of
    WM_INITDIALOG: begin
      TnrProgreesssThread(lParam).hWndProgress := hWnd;
      if IsManifestAvailable
        then PostMessage(GetDlgItem(hWnd, ID_DIALOG_PROGRESS_BAR), PBM_SETMARQUEE, 1, 100)
        else PostMessage(GetDlgItem(hWnd, ID_DIALOG_PROGRESS_BAR), WM_CLOSE, 0,0);
      SetDlgItemText(hWnd, ID_DIALOG_TEXT, PChar(TnrProgreesssThread(lParam).fMsg));
    end;
    WM_CLOSE: EndDialog(hWnd,0);
  end;
end;

procedure TnrProgreesssThread.Execute;
var hParent:dword;
begin
  hParent := AllocateHWnd(nil);
  DialogBoxParam(HInstance, PChar(ID_DIALOG_RES), hParent, @WinProc , Dword(Self));
  DeallocateHWnd(hParent);
end;

procedure ProgressShow(aMsg:string);
begin
  if threadProgress = nil
    then threadProgress := TnrProgreesssThread.Create(aMsg)
    else threadProgress.UpdateText(aMsg);
end;

procedure ProgressHide;
begin
  if threadProgress = nil then exit;
  try
    TnrProgreesssThread(threadProgress).Terminate;
  finally
    threadProgress := nil;
  end;

end;

initialization
finalization
  ProgressHide;

end.
