Solved

Showing a "processing. Please wait..." message (500 points)

Posted on 2008-10-19
8
1,700 Views
Last Modified: 2013-11-23
I have a form called "ProcessingForm" with a label "Processing. Please wait..."  I want to show this form.for different times according to circumstances (when various processes are being carried out).

I am using Delphi 6.  I am giving the maximum 500 points as this is urgent, together with my grateful thanks.
0
Comment
Question by:rincewind666
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
  • 2
  • +2
8 Comments
 
LVL 28

Expert Comment

by:2266180
ID: 22752228
I don't see what the problem is:

ProcessingForm.Show;
try
  dowhatever process you have
finally
  ProcessingForm.Hide;
end;

so, what is the actual issue here?
0
 
LVL 1

Expert Comment

by:leei
ID: 22752389
I assume you will be showing the status form using Show rather than ShowModal. If so and the process that you are running does not yield to other processes you will not see your change to the label text until the end of the (busy) process. To solve this you can do a couple different things:

1. Call the Update method of the label after setting the new text value
2. Call Application.ProcessMessages

The latter will allow all pending messages for things like GUI updates to process where the former will only update the new value assigned to the label.

-Lee
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 22755797
here is a unit i use for this,
it even allows moving the window around while processing

call it like this:

uses frmWaitScreen;

procedure TfrmMain.ImportData(ds: TDataset);
begin
  DataWait(ds.RecordCount, 2);
  try

    ds.DisableControls;
    try
      ds.First;
      while not ds.Eof do
      begin
         // Add record

         DataWait(1, 1, ds.FieldByName('ITEMNAME').AsString);

         // Add data to list
        ds.Next;
      end;  
    finally
      ds.EnabledControls;
    end;

  finally
    EndDataWait;
  end;

end;



unit frmWaitScreen;
 
interface
 
uses
  Windows, Forms, Classes, Controls, ExtCtrls, StdCtrls, Messages,
  ImgList, Graphics, ComCtrls;
 
type
  TfrmWait = class(TForm)
    pbWait: TProgressBar;
    pnl: TPanel;
    lblTop: TLabel;
    lblMessage: TLabel;
    lblMiddle: TLabel;
    lblStepMessage: TLabel;
    procedure FormShow(Sender: TObject);
  private
    fStartTime: TDateTime;
    procedure WMHitCaption(var Msg: TMessage); message WM_NCHITTEST;
  public
    constructor Create(AOwner: TComponent); override;
  end;
 
var
  frmWait: TfrmWait;
 
procedure DataWait(Step: Integer = 0; StepType: Integer = 0; StepMessage: string = '');
procedure EndDataWait;
 
implementation
 
uses SysUtils;
 
{$R *.DFM}
 
constructor TfrmWait.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fStartTime := Now;
end;
 
procedure TfrmWait.FormShow(Sender: TObject);
begin
  fStartTime := Now;
  pbWait.Visible := False;
end;
 
// Steptype: 0 = not visible, 1 = step, 2 = max
procedure DataWait(Step: Integer = 0; StepType: Integer = 0; StepMessage: string = '');
begin
  Screen.Cursor := crHourglass;
  if not Assigned(frmWait) then
    frmWait := TfrmWait.Create(Application);
  if Assigned(frmWait) then
    with frmWait do
    begin
      lblStepMessage.Caption := StepMessage;
      if Visible and not pbWait.Visible and (Now - fStartTime > 2 / 24 / 60 / 60) then // 2 sec then
        pbWait.Visible := True;
      case StepType of
        1:
        begin
          if pbWait.Position + Step < pbWait.Properties.Max then
            pbWait.Position := pbWait.Position + Step
          else
            pbWait.Position := pbWait.Properties.Max;
        end;
        2:
        begin
          pbWait.Position := 0;
          pbWait.Properties.Max := Step;
        end;
      end;
      Show;
      Update;
      pbWait.Update;
      Update;
    end;
end;
 
procedure EndDataWait;
begin
  if Assigned(frmWait) then
    frmWait.Hide;
  Screen.Cursor := crDefault;
end;
 
 
procedure TfrmWait.WMHitCaption(var Msg: TMessage);
begin
  Msg.Result := HTCAPTION;
end;
 
end.

Open in new window

0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 4

Accepted Solution

by:
dprochownik earned 250 total points
ID: 22778441
You can use my unit to show given message if yours processing code takes to much time.
I'm using it to show "please wait" message when my SQL queries takes more than 3sec. I'm often executes that queries in application main thread, so I can't use standar VCL TForm to show my message, because it wouldn't show until SQL query end. I'm using windows API

