Delphi-PRAXiS
Seite 6 von 6   « Erste     456   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   "Unendlicher Progressbar" (https://www.delphipraxis.net/204857-unendlicher-progressbar.html)

himitsu 10. Jul 2020 18:23

AW: "Unendlicher Progressbar"
 
Bei der Variante "im Timer anzeigen was der Thread macht" schon. :stupid:

Benmik 10. Jul 2020 18:40

AW: "Unendlicher Progressbar"
 
Die Variante "eine langdauernde Operation muss unbedingt im MainThread laufen" ist offenbar äußerst blöd. Mir scheint, entweder man greift zu furchtbaren Verrenkungen oder man sendet einfach abschnittsweise aus dem MainThread. Mir persönlich wären die Verrenkungen für eine schlichte Anwenderinformation zu aufwändig.

himitsu 10. Jul 2020 21:50

AW: "Unendlicher Progressbar"
 
Ja ist blöd, ohne regelmäßig etwas Zeit der VCL zu geben, um sich zu aktualisieren und Messages zu verarbeiten.

Gennauso unpraktisch, wie letztens mal jemand es machte.
* im Thread arbeiten, aber praktisch alles dort wurde via Synchronize im Haupthtread ausgeführt, was dann ebenfalls diesen extrem überlastete, ohne dass der Thread was zu tun hatte.
* Ergebnis war dass es langsamer war, durch die masse an Synchronisierungen, und der Hauptthread ebenfalls hing, weil viele der Einzelschritte zu lang waren

Jumpy 13. Jul 2020 08:48

AW: "Unendlicher Progressbar"
 
Nur nochmal zur Klarstellung: Es geht um das Starten der Anwendung? Oder geht es um Prozesse innerhalb der Anwendung, wo nach einem Button-Klick irgendwas passieren soll?

philipp.hofmann 13. Jul 2020 12:41

AW: "Unendlicher Progressbar"
 
Zur Timer-Variante:
Zitat:

und den Zugriff auf diese Variablen müsste man dennoch synchronisieren
Da es "nur" um die Status-Anzeige geht, sichere ich die Abfrage und Aktualisierungen mit try-catch ab.
Wenn dann mal ein Status-Update daneben geht, ist nicht weiter tragisch.
Aber natürlich geht dies nur, wenn der Hauptthread an sich "Zeit" hat, damit der Timer feuern kann.

jaenicke 13. Jul 2020 13:11

AW: "Unendlicher Progressbar"
 
Mein Vorschlag von oben mit einem Fenster im Thread zur Statusanzeige wie mit den verlinkten Komponenten wird übrigens auch von Notepad++ und anderen so verwendet. Dort hängt das restliche Hauptfenster ebenfalls, in dem Fall bei der Suche in vielen Dateien.

Vor allem müsste dafür am wenigsten geändert werden...

KodeZwerg 17. Jul 2020 11:55

AW: "Unendlicher Progressbar"
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hi, das Thema ist zwar schon ein wenig her, dennoch habe ich mir mal die Mühe gemacht eine kleine Klasse für genau diesen Zweck zu erschaffen, sehr Resourcenschonend da WinApi genutzt wurde.
Also dieser Zweck wird erfüllt: Ein Programm braucht einen "unendlichen" ProgressBar der per Code oder per Dialog auch abgebrochen werden kann, zusätzlich hat man ein Label zur freien Verfügung.

Es wurde TThread und WinApi genutzt um ans Ziel zu kommen, plus Resource Dialoge als Anzeige.


Hier ist der Quelltext der Klasse, im Download ist der Source kommentiert.
Delphi-Quellcode:
(*
example usage:
uses
  kzSplashBar;

procedure TForm1.FormCreate(Sender: TObject);
var
  sb: TSplashBar;
begin
  sb := TSplashBar.Create(Handle, 'example SplashBar Caption', True);
  Sleep(5000); // simulate a blocking main thread
  sb.Terminate;
end;
*)

unit kzSplashBar;

interface

uses
  Winapi.Windows, Winapi.Messages, Winapi.CommCtrl, System.Classes
  ;

type
  TSplashBar = class(System.Classes.TThread)
  private
    FhDlg: HWND;
    FMarqueeSpeed: Integer;
    FLabelCaption: string;
    FButtonCaption: string;
    FShowButton: Boolean;
    FMarqueeMode: Boolean;
    FParentHandle: HWND;
    FAborted: Boolean;
    FFlash: Boolean;
    FForeGround: Boolean;
  protected
    procedure Execute; override;
    procedure ShowSplashBar;
    procedure SetMarqueeSpeed(const ASpeed: Integer);
    procedure SetLabelCaption(const ACaption: string);
    procedure SetButtonCaption(const ACaption: string);
    function SetCaption(const AControlId: Cardinal; const ACaption: string): Boolean;
  public
    constructor Create(const AParentHandle: HWND; const ALabelCaption: string; const AEnableMarquee: Boolean); overload;
    constructor Create(const AParentHandle: HWND; const ALabelCaption: string; const AButtonCaption: string; const AEnableMarquee: Boolean); overload;
    property MarqueeSpeed: Integer read FMarqueeSpeed write SetMarqueeSpeed;
    property MarqueeMode: Boolean read FMarqueeMode;
    property LabelCaption: string read FLabelCaption write SetLabelCaption;
    property ButtonCaption: string read FButtonCaption write SetButtonCaption;
    property Aborted: Boolean read FAborted;
    property AutoForeGround: Boolean read FForeGround write FForeGround;
    property AutoFlash: Boolean read FFlash write FFlash;
    procedure SetProgressBarColor(const ARed: Byte; const AGreen: Byte; const ABlue: Byte);
    procedure SetProgressBarBkColor(const ARed: Byte; const AGreen: Byte; const ABlue: Byte);
    procedure SetProgressBarRange(const AMax: Integer);
    procedure SetProgressBarPosition(const APosition: Integer);
    procedure SetProgressBarStep;

  end;

implementation

// include needed external resource dialog file
{$R *.res}

const
  IDD_SMOOTH = 1000;
  IDD_MARQUEE = 1001;
  IDD_SMOOTHBUTTON = 1010;
  IDD_MARQUEEBUTTON = 1011;
  IDC_LABEL = 2000;
  IDC_PB = 2001;
  IDC_BUTTON = 2002;

var
  LAborted: Boolean = False;

{ TSplashBar }

constructor TSplashBar.Create(const AParentHandle: HWND; const ALabelCaption: string; const AEnableMarquee: Boolean);
begin
  FShowButton := False;
  FLabelCaption := ALabelCaption;
  FButtonCaption := '';
  FAborted := False;
  LAborted := False;
  FFlash := False;
  FForeGround := False;
  FMarqueeSpeed := 0;
  FParentHandle := AParentHandle;
  FMarqueeMode := AEnableMarquee;
  inherited Create(False);
  FreeOnTerminate := True;
end;

constructor TSplashBar.Create(const AParentHandle: HWND; const ALabelCaption: string; const AButtonCaption: string; const AEnableMarquee: Boolean);
begin
  FShowButton := True;
  FLabelCaption := ALabelCaption;
  FButtonCaption := AButtonCaption;
  FAborted := False;
  LAborted := False;
  FFlash := False;
  FForeGround := False;
  FMarqueeSpeed := 0;
  FParentHandle := AParentHandle;
  FMarqueeMode := AEnableMarquee;
  inherited Create(False);
  FreeOnTerminate := True;
end;

procedure TSplashBar.Execute;
var
  Msg: TMsg;
begin
  ShowSplashBar;
  while ((not Terminated) and
          GetMessage(Msg, FhDlg, 0, 0))) do
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;
  FAborted := LAborted;
  EndDialog(FhDlg, 0);
  if AutoForeGround then
    SetForegroundWindow(FParentHandle);
  if AutoFlash then
    FlashWindow(FParentHandle, BOOL(True));
