Solved

TProgressbar issue

Posted on 2014-04-16
12
386 Views
Last Modified: 2014-04-18
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
0
Comment
Question by:Marco Gasi
  • 7
  • 5
12 Comments
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 40005389
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

0
 
LVL 30

Author Comment

by:Marco Gasi
ID: 40005866
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!
0
 
LVL 25

Accepted Solution

by:
Sinisa Vuk earned 500 total points
ID: 40005896
what about:
ProgressBar1.StepBy(1);
for each increment of position instead of Position := FPosition;
Make another procedure like:
procedure TmgModalProgressDlg.StepProgress(Value: Integer);
begin
  FPosition := Value;
  if Assigned(FDialogOptions.FDialog) then
  begin
    FDialogOptions.FDialog.ProgressBar1.StepBy(Value);
  end;
end;

Open in new window


... then do StepProgress(1) in for loop.
0
 
LVL 30

Author Comment

by:Marco Gasi
ID: 40005999
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.
0
 
LVL 30

Author Comment

by:Marco Gasi
ID: 40006037
I'm just experimenting:

mgModalProgressDlg1.StepProgress(0);

Open in new window


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

Author Comment

by:Marco Gasi
ID: 40006136
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.
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 30

Author Closing Comment

by:Marco Gasi
ID: 40006138
Thank you, Sinisa!
0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 40006152
... and people who commented Zarko Gajic's blog.
... and yes,
Ništa
is a word for nothing :-)
0
 
LVL 30

Author Comment

by:Marco Gasi
ID: 40006430
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...)
0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 40006445
My name is hardly to translate. Marko is in croatian and this is quite common name here.
0
 
LVL 25

Expert Comment

by:Sinisa Vuk
ID: 40007766
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)
0
 
LVL 30

Author Comment

by:Marco Gasi
ID: 40008332
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
0

Featured Post

What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now