Организация диалоговых окон в Delphi

Опубликовано: Delphi
Организация диалоговых окон в Delphi

В этой статье речь пойдет об организации диалоговых окон в Delphi, которые обычно вызываются процедурой ShowMessage и подобными стандартными процедурами. При этом вы получаете стандартное окно такого типа. Например, если вызвать процедуру:

ShowMessage('Это стандартное системно окно сообщения');

При этом мы получим вот такие окно:

Стандартное окно диалога в Delphi

Как видите это не очень красивое окно. Его смысл в том, чтобы что-то быстро написать на коленке и не более того. Хотя оно модальное и полностью выполняет свою функцию, но это не то, что хотело бы видеть большинство программистов и пользователей программ.

Давайте сделаем свое окно. Я решил сделать четыре типа окна:

  • окно с вопросом для пользователя;
  • окно с сообщением для пользователя;
  • окно с предложением сохранить измененные на форме данные;
  • окно, предупреждающее о том, что производится попытка удаления данных.

Окно с вопросом для пользователя

Обычно в таком окне задается какой-либо вопрос, требующий подтверждения или отказа. Например, такое окно может выглядеть так:

Окно с вопросом пользователю в Delphi
Окно с вопросом пользователю в Delphi

Может выглядеть и по другому. Все зависит от оформления. Сами кнопки могут называться как «Да/Нет» или «Принять/Отменить» и т.п.

В кнопке «Да» напишем простой код:

procedure TfrmQuestion.cmdYesClick(Sender: TObject);
begin
    bModal:=true;
    Close;
end;

В кнопке «Отмена»:

procedure TfrmQuestion.cmdCancelClick(Sender: TObject);
begin
    bModal:=false;
    Close;
end;

И в событии onFromClose:

procedure TfrmQuestion.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action:=TCloseAction.caFree;
   frmQuestion:=nil;
end;

Саму форму назовем frmQuestion. Полный код формы:

unit question_;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Effects, FMX.Objects;

type
  TfrmQuestion = class(TForm)
    cmdCancel: TButton;
    lblMessage: TLabel;
    cmdYes: TButton;
    StyleBook1: TStyleBook;
    recClient: TRectangle;
    ShadowEffect1: TShadowEffect;
    procedure cmdCancelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmdYesClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmQuestion: TfrmQuestion;

implementation

{$R *.fmx}

uses mdi;

procedure TfrmQuestion.cmdCancelClick(Sender: TObject);
begin
    bModal:=false;
    Close;
end;

procedure TfrmQuestion.cmdYesClick(Sender: TObject);
begin
    bModal:=true;
    Close;
end;

procedure TfrmQuestion.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action:=TCloseAction.caFree;
   frmQuestion:=nil;
end;
end.

Переменная bModal — это обычная глобальная переменная типа boolean, которую можно объявить в главной форме приложения.

Окно с сообщением для пользователя

Аналогичным образом создается окно с сообщением для пользователя. Назовем его frmMessage:

Окно с сообщением для пользователя в Delphi
Окно с сообщением для пользователя в Delphi

Полный код данного окна:

unit message_;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.Effects;

type
  TfrmMessage = class(TForm)
    cmdClose: TButton;
    lblMessage: TLabel;
    StyleBook1: TStyleBook;
    recClient: TRectangle;
    ShadowEffect1: TShadowEffect;
    procedure cmdCloseClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMessage: TfrmMessage;

implementation

{$R *.fmx}

procedure TfrmMessage.cmdCloseClick(Sender: TObject);
begin
   Close;
end;

procedure TfrmMessage.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action:=TCloseAction.caFree;
   frmMessage:=nil;
end;
end.

Как видим, здесь всего три строчки кода, не считая автоматически сгенерированного средой Delphi.

Окно с предложением сохранить измененные на форме данные

Данное окно назовем frmPost:

Окно с запросом на сохранение данных в Delphi
Окно с запросом на сохранение данных в Delphi

Код окна:

unit post_;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Effects, FMX.Objects;

type
  TfrmPost = class(TForm)
    cmdCancel: TButton;
    lblMessage: TLabel;
    cmdYes: TButton;
    cmdNo: TButton;
    StyleBook1: TStyleBook;
    recClient: TRectangle;
    ShadowEffect1: TShadowEffect;
    procedure cmdCancelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmdYesClick(Sender: TObject);
    procedure cmdNoClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmPost: TfrmPost;

implementation

{$R *.fmx}

uses mdi;

procedure TfrmPost.cmdCancelClick(Sender: TObject);
begin
   sPost:='Отмена';
   Close;
end;

