Мішатронік

• для ускорения программирования или отладки программы обычно возникает потребность в том, чтобы с наименьшими затратами времени программировать вывод констант и значений переменных наиболее часто используемых типов (обычно строковых и числовых) с помощью одной или нескольких "подручных" подпрограмм, не тратя время на конвертацию из одного типа в другой (чаще строковый); для большинства случаев это можно сделать воспользовавшись, например, типом 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 могут быть без труда созданы другие подобные процедуры и функции.