The only thing you have to do are:
  • Call
     procedure DPStartWaiting(ShowAfter : LongWord = 5000; TextMessage : String = 'Please wait');
    before yours processing code. Parameters:
    • ShowAfter: how long yours message shouldn't show, because yours code can end in good time. (it can be 0ms - default 5sec)
    • TextMessage: "Please wait" etc. :)
  • Call
    procedure DPEndWaiting;
    after your processing code, to hide yours wait message or prevent showing if it haven't do that yet.

unit DPPleaseWait;
 
interface
 
  procedure DPStartWaiting(ShowAfter : LongWord = 5000;
                           TextMessage : String = 'Please wait');
  procedure DPEndWaiting;
 
implementation
  uses
    Windows,
    Messages,
    Classes,
    SyncObjs,
    Graphics,
    Forms,
    SysUtils,
    Dialogs, Math;
 
  type
    TMyThread = class(TThread)
    private
      fStartTime : DWord;
      fWait : Cardinal;
      fFormHandle : Cardinal;
//      fPrzejdzWStanUspienia : Cardinal;
      fFallAsleep : Boolean;
      procedure ThreadTerminate(Sender: TObject);
    protected
      procedure Execute; override;
    public
      constructor Create(WaitingTime: Cardinal); //W milisekundach
      Destructor Destroy; override;
      procedure   FallAsleep;
      procedure   Restore(WaitingTime: Cardinal); //W milisekundach
    end;
 
  var
    gDPWnd: TWndClass;
    gDPThread : TMyThread;
    gDPCriticalSection : TCriticalSection;
    gDPExecCount : Integer;
    gDPTextMessage : String;
 
  procedure DPDetermineTextSize(Const pCanvas : TCanvas; Const pTextMessage : String; var oWidth, oHeight: Integer);
  var
    vFontHeight: Integer;
    vi,vl,vStart,vj   : Integer;
    vs : String;
    vx : Integer;
  begin
    oWidth:=0;
    oHeight:=0;
    vl:=length(pTextMessage);
    if vl>0 then
    begin
      if pCanvas.Font.Height>0 then vFontHeight := pCanvas.Font.Height
      else vFontHeight := round(pCanvas.Font.Size * pCanvas.Font.PixelsPerInch / 72);
 
      vStart:=vl;
      vi:=vl;
      repeat
        if pTextMessage[vi]=#13 then
        begin
          SetLength(vs,vStart-vi);
          for vj:=vi+1 to vStart do vs[vj-vi]:=pTextMessage[vj];
          oHeight:=oHeight+vFontHeight+4; //4px na ostp pomidzy linijkami
          vx:=pCanvas.TextWidth(vs);
          if vx>oWidth then oWidth:=vx;
          vStart:=vi-1;
        end;
        vi:=vi-1;
      until vi = 0;
 
      SetLength(vs,vStart-vi);
      for vj:=vi+1 to vStart do vs[vj-vi]:=pTextMessage[vj];
      oHeight:=oHeight+vFontHeight;
      vx:=pCanvas.TextWidth(vs);
      if vx>oWidth then oWidth:=vx;
    end;
  end;
 
  procedure DPDrawText(Const pCanvas : TCanvas;
                       Const pX,pY:Integer;
                       Const pTextMessage : String);
  var
    vFontHeight     : Integer;
    vi,vl,vStart,vj : Integer;
    vs              : String;
    vHeight         : Integer;
  begin
    vHeight:=0;
    vl:=length(pTextMessage);
    if vl>0 then
    begin
      if pCanvas.Font.Height>0 then vFontHeight := pCanvas.Font.Height
      else vFontHeight := round(pCanvas.Font.Size * pCanvas.Font.PixelsPerInch / 72);
 
      vStart:=1;
      vi:=1;
      repeat
        if pTextMessage[vi]=#13 then
        begin
          SetLength(vs,vi-vStart);
          for vj:=vStart to vi-1 do vs[vj-vStart+1]:=pTextMessage[vj];
          pCanvas.TextOut(pX,pY+vHeight,vs);
          vHeight:=vHeight+vFontHeight+4; //4px na ostp pomidzy linijkami
          vStart:=vi+1;
        end;
        vi:=vi+1;
      until vi>vl;
 
      SetLength(vs,vi-vStart);
      for vj:=vStart to vi-1 do vs[vj-vStart+1]:=pTextMessage[vj];
      pCanvas.TextOut(pX,pY+vHeight,vs);
    end;
  end;
 
  procedure DPRedrawForm(pForm : HWND);
  var
    vCanvas : TCanvas;
    pDC : hDc;
  begin
    if pForm<>0 then
    begin
      pDC := GetDC(pForm);
      vCanvas := TCanvas.Create;
      try
        vCanvas.Handle:=pDC;
        vCanvas.Font.Name:='MS Sans Serif';
        vCanvas.Font.Size:=16;
        vCanvas.Font.Style:=vCanvas.Font.Style+[fsBold];
        vCanvas.Brush.Color:=$00BEDCBE;
        vCanvas.FillRect(vCanvas.ClipRect);
        DPDrawText(vCanvas,5,5,gDPTextMessage);
      finally
        FreeAndNil(vCanvas);
      end;
    end;
  end;
 
  function MyWndProc(Wnd: HWND; uMsg: UINT; wPar: WPARAM; lPar: LPARAM): LRESULT; stdcall;
  begin
    Result := 0;
    case uMsg of
      WM_PAINT  : DPRedrawForm(Wnd);
      WM_DESTROY: PostQuitMessage(0);
      else Result := DefWindowProc(Wnd, uMsg, wPar, lPar);
    end;
  end;
 
  constructor TMyThread.Create(WaitingTime: Cardinal);
  begin
    fWait:=WaitingTime;
    fStartTime := GetTickCount;
 
    FreeOnTerminate := true;
    OnTerminate := ThreadTerminate;
    fFallAsleep:=false;
 
    inherited  Create(false);
  end;
 
  destructor TMyThread.Destroy;
  begin
    //ShowMessage('Destruktor sie wykonuje');
    inherited;
  end;
 
  procedure TMyThread.Execute;
  var
    Canvas : TCanvas;
    DC : hDc;
    x,y: Integer;
  begin
    inherited;
 
    fFormHandle := CreateWindow('TFrmKomunikatProszeCzekac', nil,
                               WS_POPUPWINDOW or WS_BORDER,
                               0, 0, 0, 0,
                               0, 0, hInstance, NIL);
    try
      while true do
      begin
        if Terminated then break;
 
        if fFallAsleep then
        begin
          if IsWindowVisible(fFormHandle) then
            SetWindowPos(fFormHandle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or
                                                         SWP_NOSIZE or
                                                         SWP_HIDEWINDOW);
          Self.Suspend;
        end;
 
        if (GetTickCount - fStartTime) < fWait then
        begin
          if IsWindowVisible(fFormHandle) then
            SetWindowPos(fFormHandle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE or
                                                         SWP_NOSIZE or
                                                         SWP_HIDEWINDOW);
          Sleep(0);
          continue;
        end;
 
        if not IsWindowVisible(fFormHandle) then
        begin
          DC := GetDC(fFormHandle);
          Canvas := TCanvas.Create;
          try
            Canvas.Handle:=DC;
            Canvas.Font.Name:='MS Sans Serif';
            Canvas.Font.Size:=16;
            Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
 
            DPDetermineTextSize(Canvas,gDPTextMessage,x,y);
            x:=x+10; //po 5px marginasu z obu stron
            y:=y+20;
            SetWindowPos(fFormHandle,HWND_TOPMOST,round((Screen.Width-x)/2),
                                                 round((Screen.Height-y)/2),x,y,SWP_SHOWWINDOW);
            {$WARNINGS OFF}
            Win32Check(UpdateWindow(fFormHandle));
            {$WARNINGS ON}
          finally
            FreeAndNil(Canvas);
          end;
        end;
 
        Sleep(0);
      end;
    finally
      CloseWindow(fFormHandle);
    end;
  end;
 
  procedure TMyThread.ThreadTerminate(Sender: TObject);
  begin
    gDPThread:=nil;
  end;
 
  procedure DPStartWaiting(ShowAfter : LongWord; TextMessage : String);
  begin
    gDPCriticalSection.Enter;
    try
      inc(gDPExecCount);
      gDPTextMessage:=TextMessage;
      if gDPThread = nil  then
        gDPThread:=TMyThread.Create(ShowAfter)
      else if gDPThread.Suspended then
        gDPThread.Restore(ShowAfter);
    finally
      gDPCriticalSection.Leave;
    end
  end;
 
  procedure DPEndWaiting;
  begin
    if  gDPExecCount > 0  then
    begin
      gDPCriticalSection.Enter;
      try
        dec(gDPExecCount);
        if  (gDPExecCount=0)and(gDPThread<>nil)  then
        begin
          //Watek.Priority := tpHigher;
          //Watek.Terminate;
          gDPThread.FallAsleep;
        end
      finally
        gDPCriticalSection.Leave
      end
    end;
  end;
 
  procedure TMyThread.FallAsleep;
  begin
    self.fFallAsleep:=true;
  end;
 
  procedure TMyThread.Restore(WaitingTime: Cardinal);
  begin
    fWait:=WaitingTime;
    fStartTime := GetTickCount;
    fFallAsleep:=false;
    self.Resume;
  end;
 
initialization
 
  with gDPWnd do
  begin
    lpfnWndProc := @MyWndProc;
    hInstance := hInstance;
    lpszClassName := 'TFrmKomunikatProszeCzekac';
    hbrBackground := COLOR_WINDOW;
  end;
 
  Windows.RegisterClass(gDPWnd);
 
  gDPExecCount := 0;
  gDPThread := nil;
  gDPCriticalSection := TCriticalSection.Create;
 
finalization
 
  if Assigned(gDPThread) then
  begin
    gDPExecCount:=0;
    gDPThread.Terminate;
    gDPThread:=nil;
  end;
 
  FreeAndNil(gDPCriticalSection);
end.

Open in new window

0
 
LVL 37

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 250 total points
ID: 22783831
nice code

but call the inherited constructor first
that way your own initialisations won't be overriden by the inherited one

just imagine the inherited constructor sets
FreeOnTerminate to false
and OnTerminate to nil
and then trying to find the problem

 constructor TMyThread.Create(WaitingTime: Cardinal);
  begin
    inherited  Create(false);

    fWait:=WaitingTime;
    fStartTime := GetTickCount;
 
    FreeOnTerminate := true;
    OnTerminate := ThreadTerminate;
    fFallAsleep:=false;
  end;


why do you call inherited Execute ?
imagine this thread being inherited from TYourThread and that thread does the same as your code
your Execute procedure will never execute unless the App gets terminated
procedure TMyThread.Execute;
  begin
    inherited;

