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