Windows Progress Dialog Wrapper

[himitsu]

Delphi-Quellcode:

function Execute(ParentWindow: TWinControl): Boolean; overload;
function Execute(ParentWindow: HWND = 0):    Boolean; overload;

So kann man jetzt Self (die Form), Self.Handle (HWND), nil, 0 oder nichts übergeben ... wie man will.

Delphi-Quellcode:

function TdxProgressDialog.Execute(ParentWindow: TWinControl): Boolean;
begin
  if Assigned(ParentWindow) then
    Result := Execute(ParentWindow.Handle)
  else
    Result := Execute(0);
end;

function TdxProgressDialog.Execute(ParentWindow: HWND): Boolean;
var
  DialogFlags: DWord;
begin
  if ParentWindow = 0 then
    ParentWindow := FParentWindow;
  if ParentWindow = 0 then
    ParentWindow := Application.Handle;
  Result := False;
  //if Assigned(FDialog) then  // Close prüft ja selber nochmal auf Assigned
    Close;  // Exit war nicht so schön
  FDialog := CreateComObject(CLASS_ProgressDialog) as IProgressDialog;
  if Assigned(FDialog) then
  begin
    DialogFlags := PROGDLG_NORMAL;
    if FShowModal then
      DialogFlags := DialogFlags or PROGDLG_MODAL;
    if not FShowProgressBar then
      DialogFlags := DialogFlags or PROGDLG_NOPROGRESSBAR
    else
      if FMarqueeProgressBar then
        DialogFlags := DialogFlags or PROGDLG_MARQUEEPROGRESS;
    if FShowRemainingTime then
      DialogFlags := DialogFlags or PROGDLG_NOTIME
    else
      if FAutoCalcRemainingTime then
        DialogFlags := DialogFlags or PROGDLG_AUTOTIME;
    if not FAllowMinimize then
      DialogFlags := DialogFlags or PROGDLG_NOMINIMIZE;
    if not FAllowCancel then
      DialogFlags := DialogFlags or PROGDLG_NOCANCEL;
    Result := (FDialog.StartProgressDialog(ParentWindow, nil, DialogFlags, Pointer(nil^)) = S_OK);
    Result := Result and (FDialog.SetTitle(PChar(FTitle)) = S_OK);
    if (FAVIInstance > 0) then
      Result := Result and (FDialog.SetAnimation(FAVIInstance, FAVIResourceID) = S_OK);
    if FTextLine1 <> '' then
      Result := Result and (FDialog.SetLine(1, PChar(FTextLine1), 0, Pointer(nil^)) = S_OK);
    if FTextLine2 <> '' then
      Result := Result and (FDialog.SetLine(2, PChar(FTextLine2), 0, Pointer(nil^)) = S_OK);
    if FTextLine3 <> '' then
      Result := Result and (FDialog.SetLine(3, PChar(FTextLine3), 0, Pointer(nil^)) = S_OK);
    if FCancelMessage <> '' then
      Result := Result and (FDialog.SetCancelMsg(PChar(FCancelMessage), Pointer(nil^)) = S_OK);
  end;
end;

Und wenn du bei StartProgressDialog und Co. wieso nil übergibst, dann deklariere es besser als pvResevered: PPointer {ohne var} und übergib ein Richtiges nicht soein "gahacktes" NIL.

Und hast du mal versucht mehr als einmal einen Dialog, mit der selben Komponenten-Instanz, anzuzeigen?
Ich glaube nicht.

Wenn der Dialog ausgeblendet wird, sollte FDialog auch freigegeben werden und das nicht erst im Destroy.

Delphi-Quellcode:

procedure TdxProgressDialog.Cancel;
begin
  if Assigned(FDialog) then
    Check(FDialog.StopProgressDialog);
  FDialog := nil;
end;

Delphi-Quellcode:

procedure TdxProgressDialog.Cancel;
begin
  if Assigned(FDialog) then
    Check(FDialog.StopProgressDialog);
end;

Delphi-Quellcode:

procedure TdxProgressDialog.Check(Result: HRESULT);
begin
  if Result <> S_OK then
    RaiseLastOSError(Result);
end;

Allerdings finde ich auch noch das Boolean bein Execute eher unschön.
Das Ding muß sowieso angezeigt werden, oder was Schlimmes stimmt nicht.
Also entweder du speicherst intern selber in sowas wie LastError das erste HRESULT mit <> S_OK, welches innerhalb von Execute auftritt,
oder du läßt das Boolean besser weg und rufst ebenfalls jeweils das Check auf.
"Fehler" (False) ist eine besch* Fehlermeldung ... ich würde da ganz gerne auch wissen wollen WAS, bzw. WARUM es nicht geht.

[Edit]
Das mit dem Cancel war blöd ... es fehlt ein Close.

Delphi-Quellcode:

procedure TdxProgressDialog.Close;
begin
  FDialog := nil;
  // :=nil sollte doch ausreichen, um den dialog auszublenden?
  // oder vielleicht doch besser noch vor dem FDialog:=nil; ein Cancel; aufrufen.
end;

PS:
Man kann sich das Leben auch schwerer machen, als nötig.
(und wenn wirklich mal jemand so krankhaft bescheuert sein sollte und global im ganzen Projekt die vollständige boolische Auswertung aktiviert ... selber Schuld)

Delphi-Quellcode:

function TdxProgressDialog.HasUserCanceled: Boolean;
begin
  Result := FAllowCancel and Assigned(FDialog) and FDialog.HasUserCancelled;
end;

function TdxProgressDialog.Execute(ParentWindow: HWND): Boolean;
var
  DialogFlags: DWord;
begin
  if ParentWindow = 0 then
    ParentWindow := FParentWindow;
  if ParentWindow = 0 then
    ParentWindow := Application.Handle;
  Result := False;
  Close;
  FDialog := CreateComObject(CLASS_ProgressDialog) as IProgressDialog;
  if not Assigned(FDialog) then
    RaiseLastOSError(E_NOINTERFACE);
  DialogFlags := PROGDLG_NORMAL;
  if FShowModal then
    DialogFlags := DialogFlags or PROGDLG_MODAL;
  if not FShowProgressBar then
    DialogFlags := DialogFlags or PROGDLG_NOPROGRESSBAR
  else
    if FMarqueeProgressBar then
      DialogFlags := DialogFlags or PROGDLG_MARQUEEPROGRESS;
  if FShowRemainingTime then
    DialogFlags := DialogFlags or PROGDLG_NOTIME
  else
    if FAutoCalcRemainingTime then
      DialogFlags := DialogFlags or PROGDLG_AUTOTIME;
  if not FAllowMinimize then
    DialogFlags := DialogFlags or PROGDLG_NOMINIMIZE;
  if not FAllowCancel then
    DialogFlags := DialogFlags or PROGDLG_NOCANCEL;
  Check(FDialog.StartProgressDialog(ParentWindow, nil, DialogFlags, nil));
  Check(FDialog.SetTitle(PChar(FTitle)));
  if FAVIInstance > 0 then
    Check(FDialog.SetAnimation(FAVIInstance, FAVIResourceID));
  if FTextLine1 <> '' then
    Check(FDialog.SetLine(1, PChar(FTextLine1), 0, nil));
  if FTextLine2 <> '' then
    Check(FDialog.SetLine(2, PChar(FTextLine2), 0, nil));
  if FTextLine3 <> '' then
    Check(FDialog.SetLine(3, PChar(FTextLine3), 0, nil));
  if FCancelMessage <> '' then
    Check(FDialog.SetCancelMsg(PChar(FCancelMessage), nil));
end;

Ach ja, abgesehn von ParentWindow sollten der letzte Public-Block wohl eher ein Published sein.
Ansonsten kann man das TComponente als Vorfahr garnicht ausnutzen, denn es ließe sich zwar auf die Form pappen, aber einstellen könnte man dort nicht viel.

Und deine TdxProgressDialog ist nicht für Delphis bis D2009 geeignet, da das Interface mit Unicode deklariert ist, aber dort String und PChar kein Unicode sind, was dann nicht mehr zusammenpaßt.
Deklarier dir einfach eigene "String"- und "PChar"-Typen, welche ab D2009 string und PChar oder UnicodeString und PWideChar bleiben, aber bis D2007 als WideString und PWideChar deklariert sind.



[add] Bezüglich des Unicode:
Wenn man voll krank drauf ist, dann geht auch sowas:

Delphi-Quellcode:

  IProgressDialog = interface(IUnknown)
    ['{EBBC7C04-315E-11D2-B62F-006097DF5BD4}']
    function StartProgressDialog(hwndParent: HWND; const punkEnableModless: IUnknown; dwFlags: DWord; pvResevered: PPointer): HResult; stdcall;
    function StopProgressDialog: HResult; stdcall;
    function SetTitle(const pwzTitle: WideString): HResult; stdcall;
    function SetAnimation(hInstAnimation: Integer; idAnimation: Integer): HResult; stdcall;
    function HasUserCancelled: BOOL; stdcall;
    function SetProgress(dwCompleted: Integer; dwTotal: Integer): HResult; stdcall;
    function SetProgress64(ullCompleted: Currency; ullTotal: Currency): HResult; stdcall;
    function SetLine(dwLineNum: Integer; const pwzString: WideString; fCompactPath: Integer; pvResevered: PPointer): HResult; stdcall;
    function SetCancelMsg(const pwzCancelMsg: WideString; pvResevered: PPointer): HResult; stdcall;
    function Timer(dwTimerAction: DWord; pvResevered: PPointer): HResult; stdcall;
  end;

Allerdings nur für ReadOnly-PWideChar-Parameter, denn in dieser Richtung sind UnicodeString und WideString kompatibel
und womöglich statt dem WideString eben den eigenen "Unicode"-String-Typen, für die Performance.

[noch'n ADD]

Delphi-Quellcode:

  TdxProgressDialog = class(TObject)
  private
    FTextLine: array[1..3] of String;
    function  GetTextLine(Index: Integer): String;
    procedure SetTextLine(Index: Integer; const Value: String);
  published
    property TextLine1: String index 1 read GetTextLine write SetTextLine;
    property TextLine2: String index 2 read GetTextLine write SetTextLine;
    property TextLine3: String index 3 read GetTextLine write SetTextLine;
    //property TextLine[Index: Integer]: String read GetTextLine write SetTextLine;  // und im Code den Index prüfen
  end;

procedure TdxProgressDialog.SetTextLine(Index: Integer; const Value: String);
begin
  FTextLine[Index] := Value;
  if Assigned(FDialog) then
    FDialog.SetLine(Index, PChar(FTextLine[Index]), 0, nil);
end;

PS: Monitore sind heutzutage meist nicht mehr 15" ... Tools > Optionen > Editor-Optionen > Anzeige > rechter Rand z.B. mindestens auf 120 stellen.
(120 = FullHD + links und rechts OI, Tool-Palette, Projektionen usw.)