#1
  1. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    May 2002
    Posts
    86
    Rep Power
    12

    Drives "Spin up" kills progress bar progress...


    Hi, I've implemented a progress bar in one of my apps, the problem is that as soon as I run a procedure that parses a small text file line by line windows activates all the hdd's... before this happens the progress bar runs perfectly....

    Once the drives "kick in" the progress bar freezes along with the application

    In fact the process runs uninterupted in spite of the progress bar freezing, it even completes but because the progress bar has "frozen" the user is kept in the dark about what is happening...

    Does that make sense?

    Has anyone else dealt with this and is it possible to make sure the progress bar continues to inform the user of what is happening...I hope that all made sense...

    G
  2. #2
  3. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Jun 2008
    Posts
    344
    Rep Power
    6
    Does just the progress bar freeze or does the entire application freeze?

    Is the code that parses the text file implemented in a loop (for/while/repeat)? If so, then the application is busy within the loop and cannot process any messages (such as update the UI - thus the progress bar).

    The poor man's solution is to add "Application.ProcessMessages;" inside your loop, but there are reasons why that isn't the best solution. The better solution is to implement the work you are doing in a thread, and have the thread report back to the main thread its current status so it can update the progress bar.
  4. #3
  5. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    May 2002
    Posts
    86
    Rep Power
    12
    Hi majlumbo, you are dead right, it is within the loop and yes the entire app freezes as you say, I had a feeling it was something like this.

    I currently have no idea how the heck create a new thread, without being lazy is it complex? I've added the code below, and seeing an example of what is done to it to get it to thread would be very helpful... that is if you don't mind, I realize I'm being cheeky by asking.

    Code:
    procedure processIPTCrows(col_id,dirPath : string);
    var
      sldb: TSQLiteDatabase;
      sltb: TSQLIteTable;
      c_counter : integer;
      coltype_name, slDBPath : string;
      datafile : textfile;
      colrow_id: string;
      colrow_pic1: string;
      colrow_pic2,colrow_pic3: string;
      colrow_rating: string;
      colrow_filename: string;
      colrow_comment: string;
      keyword : string;
      idx : integer;
      caption : string;
      filePathAndFile : string;
    
    begin
    
    slDBPath := pub_appdatafolder +  'data.db';
    sldb := TSQLiteDatabase.Create(pub_slDBPath);
    sltb :=  slDb.GetTable('SELECT * FROM collectionrow where col_id ="' + col_id + '"');
    fIPTC.ProgressBar1.Max := sltb.Count;
    c_counter := 0;
    
    
      while not sltb.EOF do
      begin
    colrow_id := sltb.FieldAsString(sltb.fieldIndex['colrow_id']) ;
    col_id := sltb.FieldAsString(sltb.fieldIndex['col_id']) ;
    colrow_pic1 := sltb.FieldAsString(sltb.fieldIndex['colrow_pic1']) ;
    colrow_pic2 := sltb.FieldAsString(sltb.fieldIndex['colrow_pic2']) ;
    colrow_pic3 := sltb.FieldAsString(sltb.fieldIndex['colrow_pic3']) ;
    colrow_rating := sltb.FieldAsString(sltb.fieldIndex['colrow_rating']) ;
    colrow_filename := sltb.FieldAsString(sltb.fieldIndex['colrow_filename']) ;
    
    FilePathAndFile := dirPath + '\' + colrow_filename;
    
    if (colrow_pic1 <> '') or (colrow_pic2 <> '') or (colrow_pic3 <> '')then
    begin
    if fileExists(FilePathAndFile) then
      begin
        fIptc.ImageEnViewIPTC.IO.LoadFromFile(FilePathAndFile);
        Idx:=fIptc.ImageEnViewIPTC.IO.Params.IPTC_Info.IndexOf(2,25);
        Caption:= fIptc.ImageEnViewIPTC.IO.Params.IPTC_Info.StringItem[idx];
        //showMessage(inttostr(idx));
        fIptc.Memo1.Lines.Add(Caption + ' ' + colrow_filename + ' ' + inttostr(idx));
        fIptc.lCurrentFileIPTC.Caption := colrow_filename;
          with fIptc.ImageEnViewIPTC.io.Params.IPTC_Info do
          begin
              fIptc.ImageEnViewIPTC.IO.Params.IPTC_Info.Clear;
              if (colrow_pic1 = '1') then AddStringItem(2, 25,'YES-Pickamatic');
              if (colrow_pic2 = '1') then AddStringItem(2, 25,'Maybe-Pickamatic');
              if (colrow_pic3 = '1') then AddStringItem(2, 25,'NO-Pickamatic');
              fIptc.ImageEnViewIPTC.io.InjectJpegIPTC(FilePathAndFile);
              fIptc.ProgressBar2.Position := 0;
          end;
    
      end;
        inc(c_counter);
        fIPTC.ProgressBar1.Position := c_counter;
    end;
    
      sltb.Next;
      end;
    sldb.Free;
    sltb.Free;
    end;


    Greg.


    Originally Posted by majlumbo
    Does just the progress bar freeze or does the entire application freeze?

    Is the code that parses the text file implemented in a loop (for/while/repeat)? If so, then the application is busy within the loop and cannot process any messages (such as update the UI - thus the progress bar).

    The poor man's solution is to add "Application.ProcessMessages;" inside your loop, but there are reasons why that isn't the best solution. The better solution is to implement the work you are doing in a thread, and have the thread report back to the main thread its current status so it can update the progress bar.
    Last edited by dlumley; July 27th, 2012 at 05:27 AM. Reason: Added code...
  6. #4
  7. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Jun 2008
    Posts
    344
    Rep Power
    6
    Sorry for the length reply, I hope this helps....

    I took the liberty of adding try..finally blocks to wrap the code you use to dynamically create objects. That ensures that even if there's an error that the code to free the objects will still execute (no memory leaks). I also added Appliction.ProcessMessages (poor man's solution) just after you update your progress bar's position, that will allow your program to return to the message loop and execute messages that are queued up, (which one of them will be to update your progress bar).

    So now the down side.
    1) This will make your application more responsive, not completely responsive...

    2) If you run this procedure as a result of, say a button press, then if the user presses that button and kicks this process off, and then presses it again while it is still executing, that will send another button click message which will be picked up when "Application.ProcessMessages" is executed. That will, in essence, make the same procedure kick off again (and again) just after it finishes. So you need to protect against "re-entrant" code - you don't want your program to re-enter the same procedure due to a 2nd/3rd etc. button press. There are a few ways to do this, so given processIPTCrows is kicked off with a BitBtn1Click procedure, you can protect like so:

    Code:
    procdure TForm1.BitBtn1Click(Sender: TObject);
    begin
       BitBtn1.OnClick := Nil;//1st disconnect BitBtn1 and its OnClick handler 
       ProcessIPTCrows(<params>);//execute ProcessIPTCrows
       BitBtn1.OnClick := BitBtn1Click;//reconnect button to event handler
       
       //So if your user were to click the button again while executing, nothing happens,
       // since the button temporarily has no event handler defined.
    end;
    Also, for any lengthy process, a way for a user to cancel the operation should be seriously considered. You can declare a boolean variable in your form's private declaration, called "stopped" and set it to false at the beginning of your process. Then your while loop should take into account both EOF and not stopped,

    Code:
    Add stopped to form's declaration
    
    TForm1 = class(TForm)
     ...
    private
       stopped: boolean;
       ...
    end;
    
    Add a STOP button and add code:
    
    procedure TForm1.StopBtnClick(Sender: TObject);
    begin
       Stopped := True;
    end;
    
    //then you can alter the while loop like so:
    
    stopped := False;
    //enable or make visible stop button here
    StopBtn.Enabled := True;
    while (not sltb.EOF) and (not stopped) do
    begin
       ...
    end;
    if stopped then
    begin
       //execute clean up code if needed
       Stopped := False;
    end;
    Here is the modified processIPTCrows (sans stop functionality)

    Code:
    procedure processIPTCrows(col_id,dirPath : string);
    //Should this be procedure TForm1.processIPTCrows(col_id,dirPath : string);?
    var
      sldb: TSQLiteDatabase;
      sltb: TSQLIteTable;
      c_counter : integer;
      coltype_name, slDBPath : string;
      datafile : textfile;
      colrow_id: string;
      colrow_pic1: string;
      colrow_pic2,colrow_pic3: string;
      colrow_rating: string;
      colrow_filename: string;
      colrow_comment: string;
      keyword : string;
      idx : integer;
      caption : string;
      filePathAndFile : string;
    begin
       slDBPath := pub_appdatafolder +  'data.db';
       sldb := TSQLiteDatabase.Create(pub_slDBPath);
       try  //<--try block added
         sltb :=  slDb.GetTable('SELECT * FROM collectionrow where col_id ="' + col_id + '"');
         try  //<--try block added
           fIPTC.ProgressBar1.Max := sltb.Count;
           c_counter := 0;
           while not sltb.EOF do
           begin
              colrow_id := sltb.FieldAsString(sltb.fieldIndex['colrow_id']) ;
              col_id := sltb.FieldAsString(sltb.fieldIndex['col_id']) ;
              colrow_pic1 := sltb.FieldAsString(sltb.fieldIndex['colrow_pic1']) ;
              colrow_pic2 := sltb.FieldAsString(sltb.fieldIndex['colrow_pic2']) ;
              colrow_pic3 := sltb.FieldAsString(sltb.fieldIndex['colrow_pic3']) ;
              colrow_rating := sltb.FieldAsString(sltb.fieldIndex['colrow_rating']) ;
              colrow_filename := sltb.FieldAsString(sltb.fieldIndex['colrow_filename']) ;
              FilePathAndFile := dirPath + '\' + colrow_filename;
              if (colrow_pic1 <> '') or (colrow_pic2 <> '') or (colrow_pic3 <> '')then
              begin
                if fileExists(FilePathAndFile) then
                begin
                  fIptc.ImageEnViewIPTC.IO.LoadFromFile(FilePathAndFile);
                  Idx:=fIptc.ImageEnViewIPTC.IO.Params.IPTC_Info.IndexOf(2,25);
                  Caption:= fIptc.ImageEnViewIPTC.IO.Params.IPTC_Info.StringItem[idx];
                  //showMessage(inttostr(idx));
                  fIptc.Memo1.Lines.Add(Caption + ' ' + colrow_filename + ' ' + inttostr(idx));
                  fIptc.lCurrentFileIPTC.Caption := colrow_filename;
                  with fIptc.ImageEnViewIPTC.io.Params.IPTC_Info do
                  begin
                    fIptc.ImageEnViewIPTC.IO.Params.IPTC_Info.Clear;
                    if (colrow_pic1 = '1') then 
                      AddStringItem(2, 25,'YES-Pickamatic');
                    if (colrow_pic2 = '1') then 
                      AddStringItem(2, 25,'Maybe-Pickamatic');
                    if (colrow_pic3 = '1') then 
                      AddStringItem(2, 25,'NO-Pickamatic');
                    fIptc.ImageEnViewIPTC.io.InjectJpegIPTC(FilePathAndFile);
                    fIptc.ProgressBar2.Position := 0;
                  end;
                end;
                inc(c_counter);
                fIPTC.ProgressBar1.Position := c_counter;
                Application.ProcessMessages;//<--added This.
             end;
             sltb.Next;
           end;
         finally //<-- this will always execute, regardless of possible errors
            sltb.Free;
         end;
      finally//<-- this will always execute, regardless of possible errors
         sldb.Free;
      end;
    end;
    As far as threads, is it difficult? hmmmm, No and Yes. There's far more issues than I can go over in a post so I suggest you read up on it, then when you are more confient you can go forward, then rewrite this method to run in a thread. Just google "delphi thread example" lots of examples out there to guide you.
  8. #5
  9. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    May 2002
    Posts
    86
    Rep Power
    12

    Thank You!


    I appreciate your time and help so much!

    Have a great weekend!

    G
  10. #6
  11. No Profile Picture
    Contributing User
    Devshed Regular (2000 - 2499 posts)

    Join Date
    Jan 2006
    Location
    Carlsbad, CA
    Posts
    2,055
    Rep Power
    383
    Small point to emphasize what majlumbo mentioned about try..finally.
    You definitely need it when disabling / enabling events.
    Code:
    procdure TForm1.BitBtn1Click(Sender: TObject);
    begin
       BitBtn1.OnClick := Nil;//1st disconnect BitBtn1 and its OnClick handler 
       try
         ProcessIPTCrows(<params>);//execute ProcessIPTCrows
       finally
         BitBtn1.OnClick := BitBtn1Click;//reconnect button to event handler
       end;
       //So if your user were to click the button again while executing, nothing happens,
       // since the button temporarily has no event handler defined.
    end;
    Clive
    Last edited by clivew; July 27th, 2012 at 12:48 PM. Reason: Forgot the code block
  12. #7
  13. No Profile Picture
    Contributing User
    Devshed Newbie (0 - 499 posts)

    Join Date
    Jun 2008
    Posts
    344
    Rep Power
    6
    Originally Posted by clivew
    Small point to emphasize what majlumbo mentioned about try..finally.
    You definitely need it when disabling / enabling events.
    Code:
    procdure TForm1.BitBtn1Click(Sender: TObject);
    begin
       BitBtn1.OnClick := Nil;//1st disconnect BitBtn1 and its OnClick handler 
       try
         ProcessIPTCrows(<params>);//execute ProcessIPTCrows
       finally
         BitBtn1.OnClick := BitBtn1Click;//reconnect button to event handler
       end;
       //So if your user were to click the button again while executing, nothing happens,
       // since the button temporarily has no event handler defined.
    end;
    Clive
    Definitely agree with Clive, if there were to be an error in ProcessIPTCrows, then the button and its event handler would never be re-connected.

    Thanks Clive...

IMN logo majestic logo threadwatch logo seochat tools logo