asked on

TProgressbar issue

Hi all.

I'm struggling with a progressbar issue I can't get rid of!
Let me explain step-by.step.
First, the component: I use a my own component, a stupid, simple component which does the trick: it shows a modal dialog when my program has to do long operations. I deployed the component because I need often a modal dialog with some message to the user and I didn't find one on the web (not free, at least).

The code is the following one:

unit UmgModalProgressDlg;

interface

uses
  System.SysUtils, System.Classes, uDialogProgressForm, Vcl.Forms,
  Vcl.ComCtrls, Vcl.Graphics;

type

  TDialogForm = TfrmProgressDialog;
  {*------------------------------------------------------------------------------
  TmgDialogOptions is the class which let you customize the Dialog appearing to
  the user while checking and downloading updates: here you can set several pro-
  perties to integrate this visual element of TmgWebUpdater within your application.
  You can set window's color, Font's properties (you can set three labels' fonts
  individually) and you can also eventually add a background image.
  -------------------------------------------------------------------------------}
  TmgDialogOptions = class(TPersistent)
  private
    FDialog: TDialogForm;
    FMessage: String;
    FCaption: String;
    FDialogColor: TColor;
    FlblWaitFont: TFont;
    FAlignment: TAlignment;
  protected
    procedure SetMessage(Value: String);
    procedure SetCaption(Value: String);
    procedure SetColor(Value: TColor); virtual;
    procedure SetlblWaitFont(Value: TFont); virtual;
    procedure SetAlignment(Value: TAlignment); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property DialogMessage: String read FMessage write SetMessage;
    property DialogCaption: String read FCaption write SetCaption;
    property MessageAlignment: TAlignment read FAlignment write SetAlignment;
    property DialogColor: TColor read FDialogColor write SetColor default clBtnFace;
    property WaitLabelFont: TFont read FlblWaitFont write SetlblWaitFont;
  end;

  TmgModalProgressDlg = class(TComponent)
  private
    FOwner: TComponent;
    FormPointer: Pointer;
    FMin: Integer;
    Fmax: Integer;
    FSmooth: Boolean;
    FStep: Integer;
    FPosition: Integer;
    FDialogOptions: TmgDialogOptions;
  protected
    procedure SetMin(Value: Integer);
    procedure SetMax(Value: Integer);
    procedure SetStep(Value: Integer);
    procedure SetPosition(Value: Integer);
    procedure SetSmooth(Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Show;
    procedure Hide;
  published
    {*------------------------------------------------------------------------------
      DialogOptions provide an easy way to set both at design-time and at run-time
      the look'n'feel of dialog TmgWebUpdater shows to user to inform him about
      checking and downloading progress.
    -------------------------------------------------------------------------------}
    property DialogOptions: TmgDialogOptions read FDialogOptions write FDialogOptions;
    property ProgressMin: Integer read FMin write SetMin;
    property ProgressMax: Integer read FMax write SetMax;
    property ProgressStep: Integer read FStep write SetStep;
    property ProgressSmooth: Boolean read FSmooth write SetSmooth;
    property ProgressPosition: Integer read FPosition write SetPosition;
  end;

implementation

{ TmgModalWaitDlg }

constructor TmgModalProgressDlg.Create(AOwner: TComponent);
begin
  inherited;
  FDialogOptions := TmgDialogOptions.Create;
  FOwner := AOwner;
  FMin := 0;
  Fmax := 100;
  FStep := 1;
  FSmooth := False;
end;

destructor TmgModalProgressDlg.Destroy;
begin
  FDialogOptions.Free;
  inherited;
end;

procedure TmgModalProgressDlg.Hide;
begin
  FreeAndNil(FDialogOptions.FDialog);
  EnableTaskWindows(FormPointer);
  TForm(FOwner).BringToFront;
end;

procedure TmgModalProgressDlg.SetMax(Value: Integer);
begin
  if TryStrToInt(IntToStr(Value), Value) then
    FMax := Value;
end;

procedure TmgModalProgressDlg.SetMin(Value: Integer);
begin
  if TryStrToInt(IntToStr(Value), Value) then
    FMin := Value;
end;

procedure TmgModalProgressDlg.SetPosition(Value: Integer);
begin
  FPosition := Value;
  if Assigned(FDialogOptions.FDialog) then
    FDialogOptions.FDialog.ProgressBar1.Position := FPosition;
end;

procedure TmgModalProgressDlg.SetSmooth(Value: Boolean);
begin
  FSmooth := Value;
end;

procedure TmgModalProgressDlg.SetStep(Value: Integer);
begin
  if TryStrToInt(IntToStr(Value), Value) then
    FStep := Value;
end;

procedure TmgModalProgressDlg.Show;
begin
  FDialogOptions.FDialog := TfrmProgressDialog.Create(nil);
  FDialogOptions.FDialog.Caption := FDialogOptions.FCaption;
  FDialogOptions.FDialog.lblMessage.Font.Assign(FDialogOptions.FlblWaitFont);
  FDialogOptions.FDialog.Color := FDialogOptions.FDialogColor;
  FDialogOptions.FDialog.lblMessage.Caption := FDialogOptions.FMessage;
  FDialogOptions.FDialog.lblMessage.Alignment := FDialogOptions.FAlignment;
  FDialogOptions.FDialog.Position := poMainFormCenter;
  FDialogOptions.FDialog.ProgressBar1.Smooth := FSmooth;
  FDialogOptions.FDialog.ProgressBar1.Min := FMin;
  FDialogOptions.FDialog.ProgressBar1.Max := Fmax;
  FDialogOptions.FDialog.ProgressBar1.Step := FStep;
  FDialogOptions.FDialog.DoubleBuffered := True;
  FDialogOptions.FDialog.Show;
  FDialogOptions.FDialog.Update;
  FormPointer := DisableTaskWindows(FDialogOptions.FDialog.Handle);
end;

{ TmgDialogOptions }

procedure TmgDialogOptions.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
end;

constructor TmgDialogOptions.Create;
begin
  FMessage := 'Please, wait...';
  FCaption := 'Please, wait...';
  FlblWaitFont := TFont.Create;
  FAlignment := taCenter;
  FDialogColor := clBtnFace;
end;

destructor TmgDialogOptions.Destroy;
begin
  FreeAndNil(FlblWaitFont);
  inherited;
end;

procedure TmgDialogOptions.SetCaption(Value: String);
begin
  FCaption := Value;
  if (Assigned(FDialog)) and (FDialog.Visible)then
    FDialog.Caption := FCaption;
end;

procedure TmgDialogOptions.SetColor(Value: TColor);
begin
  FDialogColor := Value;
  if (Assigned(FDialog)) and (FDialog.Visible)then
    FDialog.Color := FDialogColor;
end;

procedure TmgDialogOptions.SetlblWaitFont(Value: TFont);
begin
  FlblWaitFont.Assign(Value);
  if (Assigned(FDialog)) and (FDialog.Visible)then
    FDialog.lblMessage.Font.Assign(FlblWaitFont);
end;

procedure TmgDialogOptions.SetMessage(Value: String);
begin
  FMessage := Value;
  if (Assigned(FDialog)) and (FDialog.Visible)then
    FDialog.lblMessage.Caption := FMessage;
end;

procedure TmgDialogOptions.SetAlignment(Value: TAlignment);
begin
  FAlignment := Value;
  if (Assigned(FDialog)) and (FDialog.Visible)then
    FDialog.lblMessage.Alignment := FAlignment;
end;

initialization
  RegisterClass(TForm);

end.

Open in new window

The TfrmProgressDialog doesn't have any code: only a label and a progressbar.

Here the demo (a form with a button):

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  mgModalProgressDlg1.ProgressMax := 100000;
  mgModalProgressDlg1.Show;
  try
  for I := 0 to 100000 do
    begin
    mgModalProgressDlg1.DialogOptions.DialogMessage := 'The value of I is '+IntToStr(I);
    mgModalProgressDlg1.ProgressPosition := I;
    Application.ProcessMessages;
    end;
  finally
    mgModalProgressDlg1.Hide;
  end;
end;

Open in new window

The code works well for every value you assign to the Progressbar max property (setting accordingly the max value of the I).

In the real world of my program things are different:

      mgModalProgressDlg1.ProgressMax := slOriginal.Count;
      for I := 0 to slOriginal.Count - 1 do
      begin
        lbxRegFile.Items.Add(slOriginal[I]);
        sl := SplitString(slOriginal[I], ';');
        for X := Low(sl) to High(sl) do
        begin
          sl1 := SplitString(sl[X], ',');
          for y := Low(sl1) to High(sl1) do
          begin
            rx.Subject := sl1[y];
            if rx.Match then
              if (not DirectoryExists(rx.MatchedText)) then
                if slTokens.IndexOfName(IntToStr(I)) = - 1 then
                  slTokens.Add(IntToStr(I)+'='+rx.MatchedText);
          end;
        end;
        mgModalProgressDlg1.DialogOptions.DialogMessage := 'Scanning line '+IntToStr(I) + ' of '+IntToStr(slOriginal.Count);
        mgModalProgressDlg1.ProgressPosition := I;
        Application.ProcessMessages;
      end;

Open in new window

This code
- scans a StringList where is loaded a registry file
- adds the StringList Items to the Listbox
- splits each line using a emicolo delimiter and then each item of the resulting StringDynArray using the comma delimiter
- each resulting value is compared against a regula expresison pattern to state if it is a directory and if it does, and the directory doesn't exist, the Item index is added to a second StringList
- lastly, the label of the mine modal dialog is updated and the same for the progressbar

but the label is update correctly whereas the progressbar fastly fills up and then stands to the max value while code proceeds to scanning the remaining items.
Nothing is set differently in the progressbar values except the ProgressMax value.

I really don't understand and maybe I need now to a couple of fresh eyes to see the obvious...

Thanks to all for any advice.
Marco

Sinisa Vuk

Take a look at this blog:
http://zarko-gajic.iz.hr/delphi-tprogressbar-not-updating-fast-enough/

try to set this way:

procedure TmgModalProgressDlg.SetPosition(Value: Integer);
begin
  FPosition := Value;
  if Assigned(FDialogOptions.FDialog) then
  begin
    FDialogOptions.FDialog.ProgressBar1.Position := FPosition;
    FDialogOptions.FDialog.ProgressBar1.StepBy(0);
  end;
end;

Open in new window

Marco Gasi

ASKER

Hi, Sinisa, thanks for your reply.
Unfortunately, that doesn't work. My problem is the opposite: my progressbar updates too fast. The animatioon takes place but it's too fast and reaches the max value too soon, very bery too soon. Let's say the process tahes about 10 minutes: the label update regularly nd the item number corresponds to the item processed; the progressbar fills up within 3 seconds!
I tried several combinations but o far the only on takes some effect is (in the calling form):

mgModalProgressDlg1.ProgressPosition := 1 + mgModalProgressDlg1.ProgressPosition;
mgModalProgressDlg1.ProgressPosition := -1 + mgModalProgressDlg1.ProgressPosition;

Open in new window

But of course this makes simply ProgressBar do nothing!

ASKER CERTIFIED SOLUTION

Sinisa Vuk

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Marco Gasi

ASKER

Ništa: is it right to say 'nothing'? :-)
The behavior is just the same. Since the progress usually works correctly in the demo program of the component, I can't figure out what's going wrong. I ttried other fixes foun on the web which claimed to solve themed Windows bugs, but none of them changed anything.

