Solved

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

Posted on 2008-10-19
8
1,689 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
  • 2
  • 2
  • 2
  • +2
8 Comments
 
LVL 28

Expert Comment

by:ciuly
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 36

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
 
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 36

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

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.

Join & Write a Comment

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…
This tutorial covers a step-by-step guide to install VisualVM launcher in eclipse.
The viewer will learn how to synchronize PHP projects with a remote server in NetBeans IDE 8.0 for Windows.

757 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

20 Experts available now in Live!

Get 1:1 Help Now