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

我通常有一个TPanel，其中“请等待”标题以我的表单为中心，在所有内容之上，Visibe设置为false。当我开始一个工作时，我将Visible设置为true（可选地调用update以确保它被绘制），然后设置为false（理想情况下在finally子句中）。

如果执行该工作的代码允许某些代码在中间运行，则可以从定时开始一秒钟（或其他一些intercal），然后将Visible设置为true，可选地更新进程信息并调用表单的Update确保更改被绘制到屏幕上。

Answer 3

我通常会在项目中添加一个表单，如下所示：

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;

只是一个想法，改进取决于你。

Answer 4

我显示了一条快速消息的提示，某事。像这样：

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 5

如果您的应用程序在此短暂时间内正在工作且未处理任何消息，则可以执行

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 6

我觉得这太过分了。没有“魔力”。有一个窗口提出特定的属性需要大量的信息来描述这些特定的属性，而这必须来自某个地方。赋予它特定的行为意味着必须来自某个地方的代码。 VCL使它变得更容易，但您仍需要设置表单。

我只是在表单设计器中设置了一个正确大小的表单。给它一个bsNone的BorderStyle，你就得不到关闭框了。（但也没有边框。或者你可以把它变成bsDialog并给它一个总是将CanClose设置为false的OnCloseQuery事件。）给它一个说“请等待”的TLabel和一个在2秒后调用Self.Release的TTimer。 / p>

不是Code-Golf-ish，但它会起作用并且设置起来很简单。

用Delphi写一个请等待屏幕最简单的方法是什么？

6 个答案: