Windows Progress Dialog Wrapper

[Zacherl]

Hallo zusammen,

ich habe mal einen kleinen Wrapper um den Standard Progress Dialog von Windows gebastelt. Die Bedienung sollte komplett selbsterklärend sein.


Der Dialog unterstüzt sowohl die normale, als auch eine marquee (ab Vista) ProgressBar.

Während der Dialog aktiv ist, können über die entsprechenden Properties sämtliche Texte modifiziert werden. Der Fortschritt wird über die SetProgress() Funktion aktualisiert. Während des Tasks sollte periodisch auf HasUserCanceled() geprüft werden. Diese Funktion gibt true zurück, wenn der Anwender den Abbrechen Button betätigt hat.

PS: Application.ProgressMessages nicht vergessen, fals euer Task im Hautpthread ausgeführt wird. Ansonsten hat der Anwender keine Möglichkeit zur Interaktion mit dem Dialog.

Viele Grüße
Zacherl

[uligerhardt]

Hallo, Zacherl,

danke für die Unit!

Ich hab mir als Test mal Folgendes zusammengeklatscht:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
const
  cCount = 1000;
var
  dlg: TdxProgressDialog;
  i: Integer;
begin
  dlg := TdxProgressDialog.Create(nil);
  try
    dlg.Title := 'Zählen';
    dlg.TextLine1 := 'Zähle bis ' + IntToStr(cCount);
    dlg.Execute(Handle);
    for i := 1 to cCount do
    begin
      dlg.TextLine2 := 'Bin bei ' + IntToStr(i);
      dlg.SetProgress(i, cCount);
      Application.ProcessMessages;
      Sleep(1);
      if dlg.HasUserCanceled then
        Exit;
    end;
  finally
    dlg.Free;
  end;
end;

Dabei sind mir (unter Windows 8) zwei Probleme aufgefallen:

1. Auf Buttonklick stürzt das Programm ab. Ich hab das durch   if Assigned(AOwner) and AOwner.InheritsFrom(TWinControl) then in Zeile 149 deiner Unit behoben.
2. Wenn der Zähler durchgelaufen ist, "versteckt" sich Form1 hinter dem Fenster, das als nächstes in der Z-Order kommt - also z.B. hinter Delphi, wenn man's aus der IDE heraus startet.

Edit: Wenn ich mich nicht täusche, ist ein LPCVOID einfach ein Pointer . Also würde ich die ganzen var pvResevered: Pointer mal durch pvReserved: Pointer ersetzen. Und in den entsprechenden Aufrufen das Pointer(nil^) durch nil . (Das lässt bei mir auch gleich den Würgereflex besser werden. )

[Zacherl]

Hallo ulligerhard,

danke für dein Feedback. Der Assigned() Check ist an dieser Stelle natürlich sehr wichtig!

Zum Problem mit dem Verschwinden des Fensters kann ich leider nicht viel sagen. Habe dieses Verhalten selbst ein paar Mal beobachtet. Wenn man ein allerdings konkretes ParentWindow spezifiziert, kann man das Problem umgehen.

Viele Grüße
Zacherl

[sx2008]

Mit dem Konstruktor stimmt was nicht.
Die Klasse täuscht vor eine Komponente zu sein, weil sie ein Owner-Objekt im Konstruktor entgegennimmt aber es handelt sich um eine von TObject abgeleitete Klasse.
Was die Klasse eigentlich haben möchte ist ein Parent-Window-Handle.

Daher müsste der Konstruktor so aussehen:
constructor Create(AParentWindow: HWND=0); Der Datentyp HWND zeigt, dass ein Window-Handle erwartet wird.

[Zacherl]

Ja stimmt, das könnte man ggfls. ändern. Ich lade morgen mal eine angepasste Version der Unit hoch.

[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.)

[uligerhardt]

Zitat von himitsu:

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.

Ich denke, auch du hast eine Indirektion zuviel. Das ist weder Referenz auf Zeiger noch Zeiger auf Zeiger, sondern einfach Zeiger - siehe den letzten Absatz in meiner ersten Antwort.

Zitat von himitsu:

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)

Shit happens.

Zitat von himitsu:

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.

Ist ja keine Komponente, sondern nur ein TObject . Da kannste publishen, bis du schwarz wirst.

Zitat von himitsu:

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.

Hab ich grad gemerkt, als ich es mal mit D2007 ausprobieren wollte. Ich hab jetzt mal alle PChar durch PWideChar und alle string durch ein typedef auf WideString ersetzt, dann läuft's.

[uligerhardt]

Zitat von Zacherl:

Zum Problem mit dem Verschwinden des Fensters kann ich leider nicht viel sagen. Habe dieses Verhalten selbst ein paar Mal beobachtet. Wenn man ein allerdings konkretes ParentWindow spezifiziert, kann man das Problem umgehen.

Ich setze ja ein ParentWindow: dlg.Execute(Handle); . Das Problem ist übrigens unter Windows 7 genauso da. Und zwar bei jedem Lauf meiner Testanwendung. Ich vermute mal, dass das ein Problem von IProgressDialog ist, nicht von deinem Wrapper.

[Zacherl]

Oh man, ich sollte wirklich nicht mehr programmieren, wenn ich länger als 24h wach war

Zitat von himitsu:

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

Das wollte ich nicht, da dann ja nicht mehr auf HasUserCanceled zugegriffen werden kann. Aber dein korrigierter Code umgeht das Problem ja ganz geschickt.

Zitat von himitsu:

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.

Ist ja auch von TObject abgeleitet und war nicht als visuelle Komponente geplant.

Zitat von himitsu:

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.)

Mein Notebook, auf dem ich teilweise arbeite, hat nur 17", deshalb lasse ich die Randeinstellung normalerweise auf default

Edit: Habe mal ein paar der Änderungsvorschläge umgesetzt. Cancel() war vielleicht etwas irreführend. Diese Methode habe ich in Close() umbenannt, da es prinzipiell gar keine Möglichkeit gibt den Dialog ohne den Cancel Button abzubrechen.