Класс позволяет вывести на экран псевдомодальное окно и обновлять сообщения в нем, не прерывая выполнения некоторой длительной операции в основном потоке приложения.
Класс используетмя примерно следующим образом
procedure TSomeForm.SomeActionExecute ;
begin
try
MessageForm.Show('Какое-то действие', 'Начало...');
{ ... }
MessageForm.Text('В процессе...');
{ ... }
MessageForm.Text('Конец операции...');
{ ... }
finally
MessageForm.Close ;
end ;
end ;
Вызовы Show и Close могут быть вложенными, но должна соблюдаться парность. Это позволяет вызывать одну подпрограмму, использующую класс, из другой подпрограммы, также использующей класс.
При каждом вызове подпрограмм выполняется также Application.ProcessMessages . Существующие на момент первого (самого внешнего) вызова Show формы блокируются тем же механизмом, что и в случае TCustomForm.ShowModal; таким образом, несмотря на обработку сообщений, их кнопки и другие элементы управления остаются недоступными.
Вызов подпрограммы Close следует размещать в секции finally, так как в противном случае окно сообщений может остаться на экране, в то время как другие формы будут недоступны.
unit Splash ;
interface
uses Classes, SysUtils, Forms, Controls, ExtCtrls ;
type
{ Статический класс "окна сообщений" }
MessageForm = class
public
class procedure Show ( const ACaption, AMessage : string ) ;
class procedure Text ( const AMessage : string ) ;
class procedure Close ;
end ;
implementation
var
{ Окно и необходимые ему переменные }
MsgForm : TForm ;
MsgPanel : TPanel ;
MsgDepth : integer = 0 ;
ListDisabled : pointer = nil ;
{ Инициализация окна }
procedure CreateMessageForm ;
begin
MsgForm := TForm.Create ( nil ) ;
with MsgForm do
begin
BorderIcons := [] ;
BorderStyle := bsDialog ;
Position := poScreenCenter ;
ClientHeight := 40 ;
ClientWidth := 350 ;
end ;
MsgPanel := TPanel.Create ( nil ) ;
with MsgPanel do
begin
Align := alClient ;
BevelInner := bvLowered ;
Parent := MsgForm ;
end ;
end ;
{ Запуск окна с сообщением }
class procedure MessageForm.Show ( const ACaption, AMessage : string ) ;
begin
Text ( AMessage ) ;
if MsgDepth > 0
then Inc ( MsgDepth )
else
begin
MsgForm.Caption := ACaption ;
MsgForm.Show ;
ListDisabled := DisableTaskWindows ( MsgForm.Handle ) ;
MsgDepth := 1 ;
Application.ProcessMessages ;
end ;
end ;
{ Изменение текста в окне }
class procedure MessageForm.Text ( const AMessage : string ) ;
begin
MsgPanel.Caption := AMessage ;
Application.ProcessMessages ;
end ;
{ Закрытие формы }
class procedure MessageForm.Close ;
begin
if MsgDepth > 1
then Dec ( MsgDepth )
else
begin
EnableTaskWindows ( ListDisabled ) ;
ListDisabled := nil ;
MsgForm.Close ;
MsgDepth := 0 ;
end ;
end ;
initialization
CreateMessageForm ;
finalization
FreeAndNil ( MsgForm ) ;
end.
Автор: http://www.softwarer.ru
|