Какой самый простой способ написать экран ожидания с Delphi?

Question

Я просто хочу, чтобы быстрый и грязный немодальный, не закрываемый экран, который всплывает и уходит, чтобы сделать 2 секунды, кажется более ... 1 секунда. Использование 3-5 строк кода.

Слишком много, чтобы спросить?

Answer 1

Если вы хотите сделать все программно (то есть, если вы не хотите, чтобы разработать свою форму в виде конструктора Delphi), чем вы можете написать

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; 

в новом блоке. Тогда вы всегда можете вызвать следующие функции:

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

Answer 2

Если приложение делает работу и не обрабатывает никаких сообщений в течение этого короткого периода времени, вы можете просто сделать

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

где Form4 является «Пожалуйста, подождите» форму (которая fsStayOnTop) и Sleep(2000) Символизирует проделанная работа.

Теперь лучший способ сделать это на заднем плане (возможно, в отдельном потоке), или, по крайней мере, вы должны ProcessMessages время от времени в медленном процессе. Если вы сделаете последнее, эквивалент Sleep(2000) все равно не вернется, пока процесс не будет завершен, но вам нужно написать

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

в «Пожалуйста, подождите» диалоговое окно, поэтому он не может быть закрыт (даже с Alt + F4).

Если вы используете темы или что-то еще более сложное, я думаю, что мне понадобится дополнительная информация, чтобы предоставить соответствующий ответ.

Answer 3

Я думаю, что это слишком много, чтобы спросить. Нет «волшебства». При наличии окна с определенными атрибутами требуется много информации для описания этих конкретных атрибутов, и это должно происходить откуда-то. Придание этому конкретному поведению означает код, который должен откуда-то исходить. VCL делает это намного проще, но вам все равно нужно настроить форму.

Я только что установил форму нужного размера в Designer Design. Дайте ему BorderStyle bsNone, и вы не получите закрытого окна. (Но и никакой границы. Или вы можете сделать это bsDialog и дать ему событие OnCloseQuery, которое всегда устанавливает CanClose в false.) Дайте ему TLabel, который говорит «Please Wait», и TTimer, который вызывает Self.Release через 2 секунды.

Не очень Code-Golf-ish, но он будет работать, и его просто настроить.

Answer 4

Я обычно добавить форму в проект, как это:

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 

в то время как блок выглядит следующим образом:

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. 

вы называете это так:

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; 

только a i деа, изысканность зависит от вас.

Answer 5

У меня обычно есть TPanel с надписью «Подождите», сосредоточенной на моей форме, поверх всего, с Visibe, установленным на false. Когда я запускаю задание, я устанавливаю Visible в true (необязательно вызывая обновление, чтобы убедиться, что он нарисован), а затем - false (в идеале в предложении finally).

Если код, выполняющий эту работу, позволяет запускать некоторый код между ними, вы можете начать с синхронизации на второй (или какой-либо другой интеркаль) и только затем установить видимый на true, опционально обновить информацию о процессе и вызвать форму Обновите, чтобы изменения отображались на экране.

Answer 6

Я покажу вам подсказку для быстрого вызова. например:

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;