2. Расширение базового компонента

Второй шаг создания компонента заключается в преобразовании базового и фактически заключается в добавлении имеющемуся базовому компоненту свойств, необходимых для работы с данными. Этот процесс иногда называют преобразованием компонента.

Рис. 11.1. Принцип организации работы с данными

Свойствами, необходимыми для работы с данными является ссылка на компонент, являющийся набором данных (это может быть таблица или запрос), для компонентов, работающих с одним полем еще и название поля. Дополнительно к этому необходимы несколько методов, обеспечивающих связь с источником данных.

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

Примечание

Нетрудно догадаться, что для показа данных достаточно графического элемента управления, а для редактирования данных, как правило требуется клавиатурный ввод необходим оконный элемент.

2.1. Компонент, представляющий данные

Допустим нам необходим компас (см. лекцию №8), умеющий брать значение азимута из поля базы данных и наглядно этот азимут отображающий.

В этом случае в качестве предка подойдет простой компас типа TCompass.

Для создания наследника вызываем мастер создания нового компонента Component->New VCL Component.., в котром в качестве предка выбираем класс TCompass, вводим имя класса, модуля и закладки палитры компонентов.

Пример 11.1. Листинг модуля класса TdbCompass

  unit dbCompass;
  
  interface
  uses Windows, SysUtils, Classes, Controls, DBCtrls, DB, Compass; 
  type
  TDBCompass = class(TCompass)
  private
  FDataLink: TFieldDataLink; // Для связи с источником данных 
  procedure SetDataSource(const Value: TDataSource);
  function GetDataSource: TDataSource;
  procedure DataChange(Sender: TObject);
  function GetDataField: string;
  procedure SetDataField(const Value: string);
  public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  published
  property DataSource: TDataSource read GetDataSource write SetDataSource; 
  property DataField: string read GetDataField write SetDataField; 
  end;
  
  procedure Register;
  
  implementation
  { TDBCompass }
  
  constructor TDBCompass.Create(AOwner: TComponent);
  begin
  inherited;
  FDataLink:=TFieldDataLink.Create; 
  FDataLink.OnDataChange:=DataChange;
  end;
  
  procedure TDBCompass.DataChange(Sender: TObject);
  begin
  Azimuth:=FDataLink.Field.AsInteger; 
  end;
  
  destructor TDBCompass.Destroy;
  begin
  FreeAndNil(FDataLink); 
  inherited;
  end;
  
  function TDBCompass.GetDataField: string; 
  begin
  Result:=FDataLink.FieldName;
  end;
  
  function TDBCompass.GetDataSource: TDataSource;
  begin
  Result:=FDataLink.DataSource;
  end;
  
  procedure TDBCompass.SetDataField(const Value: string);
  begin
  FDataLink.FieldName:=Value;
  end;
  
  procedure TDBCompass.SetDataSource(const Value: TDataSource);
  begin
  FDataLink.DataSource := Value;
  end;
  
  procedure Register;
  begin
  RegisterComponents('ООП', [TDBCompass]);
  
  end;
  end.

Рассмотрим листинг подробней:

	Модуль DBCtrls нужен для подключения класса `TFieldDataLink`, а модуль DB - для подключения класса `TDataSource`
	Свойство DataSource нужно для оранизации сссылки на источник данных
	Свойство DataField хранит имя поля набора данных, с которым связан компонент
	В конструкторе создается экземпляр FDataLink и назначается обработчик события OnDataChange, которое происходит при изменении внешних данных
	При изменении внешних данных устанавливается новое значение свойства Azimuth
	В деструкторе разрушается экземпляр свойства FDataLink
	Методы чтения и записи свойств

2.2. Компонент, редактирующий данные

Пример 11.2. Интерфейс TDBEdit (сокращено)

{ TDBEdit }

  TDBEdit = class(TCustomMaskEdit)
  private
    FDataLink: TFieldDataLink;
    FCanvas: TControlCanvas;
    FAlignment: TAlignment;
    FFocused: Boolean;
    procedure ActiveChange(Sender: TObject);
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    function GetTextMargins: TPoint;
    procedure ResetMaxLength;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetFocused(Value: Boolean);
    procedure SetReadOnly(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure WM... // процедуры работы с буфером обмена
    procedure CM... // процедуры обработки компонентных сообщений
  protected
    procedure Change; override;
    function EditCanModify: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure Reset; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function UseRightToLeftAlignment: Boolean; override;
    property Field: TField read GetField;
  published
   // ...
  end;

Пример 11.3. Реализация TDBEdit (сокращено)

constructor TDBEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  inherited ReadOnly := True;
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  FDataLink.OnActiveChange := ActiveChange;
end;

destructor TDBEdit.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  FCanvas.Free;
  inherited Destroy;
end;



procedure TDBEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if (Key = VK_DELETE) or ((Key = VK_INSERT) and (ssShift in Shift)) then
    FDataLink.Edit;
end;

procedure TDBEdit.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
    not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        SelectAll;
        Key := #0;
      end;
  end;
end;

function TDBEdit.EditCanModify: Boolean;
begin
  Result := FDataLink.Edit;
end;

procedure TDBEdit.Reset;
begin
  FDataLink.Reset;
  SelectAll;
end;

procedure TDBEdit.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    if (FAlignment <> taLeftJustify) and not IsMasked then Invalidate;
    FDataLink.Reset;
  end;
end;

procedure TDBEdit.Change;
begin
  FDataLink.Modified;
  inherited Change;
end;

function TDBEdit.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TDBEdit.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TDBEdit.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TDBEdit.SetDataField(const Value: string);
begin
  if not (csDesigning in ComponentState) then
    ResetMaxLength;
  FDataLink.FieldName := Value;
end;

function TDBEdit.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TDBEdit.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TDBEdit.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TDBEdit.ActiveChange(Sender: TObject);
begin
  ResetMaxLength;
end;

procedure TDBEdit.DataChange(Sender: TObject);
begin
  if FDataLink.Field <> nil then
  begin
    if FAlignment <> FDataLink.Field.Alignment then
    begin
      EditText := '';  {forces update}
      FAlignment := FDataLink.Field.Alignment;
    end;
    EditMask := FDataLink.Field.EditMask;
    if not (csDesigning in ComponentState) then
    begin
      if (FDataLink.Field.DataType in [ftString, ftWideString]) and (MaxLength = 0) then
        MaxLength := FDataLink.Field.Size;
    end;
    if FFocused and FDataLink.CanModify then
      Text := FDataLink.Field.Text
    else
    begin
      EditText := FDataLink.Field.DisplayText;
      if FDataLink.Editing and FDataLink.FModified then
        Modified := True;
    end;
  end else
  begin
    FAlignment := taLeftJustify;
    EditMask := '';
    if csDesigning in ComponentState then
      EditText := Name else
      EditText := '';
  end;
end;

procedure TDBEdit.EditingChange(Sender: TObject);
begin
  inherited ReadOnly := not FDataLink.Editing;
end;

procedure TDBEdit.UpdateData(Sender: TObject);
begin
  ValidateEdit;
  FDataLink.Field.Text := Text;
end;


procedure TDBEdit.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;


function TDBEdit.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;

function TDBEdit.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;