What's the easiest way to write a please wait screen with Delphi?

Question

I just want a quick and dirty non-modal, non-closable screen that pops up and goes away to make 2 seconds seem more like... 1 second. Using 3-5 lines of code.

Answer 1

If you want to do everything programmatically (that is, if you do not want to design your form in the Delphi form designer), than you can write

type
  TStatusWindowHandle = type HWND;

function CreateStatusWindow(const Text: string): TStatusWindowHandle;
var
  FormWidth,
  FormHeight: integer;
begin
  FormWidth := 400;
  FormHeight := 164;
  result := CreateWindow('STATIC',
                         PChar(Text),
                         WS_OVERLAPPED or WS_POPUPWINDOW or WS_THICKFRAME or SS_CENTER or SS_CENTERIMAGE,
                         (Screen.Width - FormWidth) div 2,
                         (Screen.Height - FormHeight) div 2,
                         FormWidth,
                         FormHeight,
                         Application.MainForm.Handle,
                         0,
                         HInstance,
                         nil);
  ShowWindow(result, SW_SHOWNORMAL);
  UpdateWindow(result);
end;

procedure RemoveStatusWindow(StatusWindow: TStatusWindowHandle);
begin
  DestroyWindow(StatusWindow);
end;

in a new unit. Then you can always call these functions like this:

procedure TForm3.Button1Click(Sender: TObject);
var
  status: TStatusWindowHandle;
begin
  status := CreateStatusWindow('Please Wait...');
  try
    Sleep(2000);
  finally
    RemoveStatusWindow(status);
  end;
end;

Answer 2

I show a hint for a quick message, sth. like this:

function ShowHintMsg(Form: TForm; Hint: string): THintWindow;
var
  Rect: TRect;
begin
  Result := THintWindow.Create(nil);
  Result.Canvas.Font.Size := Form.Font.Size * 2;
  Rect := Result.CalcHintRect(Form.Width, Hint, nil);
  OffsetRect(Rect, Form.Left + (Form.Width - Rect.Right) div 2,
                   Form.Top + (Form.Height - Rect.Bottom) div 2);
  Result.ActivateHint(Rect, Hint);

// due to a bug/design in THintWindow.ActivateHint, might not be
// necessary with some versions.
  Result.Repaint;
end;

procedure HideHintMsg(HintWindow: THintWindow);
begin
  try
    HintWindow.ReleaseHandle;
  finally
    HintWindow.Free;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  HintWindow: THintWindow;
begin
  HintWindow := ShowHintMsg(Self, 'Please Wait...');
  try

    Sleep(2000);  // do processing.

  finally
    HideHintMsg(HintWindow);
  end;
end;

Answer 3

I think that's too much to ask. There's no "magic." Having a window come up with specific attributes takes a lot of information to describe those specific attributes, and that has to come from somewhere. Giving it specific behavior means code that has to come from somewhere too. The VCL makes it a lot easier, but you still need to set up the form.

I'd just set up a form of the right size in the Form Designer. Give it a BorderStyle of bsNone, and you get no close box. (But no border either. Or you can make it bsDialog and give it an OnCloseQuery event that always sets CanClose to false.) Give it a TLabel that says "Please Wait," and a TTimer that calls Self.Release after 2 seconds.

Not very Code-Golf-ish, but it'll work and it's simple to set up.

Answer 4

I generally have a TPanel with a 'Please wait' caption centered on my form, on top of everything, with Visibe set to false. When I start a job, I set Visible to true (optionally calling update to be sure it gets drawn), and to false afterwards (ideally in a finally clause).

If the code that does the work allows for some code to get run inbetween, you could start by timing for a second (or some other intercal) and only then set Visible to true, optionally updating process information and calling the form's Update to be sure the changes get drawn to the screen.

Answer 5

If your application is doing work and not processing any messages during this brief period, you can just do

procedure TForm3.Button1Click(Sender: TObject);
begin
  Form4.Show;
  try
    Sleep(2000);
  finally
    Form4.Hide;
  end;
end;

where Form4 is the "please wait" form (which is fsStayOnTop), and Sleep(2000) symbolizes the work done.

Now, the best way to do things is in the background (maybe in a separate thread), or at least you should ProcessMessages once in a while in slow process. If you do the latter, the equivalent of Sleep(2000) will still not return until the process is complete, but you need to write

procedure TForm4.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := false;
end;

in the "please wait" dialog so it cannot be closed (not even with Alt+F4).

If you are using threads or something else more sophisticated, I think that I'll need more details in order to provide an appropriate answer.

Answer 6

I usually add a form to the project, like this:

dfm:

object WaitForm: TWaitForm
  Left = 0
  Top = 0
  AlphaBlend = True
  AlphaBlendValue = 230
  BorderIcons = []
  BorderStyle = bsNone
  Caption = 'Please wait...'
  ClientHeight = 112
  ClientWidth = 226
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poMainFormCenter
  OnCloseQuery = FormCloseQuery
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 226
    Height = 112
    Align = alClient
    BevelInner = bvLowered
    Caption = 'Please wait...'
    Color = clSkyBlue
    ParentBackground = False
    TabOrder = 0
  end
end

while unit looks like this:

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TWaitForm = class(TForm)
    Panel1: TPanel;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    FCanClose: Boolean;
  public
    { Public declarations }
    class function ShowWaitForm: TWaitForm;
    procedure AllowClose;
  end;

var
  WaitForm: TWaitForm;

implementation

{$R *.dfm}

{ TWaitForm }

procedure TWaitForm.AllowClose;
begin
  FCanClose := True;
end;

procedure TWaitForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := FCanClose;
end;

class function TWaitForm.ShowWaitForm: TWaitForm;
begin
  Result := Self.Create(Application);
  Result.Show;
  Result.Update;
end;

end.

you call it like this:

procedure TForm2.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  with TWaitForm.ShowWaitForm do
    try
      for I := 1 to 100 do
        Sleep(30);
    finally
      AllowClose;
      Free;
    end;
end;

just an idea, refinements is up to you.