I just want a quick and dirty non-modal, non-closable screen that pops up and goes a开发者_开发问答way to make 2 seconds seem more like... 1 second. Using 3-5 lines of code.
Is this too much to ask?
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;
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.
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.
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;
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.
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.
精彩评论