Marco Gasi

ASKER

I'm just experimenting:

mgModalProgressDlg1.StepProgress(0);

Open in new window

This makes the ProgressBar fills up almost to half and then stops: lol

Marco Gasi

ASKER

Okay. It seems StepProgress functions works fine. I have another piece of code where I use a similar loop to search all items in the listbox and in this code the StepProgress function solves the problem.

I thought the issue were like the progressbar update were called more than one times: for instance, in the demo program you can add another one or two calls to

mgModalProgressDlg1.ProgressPosition := I;

and this simulates the issue in my program. So I looked better: there is no more calls, but that code is not in a standard event. In my code I use a code I found on the web to makes the event take place after the form has been shown to the user. This is the code:

procedure TfrmIncorrectPaths.FormShow(Sender: TObject);
begin
  lblCount.Caption := '';
  lblMatches.Caption := '';
  tmr1.Enabled := True;
end;

procedure TfrmIncorrectPaths.tmr1Timer(Sender: TObject);
begin
  while Counter < 2 do
    Inc(Counter);
  if Counter = 2 then
  begin
    tmr1.Enabled := False;
    PostMessage(Self.Handle, WM_AFTER_SHOW, 0, 0);
  end;
end;

procedure TfrmIncorrectPaths.WmAfterShow(var Msg: TMessage);
begin
  //here the loop