end;

function TSplashBar.SetCaption(const AControlId: Cardinal; const ACaption: string): Boolean;
begin
  Result := SetWindowText(
              GetDlgItem(FhDlg, AControlId),
              PChar(ACaption)
            );
end;

procedure TSplashBar.SetMarqueeSpeed(const ASpeed: Integer);
begin
  if (ASpeed >= 0) then
    begin
      FMarqueeSpeed := ASpeed;
      SendDlgItemMessage(FhDlg, IDC_PB, PBM_SETMARQUEE, 1, FMarqueeSpeed);
    end;
end;

procedure TSplashBar.SetProgressBarColor(const ARed: Byte; const AGreen: Byte; const ABlue: Byte);
begin
  SendDlgItemMessage(FhDlg, IDC_PB, PBM_SETBARCOLOR, 1, RGB(ARed, AGreen, AGreen));
end;

procedure TSplashBar.SetProgressBarBkColor(const ARed: Byte; const AGreen: Byte; const ABlue: Byte);
begin
  SendMessage(GetDlgItem(FhDlg, IDC_PB), PBM_SETBKCOLOR, 1, RGB(ARed, AGreen, AGreen));
end;

procedure TSplashBar.SetProgressBarRange(const AMax: Integer);
begin
  SendMessage(GetDlgItem(FhDlg, IDC_PB), PBM_SETRANGE32, 0, AMax);
  SendMessage(GetDlgItem(FhDlg, IDC_PB), PBM_SETRANGE, 0, MakeLParam(0, AMax));
  SendMessage(GetDlgItem(FhDlg, IDC_PB), PBM_SETSTEP, WPARAM(AMax div 10), 0);
