3. Примеры пользовательских оконных компонентов

3.1. Расширение редактора TEdit

Например, необходимо создать специализированный редактор, с помощью которого можно было бы изменять координаты типа TPoint. При нажатии клавиши ввода будет происходить некоторое пользовательское событие, а при нажатии клавиши Esc – обнуление координат.

В принципе для этого вполне подходит TMaskEdit, но было бы удобней, если бы у компонента было бы свойство, обращаясь к которому можно было бы получить координаты точки.

Так и сделаем. Создадим новый компонент, унаследованный от TCustomMaskEdit, с одной стороны способный контролировать клавиатурный ввод по маске, а с другой – не отягощенный опубликованными свойствами и событиями.

Для начала определим новое свойство типа TPoint:

    property EditPoint: TPoint read GetPoint write SetPoint;

Затем переопределим конструктор, в котором сразу установим требуемую маску ввода данных и начальное значение координат:

constructor TPointEdit.Create(AOwner: TComponent);
begin
  inherited;
  EditMask:='9990, 9990;1; ';
  EditPoint:=Point(0,0);
end;

Метод записи свойства EditPoint определим таким образом, чтобы при установке его извне свойство Text выглядело бы корректно. Сделаем это с помощью функции Format:

procedure TPointEdit.SetPoint(const Value: TPoint);
begin
  Text:=Format('%4d, %4d',[Value.X, Value.Y]);
end;

Метод чтения свойства EditPoint напишем таким образом, чтобы значение получалось из сформатированного текста:

function TPointEdit.GetPoint: TPoint;
var
CommaPos: Integer;
begin
  CommaPos:=pos(',',Text);
  Result:=Point(StrToInt(Copy(Text,1,CommaPos-1)),
               StrToInt(Copy(Text,CommaPos+1,length(Text))));
end;

Добавим новый тип события, упрощающего обработку координат, метод сообщения WM_KEYDOWN, вызывающийся каждый раз при нажатии клавиши:

  TOnNewPoint=procedure(Sender: TPointEdit; Point:TPoint) of object;
…
  published
  property OnNewPoint:TOnNewPoint read FOnNewPoint write FOnNewPoint;
procedure WMKeyDown(var M:TWMKey); message WM_KEYDOWN;
…
procedure TPointEdit.WMKeyDown(var M: TWMKey);
begin
  inherited;
  if (M.CharCode=VK_RETURN) then
  begin
  Invalidate;
  if Assigned(FOnNewPoint) then FOnNewPoint(Self as TPointEdit, GetPoint);
  end;
  if (M.CharCode=VK_ESCAPE) then EditPoint:=Point(0,0);
end;

Примечание

Обратите внимание, что обработка ввода происходит только при нажатии клавиши ввода, нажатие же клавиши Esc приводит к обнулению значения координат.

Создадим тестовое приложение, демонстрирующее работу нового компонента, в котором координаты некоторого компонента меняются при изменении свойства EditPoint.

3.2. Компонент-наследник TListBox с горизонтальной прокруткой

Пример 7.5. Пример реализации компонента-наследника TListBox с горизонтальной прокруткой

unit ScrollListBox;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Windows, Messages, Dialogs;

type
  TOnEnabledChange=procedure(Sender: TObject; Enabled:boolean) of object;
  
  TScrollListBox = class(TListBox)
  private
    FHorizontExtent: word;
    FOnEnabledChange: TOnEnabledChange;
    { Private declarations }
    procedure GetLongestString;
    procedure LBAddString(var Msg:TMessage);    message lb_AddString;
    procedure LBInsertString(var Msg:TMessage); message lb_InsertString;
    procedure LBDeleteString(var Msg:TMessage); message lb_DeleteString;
    procedure WMEnable (var M:TWMEnable); message WM_Enable;
  protected
    { Protected declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
  public
    { Public declarations }
  published
    { Published declarations }
    property OnEnabledChange: TOnEnabledChange read FOnEnabledChange write fOnEnabledChange;
  end;

procedure Register;

implementation

uses Math;

procedure Register;
begin
  RegisterComponents('Лекция 6', [TScrollListBox]);
end;

{ TScrollListBox }

procedure TScrollListBox.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style:=Params.Style or WS_HSCROLL;
end;

procedure TScrollListBox.CreateWnd;
begin
  inherited;
  Perform(LB_SETHORIZONTALEXTENT,2,0);
  ShowScrollBar(Handle,SB_HORZ,true)
end;

procedure TScrollListBox.GetLongestString;
var i: integer;
begin
FHorizontExtent:=0;
Canvas.Font.Assign(font);
for i :=0 to Items.count-1 do
  FHorizontExtent:=Max(FHorizontExtent,Canvas.TextWidth(Items[i]));
  Perform(LB_SETHORIZONTALEXTENT,FHorizontExtent+2,0);
end;

procedure TScrollListBox.LBAddString(var Msg: TMessage);
begin
 inherited;
 GetLongestString;
end;

procedure TScrollListBox.LBDeleteString(var Msg: TMessage);
begin
 inherited;
 GetLongestString;
end;

procedure TScrollListBox.LBInsertString(var Msg: TMessage);
begin
 inherited;
 GetLongestString;
end;

procedure TScrollListBox.WMEnable(var M: TWMEnable);
begin
  inherited;
  if Assigned(FOnEnabledChange) then FOnEnabledChange(Self, Enabled);
end;
end.