[Из песочницы] Как в TMemo сделать вертикальное выравнивание, отступы и TextHint
Пролог
Итак, из-за чего все собственно и стряслось. Я пишу плагины для LedearTask. Также, в 2017 году, написал векторный редактор для турецкой фирмы станков по производству печатей MATUYA. Что LeaderTask, что MATUYA, выставили интересные требования — вертикальное выравнивание в многострочном редакторе, отступы и TextHint. TextHint имеется ввиду — такое серое приглашение ввести хоть что-нибудь, когда элемент ввода пуст.
LeaderTask: плагин «Лестница Целей» (ввод и хинт по центру в многострочном редакторе) 
Matuya Stamp Systems (ввод текста выровнен по правому и нижнему краю)
Как известно, вертикального выравнивания, в отличии от горизонтального, в стандартном Windows API для контролов не существует.
Также, приглашения для ввода какой-то информации в многострочных контролах Windows не поддерживаются.
Таким образом, возникает дилемма –, а как? Хочется использовать стандартные компоненты, но при этом иметь расширенные возможности ввода текстовой информации.
Небольшое отступление
С некоторых, достаточно отдаленных, пор, я не пишу компоненты и не использую сторонние. В условиях вечного дедлайна намного выгодней, быстрее и экономичней все писать самому. То, что будет создано в real-time. Т.е. использовать богатые возможности дизайнера Delphi, но подменять классы «на лету» в real-time. Как это все выглядит, надеюсь описать подробнее чуть позже. Что это значит в текущем конкретном случае, опишу сейчас.
Что требуется
По сути, от меня требуется TMemo, в котором есть вертикальное выравнивание, скажем, свойство Layout, свойство TextHint — «приглашение» ввести какой-нибудь текст. Также, требуется сделать отступы сверху-снизу-слева-справа для ввода и отображения текста, чтоб он не «прилипал» к граням контрола.
Теория
Необходим TMemo с дополнительными возможностями. Очевидно, придется писать наследника от TMemo. Не от TCustomMemo, и уж тем более не от TCustomEdit. Нам нужен именно TMemo, потому что мы не собираемся писать библиотеку компонентов, а хотим сделать проект быстро и в срок.
Вертикальное выравнивание нам недоступно. Ну что ж, зато мы можем установить для контролов прямоугольник ввода текста. Это осуществляется следующим образом.
В нашем случае, это будет выглядеть так:
Perform(EM_SETRECT, 0, LPARAM(@ARect))
Где ARect –искомый прямоугольник для ввода текста. Очевидно, его верхняя грань должна зависеть от значения свойства Layout. Также, этот прямоугольник может определить и границы отступа от краев для ввода текста.
Далее, немного поковыряв исходники, находим виртуальный метод:
procedure PaintWindow(DC: HDC); virtual;
Он вызывается в любом случае, что для DoubleBuffered, что без него. Его вызов будет осуществлен при наличии csCustomPaint в ControlState компонента, после всех значимых отрисовок компонента. Его мы будем использовать для отрисовки TextHint.
Практика
Не буду останавливаться на некоторых, думаю, не особо интересных деталях реализации.
Для начала, у нас появляются следующие дополнительные свойства:
//-- выравнивание по вертикали ----------------------------------------
property Layout : TTextLayout read FLayout write SetLayout default tlTop;
//-- отступы от краев контрола, описание в исходниках ниже----------
property Margin : TxMargin read FMargin write SetMargin;
//-- серое приглашение ввести что-нибудь в пустой элемент ----------
property TextHint : string read FTextHint write SetTextHint;И основные моменты.
1. Объявление класса безусловно таково:
type
TxIPMemo = class (TMemo)
2. В конструкторе пишем строку:
Constructor TxIPMemo.Create (AOwner : TComponent);
begin
inherited Create (AOwner);
//-- для того, чтобы метод PaintWindow был вызван ---------------
ControlState := ControlState + [csCustomPaint];
…
end;
3. Назначение прямоугольник ввода:
function TxIPMemo.SetRect (ARect : TRect) : boolean;
begin
result := Perform(EM_SETRECT, 0, LPARAM(@ARect))>0;
end;
4. Расчет прямоугольника ввода:
function TxIPMemo.CalcRect : TRect;
var s : string;
h : Integer;
rct : TRect;
begin
rct := Rect(0,0,ClientWidth,ClientHeight);
//-- вначале определяем смещения от краев контрола ----------------
rct.Top := rct.Top + FMargin.Top;
rct.Left := rct.Left + FMargin.Left;
rct.Right := rct.Right - FMargin.Right;
rct.Bottom := rct.Bottom - FMargin.Bottom;
//-- если выравнивание по верху - ничего не высчитваем, выходим ---
result := rct;
if Layout = tlTop then exit;
//-- битмап создается в конструкторе ------------------------------
FBitmap.Canvas.Font.Assign(Font);
s := Lines.Text;
//-- если строка пуста и нет фокуса берем значение хинта для расчетов
if (s = '') and (not Focused) then s := TextHint;
//-- вычисляем выосту текста --------------------------------------
h := CalcHeight(FBitmap.Canvas.Handle, WidthRect(rct)-2, s,
TrueWordWrap);
//-- находим смещение сверху для прямоугольника ввода -------------
case FLayout of
tlCenter : H := rct.Top + (HeightRect(rct) - H) div 2;
tlBottom : H := rct.Bottom - H;
end;
//-- небольша проверка на валидность ------------------------------
if (H > rct.Top) then
rct.Top := H;
result := rct;
end;
5. Что такое TrueWordWrap в вызове функции CalcHeight выше. Это метод, которые возвращает истинное значение переноса строк для TMemo, которое зависит на самом деле от ряда параметров:
function TxIPMemo.TrueWordWrap : boolean;
begin
result := not ((Alignment = taLeftJustify) and
(ScrollBars in [ssHorizontal, ssBoth]))
and (WordWrap or (Alignment <> taLeftJustify));
end;
6. Где происходит вызов перерасчета и назначения прямоугольника ввода:
procedure DoEnter; override;
procedure DoExit; override;
procedure Change; override;
procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
procedure CMRecreateWnd(var Message: TMessage); message CM_RECREATEWND;
7. Назначение свойства TextHint чрезвычайно просто, но с учетом того, если кому-то вдруг захочется регистрировать компонент:
procedure TxIPMemo.SetTextHint (Value : string);
begin
if FTextHint = Value then exit;
FTextHint := Value;
if not (csLoading in ComponentState) then
Change;
end;
8. Рисуем TextHint:
procedure TxIPMemo.PaintWindow(DC: HDC);
var rct : TRect;
str : string;
cnv : TCanvas;
begin
inherited PaintWindow(DC);
if Focused then exit;
str := Lines.Text;
if str <> '' then exit;
str := FTextHint;
if str = '' then exit;
rct := CalcRect;
InflateRect (rct, -2,-2);
cnv := TCanvas.Create;
cnv.Handle := DC;
cnv.Font.Assign(Font);
cnv.Font.Color := clBtnShadow;
DrawTextEx(cnv,rct,str,tlTop,Alignment,TrueWordWrap,false);
cnv.Free;
end;
9. Чтобы облегчить «подмену» стандартного TMemo на наш, есть следующий метод. Он забирает все основные события и свойства у переданного указателя на TCustomMemo. При выставленном флаге AWithFree, уничтожает экземпляр старого и становится на его место. Т.е., если в коде все завязано на «старый» TCustomMemo, ничего страшного не произойдет. Все будет работать с новым экземпляром, как со старым, за исключением тех моментов, когда будут использованы свойства, про которые вы и так в курсе, и обращаться к ним все равно придется как к TxIPMemo:
function TxIPMemo.SetMemo (AMemo : PMemoControl; AWithFree : boolean = true) : boolean;
var s : string;
begin
result := AMemo <> nil;
if not result then exit;
s := Amemo^.Name;
BoundsRect := AMemo^.BoundsRect;
Parent := AMemo^.Parent;
Align := Amemo^.Align;
Alignment := TxIPMemo(Amemo^).Alignment;
{$IFDEF VER_XE}
OnMouseEnter := TxIPMemo(Amemo^).OnMouseEnter;
OnMouseLeave := TxIPMemo(Amemo^).OnMouseLeave;
{$ENDIF}
BorderStyle := TxIPMemo(Amemo^).BorderStyle;
Font.Assign(TxIPMemo(Amemo^).Font);
Color := TxIPMemo(Amemo^).Color;
Visible := Amemo^.Visible;
TabOrder := TxIPMemo(Amemo^).TabOrder;
ScrollBars := TxIPMemo(Amemo^).ScrollBars;
WantTabs := TxIPMemo(Amemo^).WantTabs;
WantReturns := TxIPMemo(Amemo^).WantReturns;
WordWrap := TxIPMemo(Amemo^).WordWrap;
OnKeyPress := TxIPMemo(Amemo^).OnKeyPress;
OnKeyDown := TxIPMemo(Amemo^).OnKeyDown;
OnKeyUp := TxIPMemo(Amemo^).OnKeyUp;
OnChange := TxIPMemo(Amemo^).OnChange;
OnClick := TxIPMemo(Amemo^).OnClick;
OnMouseDown := TxIPMemo(Amemo^).OnMouseDown;
OnMouseMove := TxIPMemo(Amemo^).OnMouseMove;
OnMouseUp := TxIPMemo(Amemo^).OnMouseUp;
OnEnter := TxIPMemo(Amemo^).OnEnter;
OnExit := TxIPMemo(Amemo^).OnExit;
if AWithFree then begin
Amemo^.Free;
Name := s;
AMemo^ := self;
end;
end;
Как использовать
Предположим, что уже есть компонент TMemo на форме, которое Вы либо используете в динамике, подобно как выше-вкратце-описанные редакторы, либо статический компонент, созданный в дизайне. Это все не важно.
1. Объявляем где-то следующим образом:
FMemo : TxIPMemo;
2. В событии OnCreate формы, либо в её конструкторе, пишем следующее:
FMemo := TxIPMemo.Create (self);
//-- назначение дополнительных свойств ------------------
FMemo.TextHint := 'Введите сюда что-нибудь ...';
FMemo.Layout := tlCenter;
За уничтожение экземпляра класса не волнуемся — он будет гарантированно уничтожен в деструкторе.
3. Возможно, в том же обработчике FormCreate пишем:
FMemo.SetMemo (@Memo1);
Тем самым забирая свойства и события у Memo1, и уничтожая его, становясь на его место.
4. Собственно, и все. Назначаете необходимые свойства нашему компоненту. И пользуем TMemo с возможностями вертикального выравнивания, отступов (которые могут быть и отрицательными), приглашения для пользователя при пустом Text.
Окно демо-приложения
Эпилог
В исходниках, ссылка на которые ниже, все используемые в тексте вспомогательные функции представлены.
Версия компилятора определяется {$I} подключаемым файлом pro_param.inc.
Т.к., в силу специфики работы, придерживаюсь концепции один модуль — разные версии, представленные исходники компилируются в Delphi 7, Delphi XE 7 и Delphi 10.1 Berlin. По той простой причине, что Delphi 7 у меня куплен, а Delphi 10.1 Berlin — бесплатная лицензия для коммерческих продуктов. А заказчик в последнее время хочет быть абсолютно «белым». Поэтому не использую никаких платных библиотек.
Надеюсь, материал поможет в ситуациях разной степени тяжести.
Скачать:
xIPMemo
Demo D7, XE 7