end;

procedure TSplashBar.SetProgressBarPosition(const APosition: Integer);
begin
  SendMessage(GetDlgItem(FhDlg, IDC_PB), PBM_SETPOS, APosition, 0);
end;

procedure TSplashBar.SetProgressBarStep;
begin
  SendMessage(GetDlgItem(FhDlg, IDC_PB), PBM_STEPIT, 0, 0);
end;

procedure TSplashBar.SetLabelCaption(const ACaption: String);
begin
  FLabelCaption := ACaption;
  SetCaption(IDC_LABEL, FLabelCaption);
end;

procedure TSplashBar.SetButtonCaption(const ACaption: string);
begin
  if FShowButton then
    begin
      FButtonCaption := ACaption;
      SetCaption(IDC_BUTTON, FButtonCaption);
     end;
end;

function DlgFunc(hWin: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): bool; stdcall;
begin
  Result := BOOL(False);
  case uMsg of
    WM_CREATE:
      begin
      end; // WM_CREATE

    WM_INITDIALOG:
      begin
      end; // WM_INITDIALOG

    WM_ACTIVATE:
      begin
      end; // WM_ACTIVATE

    WM_LBUTTONDOWN:
      begin
        Result := BOOL(DefWindowProc(hWin, uMsg, wp, lp));
        PostMessage(hWin, WM_SYSCOMMAND, $f012, 0);
      end; // WM_LBUTTONDOWN

    WM_PAINT, WM_NCPAINT, WM_NCACTIVATE:
      begin
        InvalidateRect(hWin, nil, True);
      end; // WM_PAINT, WM_NCPAINT, WM_NCACTIVATE

    WM_SIZE:
      begin
        MoveWindow(hWin, 0, HiWord(lp), LOWORD(lp), HiWord(lp), True);
      end; // WM_SIZE

    WM_COMMAND: // react on controls command, like buttons or checkboxes etc may invoke
      begin
        case LoWord(wp) of // what shall happen when a CONTROL_ID triggered WM_COMMAND
          IDC_BUTTON:
            begin
              if (MessageBox(hWin,
                             PChar(
                                   'Would you like to cancel operation?'+#13#10#13#10
                                  +'(keep in mind that current operation may finish first.)'
                                  ),
                             PChar('Cancel Operation'),
                         MB_YESNO or MB_ICONQUESTION or MB_TOPMOST or MB_APPLMODAL)
                  = ID_YES) then
              begin
                LAborted := True;
                PostQuitMessage(0);
              end;
            end; // ID_BUTTON
        end; // case LoWord(wp)
      end; // WM_COMMAND

    WM_CLOSE, WM_DESTROY:
      begin
       end; // WM_CLOSE, WM_DESTROY
  end; // case uMsg
end;

procedure TSplashBar.ShowSplashBar;
var
  hWndFont: HGDIOBJ;