procedure TfrmPost.cmdNoClick(Sender: TObject);
begin
   sPost:='Нет';
   Close;
end;

procedure TfrmPost.cmdYesClick(Sender: TObject);
begin
   sPost:='Да';
   Close;
end;

procedure TfrmPost.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action:=TCloseAction.caFree;
   frmPost:=nil;
end;
end.

Если в первом окне была логическая переменная bModal, то в данном текстовая переменная sPost, которая также может быть объявлена в главной форме приложения.

Окно, предупреждающее о том, что производится попытка удаления данных

Ну и последнее окно — окно с запросом на удаление данных, которое мы назовем frmDelete:

Окно с запросом на удаление данных в Delphi
Окно с запросом на удаление данных в Delphi

Полный под формы данного окна:

unit delete_;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Effects, FMX.Objects;

type
  TfrmDelete = class(TForm)
    cmdCancel: TButton;
    lblMessage: TLabel;
    cmdDelete: TButton;
    StyleBook1: TStyleBook;
    recClient: TRectangle;
    ShadowEffect1: TShadowEffect;
    procedure cmdCancelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure cmdDeleteClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmDelete: TfrmDelete;

implementation

{$R *.fmx}

uses mdi;

procedure TfrmDelete.cmdCancelClick(Sender: TObject);
begin
   bModal:=false;
   Close;
end;

procedure TfrmDelete.cmdDeleteClick(Sender: TObject);
begin
   bModal:=true;
   Close;
end;

procedure TfrmDelete.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action:=TCloseAction.caFree;
   frmDelete:=nil;
end;
end.

Организация взаимодействия диалоговых окон

Теперь, когда у нас есть готовые модули четырех типов окон, можем рассмотреть принцип использования.

Использовать перечисленные формы очень просто. В нужный момент их надо просто создавать из кода вот и все. Но при каждом создании желательно указывать координаты их появления. Можно конечно их всегда выводить в центре рабочего стола, но это не эстетично.

Более интересно и красиво, когда они выводятся в центре того окна, из которого они вызываются. А еще под них можно сделать затемненную подложку. То есть между формой, из которой вызывается модальное окно и самим модальным окном сделаем затемненную подложку — полупрозрачную форму без рамок. Мы назовем ее frmGray и у нее будет всего одна процедура onFormClose:

unit gray_;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects;

type
  TfrmGray = class(TForm)
    Rectangle1: TRectangle;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmGray: TfrmGray;

implementation

{$R *.fmx}

procedure TfrmGray.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   Action:=TCloseAction.caFree;
   frmGray:=nil;
end;
end.

В конструкторе форм мы лишь зададим данной форме полупрозрачный цвет. Это вы можете сделать на свое усмотрение, а потом подрегулировать. Также мы укажем у свойства FormStyle значение Normal и WindowState = wsMaximized. Не забудьте убрать рамку формы.

Затем мы создадим модуль dialogs_:

unit dialogs_;
interface
uses
  Windows, Messages, FMX.Forms, SysUtils, gray_, question_, mdi, message_, post_, delete_,
  UITypes;

  procedure QuestionCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
  procedure MessageCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
  procedure PostCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
  procedure DeleteCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);

implementation

procedure QuestionCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
begin
    Application.CreateForm(TfrmGray,frmGray);
    frmGray.Show;
    Application.CreateForm(TfrmQuestion, frmQuestion);
    frmQuestion.Left:=Round(Left +(Width-frmQuestion.Width)/2);
    frmQuestion.Top:=Round(Top +(Height-frmQuestion.Height)/2+20);
    frmQuestion.lblMessage.Text:=Text;
    frmQuestion.ShowModal;
    frmGray.Close;
end;

procedure MessageCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
begin
    Application.CreateForm(TfrmGray,frmGray);
    frmGray.Show;
    Application.CreateForm(TfrmMessage, frmMessage);
    frmMessage.Left:=Round(Left +(Width-frmMessage.Width)/2);
    frmMessage.Top:=Round(Top +(Height-frmMessage.Height)/2+20);
    frmMessage.lblMessage.Text:=Text;
    frmMessage.ShowModal;
    frmGray.Close;
end;

procedure PostCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
begin
    Application.CreateForm(TfrmGray,frmGray);
    frmGray.Show;
    Application.CreateForm(TfrmPost, frmPost);
    frmPost.Left:=Round(Left +(Width-frmPost.Width)/2);
    frmPost.Top:=Round(Top +(Height-frmPost.Height)/2+20);
    frmPost.lblMessage.Text:=Text;
    frmPost.ShowModal;
    frmGray.Close;
end;

procedure DeleteCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
begin
    Application.CreateForm(TfrmGray,frmGray);
    frmGray.Show;
    Application.CreateForm(TfrmDelete, frmDelete);
    frmDelete.Left:=Round(Left +(Width-frmDelete.Width)/2);
    frmDelete.Top:=Round(Top +(Height-frmDelete.Height)/2+20);
    frmDelete.lblMessage.Text:=Text;
    frmDelete.ShowModal;
    frmGray.Close;
end;
end.

Обратите внимание на процедуры этого модуля:

procedure QuestionCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
procedure MessageCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
procedure PostCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);
procedure DeleteCreate(Left: integer; Top: integer; Height: integer; Width: integer; Text: String);

В каждую из этих процедур передаются габариты и координаты формы, из которой вызывается одно из четырех наших модальных окон. Конечный параметр Text является передаваемой текстовой строкой — сообщение, которое будет появляться в центре окна.

Здесь в секции uses обязательно должны быть подключены все наши создаваемые ранее модули.

Теперь посмотрим на несколько примеров того, как мы можем вызывать свои созданные модальные окна вместо системных.

Например, у нас есть форма frmRacks и мы собираемся удалить запись из набора данных fdRacks, расположенного на этой форме. Для этого у набора данных fdRacks в событии onBeforeDelete, возникающее перед непосредственным удалением записи из набора данных, мы напишем следующий обработчик:

procedure TfrmRacks.fdRacksBeforeDelete(DataSet: TDataSet);
begin
    DeleteCreate(Left,Top,Height,Width,'Удалить стойку?');
    if bModal=false then abort;
end;

Мы вызываем нашу процедуру DeleteCreate и передадим в нее размеры и координаты нашей формы frmRacks, а также сообщение, которое мы хотим видеть в окне.

При этом, если мы вернемся в процедуру DeleteCreate, то увидим, что в ней мы создавали окно frmDelete. И после создания мы написали, что будем показывать его как ShowModal, то есть, как модальное. Это значит, что код программы в одном текущем потоке остановится, пока мы не закром данное окно.

Следовательно из двух строк нашей процедуры procedure onBeforeDelete будет выполнена только первая. Вторая строка, 

if bModal=false then abort;

будет выполнена после закрытия модального окна. А мы вспомним, что когда мы закрываем окно, то мы делаем это одной из двух кнопок, либо «Удалить», либо «Отмена». Когда мы нажимаем н а кнопку «Отмена», то глобальная переменная bModal принимает значение false. Если так, то получается пользователь отказался от удаления (передумал), а значит можно написать команду abort и прекратить удаление.

Результат же команды

DeleteCreate(Left,Top,Height,Width,'Удалить стойку?');

будет такой:

Окно с запросом на удаление данных в режиме выполнения
Окно с запросом на удаление данных в режиме выполнения

Видите, для чего нужно затемнение? Если его убрать, то наше модальное окно сольется основным. Ну и теперь наше окно конечно же не похоже на стандартное окно приложения, а выполнено в единой стилистике.

Остальные перечисленные окна вызываются точно также, как и frmDelete, только нужно будет вызывать соответствующие процедуры из модуля unit dialogs_.

0
Понравилась статья? Поделиться с друзьями:
Вам также может быть интересно
Проверка даты на полноту ввода в FMX Delphi
Delphi 0
Проверка маски на полноту ввода в FMX Delphi — часть 1
В статье «Компонент маски в FMX Delphi» мы рассмотрели способы организации маски ввода для
Компонент маски в FMX Delphi
Delphi 0
Компонент маски в FMX Delphi
Как известно, во фреймворке FMX для Delphi отсутствует компонент маски. И это очень не
Работа с INI-файлами в Delphi
Delphi 0
Работа с INI-файлами в Delphi
INI-файлы являются прекрасным способом сохранения какой-либо служебной информации в разрабатываемых приложениях. Конечно это не
Access violation at adress
Delphi 0
Delphi, FMX, FireDAC, MySQL и Access violation at adress…
Сообщение операционной системы Access violation at adress... является не редким. Одна из причин его
BLOB Delphi
Delphi 0
BLOB — поля и Delphi
BLOB (от англ. Binary Large Object — «большой двоичный объект») — тип данных в базах данных.
Скачать и установить FastReport для Delphi
Delphi 0
Скачать и установить FastReport для Delphi
Ранее в статье «Установка пакетов FastReport VCL в Delphi» уже был рассмотрен один из
Добавить комментарий

;-) :| :x :twisted: :smile: :shock: :sad: :roll: :razz: :oops: :o :mrgreen: :lol: :idea: :grin: :evil: :cry: :cool: :arrow: :???: :?: :!: