Logo    
Деловая газета CitCity.ru CITKIT.ru - все об Open Source Форумы Все публикации Учебный центр Курилка
CitForum    CITForum на CD    Подписка на новости портала Море(!) аналитической информации! :: CITFORUM.RU
IT-консалтинг Software Engineering Программирование СУБД Безопасность Internet Сети Операционные системы Hardware

18.01.2017

Google
WWW CITForum.ru
С Новым годом!
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

Размещение рекламы — тел. +7 495 4119920, ICQ 232284597

Подписка на новости IT-портала CITForum.ru
(библиотека, CITKIT.ru, CitCity)

Новые публикации:

24 декабря

CITKIT.ru:

  • Новогодние поздравления
  • Сергей Кузнецов. Цикл Операционные системы: Ностальгия по будущему:

  • Алексей Федорчук. OpenSolaris 2008.11 Release

  • Сергей Голубев:

  • Евгений Чайкин aka StraNNik (Блогометки):

    17 декабря

  • С.Д.Кузнецов. Базы данных. Вводный курс

    10 декабря

    CITKIT.ru:

  • OpenSolaris 2008.11 Release

  • Альтернативные ОС: две грустные истории (С.Кузнецов)
  • Nokia N810 — доведение до ума
  • CitCity:

  • Платформа 2009: заоблачные перспективы Microsoft

    4 декабря

  • Лекция С.Д.Кузнецова Понятие модели данных. Обзор разновидностей моделей данных

    CITKIT.ru:

  • OpenSolaris 2008.11 Release. Первые впечатления

  • Linux vs FreeBSD: продолжим "Священные войны"?

  • Nokia N810 as is

  • Индульгенция для FOSS

  • Друзья СПО'2008

    26 ноября

  • Нечеткое сравнение коллекций: семантический и алгоритмический аспекты

    CitCity:

    CITKIT.ru:

  • Глава из книги А.Федорчука
    Сага о FreeBSD:
  • 19 ноября

  • Проблемы экономики производства крупных программных продуктов

  • Язык модификации данных формата XML функциональными методами

    CITKIT.ru:

  • Главы из книги А.Федорчука
    Сага о FreeBSD:

    Заметки к книге:

  • FreeBSD: монтирование сменных устройств и механизм HAL
  • Текстовый редактор ee

    12 ноября

  • Правило пяти минут двадцать лет спустя, и как флэш-память изменяет правила (Гоц Грейф, перевод: Сергей Кузнецов)

    CITKIT.ru:

  • Главы из книги А.Федорчука
    Сага о FreeBSD:
  • OSS в России: взгляд правоведа (В.Житомирский)

  • Новая статья из цикла С.Голубева "Железный марш":

    29 октября

  • О некоторых задачах обратной инженерии

  • Веб-сервисы и Ruby

  • Тестирование web-приложений с помощью Ruby

    CITKIT.ru:

  • Главы из книги А.Федорчука
    Сага о FreeBSD:

  • PuppyRus Linux - беседа с разработчиком (С.Голубев)

  • Сергей Кузнецов. Заметка не про Linux

    22 октября

  • Обзор методов описания встраиваемой аппаратуры и построения инструментария кросс-разработки

    CITKIT.ru:

  • Сергей Кузнецов. Почему я равнодушен к Linux

  • Глава из книги А.Федорчука
    Сага о FreeBSD:
  • Что надо иметь
    3. Базовые познания

    CitCity:

  • Управление IT-инфраструктурой на основе продуктов Microsoft

    15 октября

  • Методы бикластеризации для анализа интернет-данных

    CitCity:

  • Разъемы на ноутбуках: что они дают и зачем их так много?
  • AMD Puma и Intel Centrino 2: кто лучше?

    CITKIT.ru:

  • Новый цикл статей С.Голубева
    Железный марш:

  • Главы из книги А.Федорчука
    Сага о FreeBSD:

    8 октября

  • Автоматизация тестирования web-приложений, основанных на скриптовых языках
  • Опыт применения технологии Azov для тестирования библиотеки Qt3

    Обзоры журнала Computer:

  • SOA с гарантией качества
  • Пикоджоуль ватт бережет
  • ICT и всемирное развитие

    CitCity:

  • Пиррова победа корпорации Microsoft

    CITKIT.ru:

  • Главы из книги А.Федорчука
    Сага о FreeBSD:

    Статья из архива:

  • Я живу в FreeBSD (Вадим Колонцов)

    Новые Блогометки:

  • Перекройка шаблона Blogger или N шагов к настоящему
  • Blogger. Comment style
  • Screenie или глянцевый снимок экрана

    2 октября

    CITKIT.ru:

  • Сага о FreeBSD (А. Федорчук)

    Zenwalk: пакет недели

  • Банинг — интеллектуальное развлечение (С.Голубев)

    CitCity:

    25 сентября

  • Клермонтский отчет об исследованиях в области баз данных

    CITKIT.ru:

  • Пользователям просьба не беспокоиться... (В.Попов)

  • Снова про ZFS: диск хорошо, а два лучше
  • Командная оболочка tcsh (А.Федорчук)

    Zenwalk: пакет недели

    17 сентября

  • T2C: технология автоматизированной разработки тестов базовой функциональности программных интерфейсов
  • Технология Azov автоматизации массового создания тестов работоспособности

    CITKIT.ru:

  • FreeBSD: ZFS vs UFS, и обе-две — против всех (А.Федорчук)

    Zenwalk: пакет недели

  • Дачнет — практика без теории (С.Голубев)

    10 сентября

  • За чем следить и чем управлять при работе приложений с Oracle
  • Планировщик заданий в Oracle
    (В.Пржиялковский)

    CITKIT.ru:

  • Microsoft: ответный "боян" (С.Голубев)

  • Причуды симбиоза, или снова "сделай сам" (В.Попов)

  • Файловые системы современного Linux'а: последнее тестирование
  • Zsh. Введение и обзор возможностей
    (А.Федорчук)

    Описания пакетов Zenwalk: Zsh, Thunar, Thunar-bulk-rename, Xfce4-places-plugin, Xfce4-fsguard-plugin

    Блогометки:

  • Google Chrome
  • Лончер для ASUS Eee PC 701

    3 сентября

    CITKIT.ru:

  • Заметки о ядре (А.Федорчук):

    Добавлены описания пакетов Zenwalk: Galculator, Screenshot, Gnumeric, Pidgin

    В дискуссинном клубе:

  • И еще о Википедии и Google Knol

  • Лекция для начинающего линуксоида (С.Голубев)

    26 августа

  • Транзакционная память (Пересказ: С. Кузнецов)

    CITKIT.ru:

  • Открыт новый проект Zenwalk: пакет недели

  • Статья Текстовые процессоры и их быстродействие: конец еще одной легенды?

    21 августа

    CITKIT.ru:

  • Почему школам следует использовать только свободные программы (Ричард Столлман)
  • Беседа Сергея Голубева с учителем В.В.Михайловым

  • Википедия или Гуглезнание? Приглашение к обсуждению (Алексей Федорчук)
  • Народная энциклопедия от Google (StraNNik)

  • Обзор Mandriva 2009.0 Beta 1 Thornicrofti
  • Новичок в Линукс: Оптимизируем Mandriva 2008.1

  • Книга Zenwalk. Приобщение к Linux:

    13 августа

    CitCity:

  • Мирный Atom на службе человеку. Обзор платы Intel D945GCLF с интегрированным процессором
  • Обзор процессоров Intel Atom 230 на ядре Diamondville

  • iPhone - год спустя. Скоро и в России?

    CITKIT.ru:

  • Интермедия 3.4. GRUB: установка и настройка (из книги Zenwalk. Приобщение к Linux)

    6 августа

  • СУБД с хранением данных по столбцами и по строкам: насколько они отличаются в действительности? (Пересказ: С. Кузнецов)

    CITKIT.ru:

  • Интермедия 2.2. Что неплохо знать для начала (из книги Zenwalk. Приобщение к Linux)

  • И снова про шрифты в Иксах (А.Федорчук)

  • 20 самых быстрых и простых оконных менеджеров для Linux

  • Дело о трех миллиардах (С.Голубев)

    30 июля

  • OLTP в Зазеркалье (Пересказ: С. Кузнецов)

    CitCity:

  • Будущее BI в облаках?
  • Тиражные приложения и заказная разработка. Преимущества для заказчика
  • Дискуссия со сторонниками заказной разработки

    CITKIT.ru:

  • Новые главы книги Zenwalk. Приобщение к Linux:
  • Глава 8. Пакеты: средства установки, системы управления, системы построения
  • Глава 9. Zenwalk: репозитории, пакеты, методы установки

    23 июля

    CITKIT.ru:

  • Все против всех. 64 vs 32, Intel vs AMD, tmpfs vs ext3
  • Две головы от Intel

  • Zenwalk: обзор штатных приложений (глава из книги "Zenwalk. Приобщение к Linux")

  • Нормально, Григорий...

    16 июля

    Обзоры журнала Computer:

  • Перспективы и проблемы программной инженерии в XXI веке
  • Большие хлопоты с большими объемами данных
  • Перспективы наноэлектроники

    CITKIT.ru:

  • Интермедия о лицензиях (А.Федорчук. "Zenwalk. Приобщение к Linux")

  • Есть ли будущее у KDE?

  • Linux в школе: альтернативный вариант в задачах

  • Шифр (приключения агента Никодима)

    10 июля

    CITKIT.ru:

  • Новые разделы книги А. Федорчука Zenwalk. Приобщение к Linux:
  • Интермедия вступительная. Linux или GNU/Linux? Как вас теперь называть?
  • Глава 5. Среда Xfce
  • Глава 6. Xfce: приложения и плагины

  • ZUR (Zenwalk User Repository) FAQ

    2 июля

  • Персистентность данных в объектно-ориентированных приложениях (С. Кузнецов)

    CITKIT.ru:

  • Новые разделы книги А. Федорчука Zenwalk. Приобщение к Linux:
  • Интермедия 1.2. Дорога к Zenwalk'у. Период бури и натиска
  • Интермедия 3.3. Немного о Linux'е и "железе"
  • Глава 4. Настройка: инструментами и руками
  • Интермедия 4.1. Zenpanel и конфиги: поиски корреляции

  • Интервью с Жан-Филиппом Гийоменом, создателем дистрибутива Zenwalk

  • Linux в школе: первые итоги (С. Голубев)

    25 июня

    CITKIT.ru:

  • Zenwalk. Приобщение к Linux (А. Федорчук)

  • Логика и риторика (С.Голубев)

  • Технология Tru64 AdvFS

  • Ханс Райзер предлагает отвести полицейских к телу Нины

    18 июня

  • Проекты по управлению данными в Google (Пересказ: С. Кузнецов)

    CITKIT.ru:

  • ОС и поддержка "железа": мифы и реальность (А. Федорчук)

  • Linux в школе: другие дистрибутивы

  • Пинок (С. Голубев)

    4 июня

  • Ландшафт области управления данными: аналитический обзор (С. Кузнецов)

    CITKIT.ru:

  • Linux в школе: слово заинтересованным лицам

  • SlackBuild: пакеты своими руками

  • Linux от компании Novell. Установка и обзор openSUSE Linux

    Все публикации >>>




  • IT-консалтинг Software Engineering Программирование СУБД Безопасность Internet Сети Операционные системы Hardware

    Информация для рекламодателей PR-акции, размещение рекламы — тел. +7 495 4119920, ICQ 232284597 Пресс-релизы — pr@citcity.ru
    Послать комментарий
    Информация для авторов
    Rambler's Top100 TopList liveinternet.ru: показано число просмотров за 24 часа, посетителей за 24 часа и за сегодня This Web server launched on February 24, 1997
    Copyright © 1997-2000 CIT, © 2001-2007 CIT Forum
    Внимание! Любой из материалов, опубликованных на этом сервере, не может быть воспроизведен в какой бы то ни было форме и какими бы то ни было средствами без письменного разрешения владельцев авторских прав. Подробнее...