begin
  InitCommonControls;
  if (not FShowButton and FMarqueeMode) then
    FhDlg := CreateDialogParam(HInstance,
               MakeIntResource(IDD_MARQUEE),
               GetDesktopWindow, @DlgFunc, 0);

  if (not FShowButton and not FMarqueeMode) then
    FhDlg := CreateDialogParam(HInstance,
               MakeIntResource(IDD_SMOOTH),
               GetDesktopWindow, @DlgFunc, 0);

  if (FShowButton and FMarqueeMode) then
    FhDlg := CreateDialogParam(HInstance,
               MakeIntResource(IDD_MARQUEEBUTTON),
               GetDesktopWindow, @DlgFunc, 0);

  if (FShowButton and not FMarqueeMode) then
    FhDlg := CreateDialogParam(HInstance,
               MakeIntResource(IDD_SMOOTHBUTTON),
               GetDesktopWindow, @DlgFunc, 0);


  if (FhDlg <= 0) then
    Exit;
  SetLabelCaption(FLabelCaption);
  if FShowButton then
    SetButtonCaption(FButtonCaption);
  SetMarqueeSpeed(FMarqueeSpeed);
  hWndFont := GetStockObject(DEFAULT_GUI_FONT);
  if(hWndFont <> 0) then
    SendMessage(FhDlg, WM_SETFONT, hWndFont, LPARAM(True));
end;

end.
Im Anhang ist ein kommentiertes Demo Projekt samt allen Quelltexten plus 32bit Kompilat zum reinschnuppern was die Klasse macht.

jaenicke 21. Jul 2020 16:58

AW: "Unendlicher Progressbar"
 
Zitat:

Zitat von KodeZwerg (Beitrag 1469798)
Es wurde TThread und WinApi genutzt um ans Ziel zu kommen, plus Resource Dialoge als Anzeige.

Genau das habe ich auch in der verlinkten MTCL gemacht, nur dass ich die visuellen Komponenten in Klassen verpackt habe und man damit auf die Komponenten in der Ressource zugreifen kann. Alternativ kann man die Komponenten aber auch dynamisch erstellen. Aber das Projekt ist eben noch nicht weit.

Die Demo sieht gut aus, so hatte ich mir das vorgestellt.

KodeZwerg 27. Jul 2020 07:39

AW: "Unendlicher Progressbar"
 
Liste der Anhänge anzeigen (Anzahl: 1)
Zitat:

Zitat von jaenicke (Beitrag 1470028)
Genau das habe ich auch in der verlinkten MTCL gemacht, nur dass ich die visuellen Komponenten in Klassen verpackt habe und man damit auf die Komponenten in der Ressource zugreifen kann. Alternativ kann man die Komponenten aber auch dynamisch erstellen. Aber das Projekt ist eben noch nicht weit.

Die Demo sieht gut aus, so hatte ich mir das vorgestellt.

Wiedermal sorry für späten reply.... bissl Ferien zwischendurch mal :-)

Ich wollte echt nicht in Konkurrenz mit Dir stehen, dennoch vielen Dank für's Lob, für mich ist es eh die einzig wahre Möglichkeit an so etwas ranzugehen.
Da man auch im Urlaub Zeit mit Delphi verbringt hab ich nochmal von vorne angefangen (aufm Lappi fehlte mir meine vorige Kreation, ohne inet konnt ichs nicht laden), dieses mal gleich als Komponente.
Nach einem Diagram wie ich es mir vorgestellt habe das es zu funktionieren hat, nun auch als "Zwei-Klassen-System" falls man das so nennt.
Hauptklasse ist für die Delphi IDE als Wrapper, intern die eigentliche Klasse.
Nun auch 100% dynamisch ohne Resourcen-Dialog. Da hier und da noch ein paar ungereimtheiten vorhanden sind die mir nicht zusagen gibt es im Anhang nur eine Demo.
Falls daran überhaupt ein Interesse bestehen sollte, werde ich den Source auch zur freien Verfügung hochladen.

Die drei Punkte die mir noch Sorgen bereiten:
- 1. Wenn ich das Window auf der TaskBar eintrage, kann man den Dialog über der TaskBar schließen... das geht so mal gar nicht.
- 2. Bild positionierung klappt noch nicht so wie ich es gerne hätte.
// edit: mit Bild positionierung meine ich nicht was Window sondern meine Unterstützung für Bilder im Splash
// am liebsten würde ich eine "Stretch" methode implementieren, da fehlt mir noch bissl Erfahrung how-to, aber wird schon noch :-)
- 3. Die GUI nochmal mit ein bisschen mehr "Luft" (Margins-Like) zwischen den einzelnen Elementen zeichnen lassen.

Schade das der TE sich noch nicht geäußert hat ob das Thema erledigt ist.

Ps: Mtcl sagt mir gerade noch nichts, werde ich nun nachholen!


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:18 Uhr.
Seite 6 von 6   « Erste     456   

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz