Пролог

Итак, из-за чего все собственно и стряслось. Я пишу плагины для 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