why not use the VCL ?
 
you have a thread running from the first time you use the wait proc until the end of the program
why ???

i gues this would probably work in OWL too ? the version before Delphi :)
it's for Delphi 6 !!! keep it simple



 procedure TMyThread.Execute;
  var
    aForm: TWaitForm; // designed with the IDE ...
  begin
    // inherited; scary !!!
 
    aForm := TWaitForm.Create(Application);
    try
      while true do
      begin
        if Terminated then break;
 
        if fFallAsleep then
        begin
           aForm.Hide;
           Suspend;
        end;
 
        if (GetTickCount - fStartTime) >= fWait then
        begin
          if not aForm.Visible then 
          begin
            aForm.Canvas.Font.Name:='MS Sans Serif';
            aForm.Canvas.Font.Size:=16;
            aForm.Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
 
            DPDetermineTextSize(aForm.Canvas,gDPTextMessage,x,y);
            x:=x+10; //po 5px marginasu z obu stron
            y:=y+20;
            aForm.Left := round((Screen.Width-x)/2); 
            aForm.Top := round((Screen.Height-y)/2); // no mention of Taskbar ???
            aForm.Width := x;
            aForm.Height := y;
            aForm.Show;
            aForm.BringToFront;
            aForm.Update;
          end;
        end else 
        begin
          aForm.Show;
          aForm.BringToFront;
          aForm.Update;
        end;
 
        Sleep(0);
      end;
    finally
      FreeAndNil(aForm);
    end;
  end;

Open in new window

0
 
LVL 4

Expert Comment

by:dprochownik
ID: 22784043
I wrote this code few years ago, with much less skills :)

1)
You are right about inherited in Execute, It should be removed.

2)
About inherited in contructor it shoud be at the begginig. My mistake, or rather overlook, because it works :D. Yes, its opposite to programming rules but works.

3)
I'm not using VCL because it don't wokrs :D, at least in D7 which I was using at that time.
 
My intention it to show processing message only if some operation takes to much time, to show user that application didn't hang.
BUT
I don't wan't show that message before I start execute my processing code because it can end in acceptable time and there is no need to show anythig. It just irritades users, when processing messages are often flashing for short time.

VCL is not multi threaded.
For example: when in main application thread I will start executing of some complicated SQL over IBX, which is not calling application.processmessages before SQL server respond, then I can't show any VCL window even from other threads before query will end. Or rather I can change visible property, but window will not show before my query end.
The simplest way to omit that problem is not using VCL.

4) I don't remeber why I'm not finishing my process. Perhaps because I'm using that function quite often and I thought that suspending thread will be faster than creating it every time.
I know, perfomance can be omited in this case :)

0
 

Author Closing Comment

by:rincewind666
ID: 31507586
Many thanks for your help.  Greatly appreciated.
0
 

Author Comment

by:rincewind666
ID: 22849285
Many thanks for your help.  Greatly appreciated.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

In our object-oriented world the class is a minimal unit, a brick for constructing our applications. It is an abstraction and we know well how to use it. In well-designed software we are not usually interested in knowing how objects look in memory. …
Update (December 2011): Since this article was published, the things have changed for good for Android native developers. The Sequoyah Project (http://www.eclipse.org/sequoyah/) automates most of the tasks discussed in this article. You can even fin…
THe viewer will learn how to use NetBeans IDE 8.0 for Windows to perform CRUD operations on a MySql database.
The viewer will learn how to synchronize PHP projects with a remote server in NetBeans IDE 8.0 for Windows.

762 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