end;

Open in new window

So the problem is now with this code. I'll open a new question about: this specific question has been solved by your comment ID: 40005896

Thank you very mutch.

Marco Gasi

ASKER

Thank you, Sinisa!

Sinisa Vuk

... and people who commented Zarko Gajic's blog.
... and yes,

Ništa

is a word for nothing :-)

Marco Gasi

ASKER

Hi Sinisa. I post the link to the other question, hoping you have a brilliant idea :-)

(What is a latin equivalent of Sinisa? Do you know? I really don't know what is the croatian equivalnt of Marco...)

Sinisa Vuk

My name is hardly to translate. Marko is in croatian and this is quite common name here.

Sinisa Vuk

Try another thing:
- set max to 100 (or do not set at all - because default is 100)
- calculate position to range of 0..100 (as percentage): pos := muldiv(i, 100, 10000)

Marco Gasi

ASKER

Hi, Sinisa.
This does the trick:

mgModalProgressDlg1.ProgressPosition := muldiv(i, 100, slOriginal.Count);

Please, post your comment in my other question. I'm waiting for Geert clarify what he said about my bugs (if he'll do it), but you deserve points for sure.
My only regret is to not understand why I have to use such a trick in that procedure and not in other procedures: the worst, progress fills regularly in a way in the demo program, in another way in a procedure of my prog, and in another different way in WmAfterShow event. I admit this could be a bug, but I would like understand what bug it is.

Cheers