Улучшение вспомогательных окон среды Delphi

2005 г.

Улучшение вспомогательных окон среды Delphi

Владимир Коднянко, «Королевство Delphi»

В практике программирования в среде часто приходится пользоваться вспомогательными окнами, в которых необходимо вывести сообщение - однострочное или многострочное или задать вопрос (также однострочный или многострочный) с тем, чтобы получить от пользователя программы ответ, который необходим для разрешения какой-либо ситуации. Задача эта простая и даже для малоопытного программиста не представляет особых затруднений: можно использовать процедуру ShowMessage, функцию MessageDlgPos стандартного модуля Dialogs.pas или подобные им подпрограммы. Однако есть несколько "но":

для ускорения программирования или отладки программы обычно возникает потребность в том, чтобы с наименьшими затратами времени программировать вывод констант и значений переменных наиболее часто используемых типов (обычно строковых и числовых) с помощью одной или нескольких "подручных" подпрограмм, не тратя время на конвертацию из одного типа в другой (чаще строковый); для большинства случаев это можно сделать воспользовавшись, например, типом Variant;
использование стандартных подпрограмм, например ShowMessage, иногда не удовлетворяет программиста по той причине, что это окно всегда выводится в центре экрана, и если окно приложения находится в этот момент не в центре, а в каком-нибудь углу экрана, то такое расположение окон нежелательно; можно, конечно, воспользоваться другой подпрограммой, позволяющей позиционировать окно где угодно, но "угадать", где в данный момент находится активное окно, обычными средствами непросто; наиболее приемлемой можно считать ситуацию, когда окно вопроса или сообщения имеет общий центр с активной формой, однако "не теряется" за пределами экрана если в большом окне активной формы ее центр находится вне экрана;
площадь стандартных окон достаточно велика из-за неоправданно низкого расположения рисунка и кнопок в окне, а также довольно большого расстояния от кнопок до нижнего края окна; можно также улучшить вывод надписи на метке, позиционируя ее по отношению к рисунку в зависимости от числа строк на метке; такие изменения позволят, во-первых, уменьшить высоту окна и, во-вторых, улучшить расположение надписи на нем;
если на компьютер устанавливается Delphi (англоязычная), то чтобы надписи в окнах сообщений и вопросов (в заголовках, на кнопках) были русскоязычными, надо затратить дополнительные усилия по русификации надписей, что требует отдельной работы: здесь желательно иметь подпрограммы, которые способны сразу "выдавать" надписи в окнах на русском языке вне зависимости от того, русифицирована Delphi или нет.

Разрешение этих "но" является целью настоящего сообщения.

Прежде нужно создать новый unit или добавить низлежащий код в уже имеющийся подходящий unit и объявить несколько переменных, которые потребуются для автоматической русификации надписей. Их лучше разместить в секции implementation выше текстов приведенных ниже подпрограмм.

var
  // кнопки
  ButtonEngCaptions: array[1..11] of string =
      ('Yes', 'No', 'OK', 'Cancel',
      'Abort', 'Retry', 'Ignore',
      'All', 'NoToAll','YesToAll',
      'Help');
  ButtonRusCaptions: array[1..11] of string =
      ('Да', 'Нет', 'OK', 'Отмена',
      'Прервать','Повтор', 'Пропуск',
      'Все', 'Нет Всем','Да Всем',
      'Помощь');
  // заголовки окон
  MsgEngCaptions: array[1..4] of string =
      ('Confirm', 'Information', 'Warning', 'Error');
  MsgRusCaptions: array[1..4] of string =
      ('Подтвердите', 'Сообщение','Предупреждение','Ошибка');

Далее возьмем стандартную функцию MessageDlgPosHelp модуля Dialogs.pas и коррекцией ее кода создадим новую функцию KdnMessageDlg (текст функции снабжен необходимыми комментариями):

function KdnMessageDlg(MsgVariant: string;
                       DlgType: TMsgDlgType;
                       Buttons: TMsgDlgButtons): Integer;
  var w1,w2,h1,h2,t2,L2,cx,cy: Integer;
      ScreenActFormVisBoo: boolean;
      i,j: Integer;
      F: TForm;
      Msg,s: ^String;
begin
  New(Msg); New(s);
  Msg^:= MsgVariant; // конвертируем Variant в строку
  F:= CreateMessageDialog(Msg^,DlgType,Buttons);
  with F do
   try
    w1:=0; w2:=0; h1:= 0; // рабочие переменные

    // русифицируем надпись на шапке F-формы
    for i:= 1 to 4 do
     if Caption = MsgEngCaptions[i]
     then Caption:= MsgRusCaptions[i];

    // изменяем положение элементов формы и русифицируем кнопки
    for i:= 0 to F.ComponentCount-1 do
     begin

      // приподнимаем рисунок
      if F.Components[i] is TImage then
       With F.Components[i] as TImage do
        Top:= Top-4;

      // позиционируем метку относительно рисунка
      // в зависимости от числа строк
      if F.Components[i] is TLabel then
       With F.Components[i] as TLabel do
        begin
         w1:=1; // вычислим число строк в метке
         if Length(Caption)>2 then
         for j:= 1 to Length(Caption)-2 do
           if Copy(Caption,j,2) = #13#10 then Inc(w1);
         if w1=1 then Top:= Top+2 else
         if w1=2 then Top:= Top-2 else Top:= Top-4;
         w2:= Top+height; // положение нижней части метки
        end;

    // русифицируем надписи на кнопках и позиционирум кнопки
    // в зависимости от числа строк метки
    if F.Components[i] is TButton then
       With F.Components[i] as TButton do
        begin
         s^:= Caption; // приведем надпись к
                          виду ButtonEngCaptions
         Delete(s^,Pos('&',s^),1);
         s^:= AnsiUpperCase(DelSymbAll(s^,' '));
         for j:=1 to 11 do // поиск надписи
          if s^ = AnsiUpperCase(ButtonEngCaptions[j]) then
           Caption:= ButtonRusCaptions[j]; // русификация
         if w1=1 then Top:= w2+20 else // позиционирование
          if w1=2 then Top:= w2+12 else Top:= w2+10;
         h1:= Top+height; // положение нижней части кнопок
        end;
    end; // for i

    height:= h1+42; // подбираем подходящую высоту формы

    // вычисляем положение F-формы
    // 1. определяем центр активной формы
    cx:= -1; cy:= -1; // координаты центра активной формы
    ScreenActFormVisBoo:= false; // наличие и
                                   видимость активной формы
    if Screen.ActiveForm <> Nil then
      if Screen.ActiveForm.Visible then
    begin
      w2:= Screen.ActiveForm.width;
      h2:= Screen.ActiveForm.height;
      t2:= Screen.ActiveForm.Top;
      L2:= Screen.ActiveForm.Left;
      cx:= L2 + w2 div 2; // координаты центра активной формы
      cy:= t2 + h2 div 2;
      ScreenActFormVisBoo:= true;
    end;

    // 2. определяем координаты левого верхнего угла F-формы
    w1:= width; h1:= height; // параметры F-окна
    if ScreenActFormVisBoo then // активная форма видима
    begin
      w2:= Screen.width; // размеры экрана
      h2:= Screen.height;
      Top:= cy - h1 div 2; // F.Top
      Left:= cx - w1 div 2; // F.Left
      // F-окно должо быть полностью в экране
      if Top<0 then Top:=0 else
        if Top>h2-h1 then Top:= h2-h1;
      Left:= cx - w1 div 2;
        if Left<0 then Left:=0 else
        if Left>w2-w1 then Left:= w2-w1;
      end
    else
      Position:= poScreenCenter; // активной формы нет
                                    или невидима
    Result:= ShowModal;
    finally // освобождаем память
    Dispose(Msg); Dispose(s);
    F.Free;
    Application.ProcessMessages; // убираем следы F-окна
  end;
end;

где функция DelSymbAll имеет код

function DelSymbAll(s: String; Ch: Char): String;
// удаляет символ везде
  var i: Integer;
begin
  i:= pos(Ch,s);
  while i>0 do
  begin
    Delete(s,i,1);
    i:= pos(Ch,s);
    end;
  Result:= s;
end;

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

Используя KdnMessageDlg построим процедуру - усовершенствованый аналог стандартной процедуры ShowMessage:

  procedure KdnMessage(Msg: Variant);
  //однострочное сообщение
  begin
    KdnMessageDlg(Msg, mtInformation,[mbOK]);
  end;

Несколько примеров обращения к процедуре:

KdnMessage(24);           // числовой целочисленный тип аргумента
KdnMessage(-224.89);      // числовой вещественный тип аргумента
KdnMessage('Это строка'); // строковый тип
KdnMessage(Now);          // тип TDateTime
KdnMessage(Tim);          // тип TTime
KdnMessage(Dat);          // тип TDate

В последнем случае активное окно и нависающее над ним окно сообщения будут выглядеть так (центры активной формы и окна сообщения совпадают):

На основе предыдущей процедуры построим многострочное сообщение:

procedure KdnMessageV(Msg: array of Variant);
//многострочное сообщение
begin
  KdnMessage(DinVarArrToStrs(Msg);
end;

где функция DinVarArrToStrs имеет код:

function DinVarArrToStrs(a: array of Variant): Variant;
// конвертация Variant-массива в многострочный Variant
  var s: array of String; i: byte;
begin
  SetLength(s,2);
  s[0]:='';
  if Length(a)>0 then
  begin
    s[0]:= a[0];
    if Length(a)>1 then
    for i:= 1 to Length(a)-1 do
      begin
        s[1]:= a[i];
        s[0]:= s[0]+''#13#10''+s[1];
      end;
    end;
  Result:= s[0];
  s:= Nil;
end;

Пример обращения к процедуре:

KdnMessageV([1355,-15.87,Now,DateOf(Now),TimeOf(Now)]);

и окно, отображающее результат обращения:

Аналогичным образом создадим однострочное окно для вывода вопроса с целью получения ответа от пользователя программы

function KdnYesNo(Question: Variant): boolean;
// однострочный вопрос
begin
  Result:= KdnMessageDlg(Question,mtConfirmation,
  [mbYes,mbNo]) = mrYes;
end;

и соответствующее многострочное окно

function KdnYesNoV(Question: array of Variant): boolean;
// многострочный вопрос
begin
  Result:= KdnYesNo(DinVarArrToStrs(Question));
end;

Примеры обращения к функциям:

if KdnYesNo('Удалить рисунок ?') then DeleteFile(ImFile);
if not KdnYesNoV(['Вы действительно желаете',
  'удалить непустую папку', ExeDir,'?'])
  then exit;

Соответствующие окна показаны ниже.

Точно также можно создать окна с тремя кнопками:

function KdnYesNoCancel(Question: Variant): byte;
// однострочное окно с тремя кнопками
  var r: Integer;
begin
  r:= KdnMessageDlg(Question,mtConfirmation,
                    [mbYes,mbNo,mbCancel]);
  Result:= 3; // на случай выхода вне кнопок
  if r = mrYes then Result:= 1 else
  if r = mrNo then Result:= 2;
end;

function KdnYesNoCancelV(Question: array of Variant): byte;
// многострочное окно с тремя кнопками
begin
  Result:= KdnYesNoCancel(DinVarArrToStrs(Question));
end;

Ограничимся примером обращения к последней функции

if KdnYesNoCancelV(['Вы действительно желаете',
  'удалить непустую папку', ExeDir,'?']) = 1
then if KdnYesNo('Подтвердите') then DeleteFolder(ExeDir);

Первое окно, которое появится в результате исполнения этого кода, имеет вид:

Аналогично на основе функции KdnMessageDlg могут быть без труда созданы другие подобные процедуры и функции.

Улучшение вспомогательных окон среды Delphi 2