Шаг 26.
Использование OLE-документов в приложениях. Хранение OLE-объектов в базах данных. Создание OLE-контейнера в виде VCL-компонента

    На этом шаге мы рассмотрим создание компонента, реализующего указанную задачу.

    Приведенный на предыдущем шаге пример имеет ряд недостатков. Так, если внести изменения в объект, содержащийся в OLE-коптейнере, а затем закрыть приложение, то содержимое контейнера не будет сохранено в таблице. Дело в том, что при редактировании объектов в OLE-контейнере компонент TTable не информируется о происходящих изменениях, поэтому не выставляется флаг, свидетельствующий о том, что данная запись пользователем изменена. Соответственно, на компоненте TDBNavigator недоступны кнопки Post и Cancel.

    Выход в данной ситуации заключается в создании на базе TOleContainег компонента, чувствительного к данным (data-aware component). В компонентах такого типа должен быть создан объект TDataFieldLink. Этот объект связывается с источником данных и каким-либо определенным полем из таблицы. Он имеет событие OnDataChange, происходящее всякий раз, когда новые данные считываются из таблицы. В обработчике этого события данные помещаются в OLE-контейнер. Другое событие - OnUpdateData - вызывается для считывания совершенных изменений. Это событие вызывается только в том случае, если либо ранее был вызван метод Edit объекта TDataFieldLink, переводящий текущую запись в состояние редактирования; либо свойство Modified равно True. Последнее говорит о том, что в записи были сделаны изменения.

    Поскольку компонент TOleContainег не имеет события OnChange (как, например, компонент TEdit), то метод Modified следует вызывать при активации OLE-контейиера, а также при выполнении метода InsertObjectDialog и при очистке содержимого OLE-контейнера. Соответственно, эти два метода в компоненте TDBOleContainег перекрыты. Кроме того, чувствительные к данным компоненты обязаны откликаться на сообщение CM_GETDATALINK и возвращать источник данных.

    Исходный текст компонента TDBO1eContainег приведен ниже: 

unit DBOleContainer;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtnrs, DB, DBCtrls;

type
  TDBOleContainer = class(TOleContainer)
  private
    { Private declarations }
    FDataLink: TFieldDataLink;
    FAutoDisplay: Boolean;
    FFocused: Boolean;
    FObjectLoaded: Boolean;
    FDummy:integer;
    FFromActivate:boolean;
    procedure DataChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure SetAutoDisplay(Value: Boolean);
    procedure SetFocused(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); 
                    message WM_LBUTTONDBLCLK;
    procedure CMGetDataLink(var Message: TMessage); 
                    message CM_GETDATALINK;
    procedure DoDeactivate(Sender:TObject);
  protected
    { Protected declarations }
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure LoadObject; virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Field: TField read GetField;
    function InsertObjectDialog:boolean;
    procedure DestroyObject;
  published
    { Published declarations }
    property DataSource:TDataSource read GetDataSource write SetDataSource;
    property DataField:string read GetDataField write SetDataField;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property AutoDisplay: Boolean read FAutoDisplay 
        write SetAutoDisplay default True;
    property AutoActivate:integer read FDummy;
  end;

procedure Register;

implementation

const
  Signature:integer=-525465623;

constructor TDBOLEContainer.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  inherited AutoActivate:=aaDoubleClick;
  ControlStyle:=ControlStyle+[csReplicatable];
  FAutoDisplay:=True;
  FDataLink:=TFieldDataLink.Create;
  FDataLink.Control:=Self;
  FDataLink.OnDataChange:=DataChange;
  FDataLink.OnUpdateData:=UpdateData;
  OnDeactivate:=DoDeactivate;
end;

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

procedure TDBOLEContainer.Loaded;
begin
  inherited Loaded;
  if (csDesigning in ComponentState) then DataChange(Self);
end;

procedure TDBOLEContainer.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation=opRemove) and (FDataLink<>nil) and
    (AComponent=DataSource) then DataSource:=nil;
end;

procedure TDBOLEContainer.DoDeactivate(Sender:TObject);
begin
  if Modified then begin
    if not FDataLink.Editing then FDataLink.Edit;
    FDataLink.Modified;
  end;
end;

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

procedure TDBOLEContainer.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource:=Value;
  if Value<>nil then Value.FreeNotification(Self);
end;

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

procedure TDBOLEContainer.SetDataField(const Value: string);
begin
  FDataLink.FieldName:=Value;
end;

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

procedure TDBOLEContainer.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly:=Value;
  if Value then 
     inherited AutoActivate:=aaDoubleClick 
  else inherited AutoActivate:=aaManual;
end;

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

procedure TDBOLEContainer.LoadObject;
var
  Stream:TMemoryStream;
  N:integer;
begin
  if not FObjectLoaded and 
          Assigned(FDataLink.Field) and FDataLink.Field.IsBlob then 
  begin
    inherited DestroyObject;
    Stream:=nil;
    try
      {Creation memory stream and saving content from database}
      Stream:=TMemoryStream.Create;
      TBlobField(FDataLink.Field).SaveToStream(Stream);
      Stream.Seek(0,soFromBeginning);
      if Stream.Size>4 then begin
      {if size<4 then bad field - even though signature was not entered}
        Stream.Read(N,sizeof(N));
        if N=Signature then LoadFromStream(Stream);
      end;
      if Assigned(Stream) then begin
        Stream.Free;
        Stream:=nil;
      end;
      FObjectLoaded:=True;
    except
      on E:exception do begin
        if Assigned(Stream) then Stream.Free;
        MessageDlg(E.Message,mtError,[mbOK],0);
      end;
    end;
    Modified:=False;
  end;
end;

procedure TDBOLEContainer.DataChange(Sender: TObject);
begin
  if (FDataLink.Field <>nil) then if FDataLink.Field.IsBlob then begin
    if FAutoDisplay or (FDataLink.Editing and FObjectLoaded) then begin
      FObjectLoaded:=False;
      LoadObject;
    end else begin
      FObjectLoaded:=False;
    end;
  end;
  if HandleAllocated then 
        RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
end;

procedure TDBOLEContainer.UpdateData(Sender: TObject);
var
  Stream:TMemoryStream;
begin
  {Read OLE data from container}
  if FDataLink.Field.IsBlob then begin
    Stream:=nil;
    try
      Stream:=TMemoryStream.Create;
      Stream.Write(Signature,sizeof(Signature));
      if Assigned(OleObjectInterface) then SaveToStream(Stream);
      Stream.Seek(0,soFromBeginning);
      TBlobField(FDataLink.Field).LoadFromStream(Stream);
      if Assigned(Stream) then begin
        Stream.Free;
        Stream:=nil;
      end;
      Modified:=False;
    except
      on E:exception do begin
        if Assigned(Stream) then Stream.Free;
        MessageDlg(E.Message,mtError,[mbOK],0);
      end;
    end;
  end;
end;

procedure TDBOLEContainer.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused:=Value;
    if not Assigned(FDataLink.Field) or not FDataLink.Field.IsBlob then
      FDataLink.Reset;
  end;
end;

procedure TDBOLEContainer.CMEnter(var Message: TCMEnter);
begin
  if FFromActivate then begin
    inherited;
    Exit;
  end;
  SetFocused(True);
  inherited;
end;

procedure TDBOLEContainer.CMExit(var Message: TCMExit);
begin
  if FFromActivate then begin
    inherited;
    Exit;
  end;
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;
  SetFocused(False);
  inherited;
end;

procedure TDBOLEContainer.SetAutoDisplay(Value: Boolean);
begin
  if FAutoDisplay <> Value then
  begin
    FAutoDisplay:=Value;
    if Value then LoadObject;
  end;
end;

procedure TDBOLEContainer.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  if Assigned(OleObjectInterface) then try
    FFromActivate:=True;
    FDataLink.Edit;
    inherited;
    FDataLink.Modified;
  finally
    FFromActivate:=False;
  end else try
    FFromActivate:=True;
    FObjectLoaded:=True;
    FDataLink.Edit;
    if inherited InsertObjectDialog then FDataLink.Modified;
  finally
    FFromActivate:=False;
  end;
end;

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

function TDBOLEContainer.InsertObjectDialog:boolean;
begin
  Result:=False;
  try
    FFromActivate:=True;
    FObjectLoaded:=True;
    FDataLink.Edit;
    Result:=inherited InsertObjectDialog;
    if Result then FDataLink.Modified;
  finally
    FFromActivate:=False;
  end;
end;

procedure TDBOleContainer.DestroyObject;
begin
  FDataLink.Edit;
  inherited DestroyObject;
  FDataLink.Modified;
  Invalidate;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TDBOleContainer]);
end;

end.
Текст этого компонента можно взять здесь (2,1 Кб).

    Теперь приведем алгоритм его инсталляции. Отметим, что он будет расположен на вкладке Samples: об этом говорит первый параметр процедуры RegisterComponents().

    Выполнете команду File | Close All в среде Delphi, после чего приступайте с созданию заготовки компонента. Для этого выполните пункт меню Component | New Component и заполните поля в соответствии с рисунком 1:


Рис.1. Создание компонента на основе существующего VCL-компонента

    Здесь заполняются следующие поля:

    Нажмите кнопку OK. Появится окно с редактором кода, в котором разместите приведенный выше код. После этого сохраните отредактированный PAS-файл под тем же именем, что и имя компонента. В результате вы получите файл DBOleContainer.pas.

    Теперь установим компонент в палитру компонентов. Для этого выполним пункт меню Component | Install Component. В результате окно, которое заполним соответственно с рисунком 2:


Рис.2. Окно добавления компонента в палитру

    Перечислим поля, которые нужно заполнить:

    По нажатию кнопки OK появляется окно с предупреждением, что пакет будет перестроен:


Рис.3. Окно с предупреждением

    Подтвердив изменение пакета, мы через некоторое время получим сообщение о том, что компонент установлен:


Рис.4. Сообщение об установке компонента

    Напомним, что он находится на вкладке Samples.

    Для тестирования компонента можно создать проект, аналогичный предыдущему, но с компонентом TDBOleContainer. Выполните пункт меню File | New | Application и подтвердите сохранение изменений в пакете.


Рис.5. Приложение на этапе разработки

    Обратите внимание, что использование компонента, чувствительного к данным, приводит к тому, что данные видны па этапе разработки, как и в случае стандартных компонентов DataControls (рисунок 5).

    Создадим для кнопок соответствующие обработчики событий. Кнопка Insert используется для размещения в поле нового OLE-компонента: 

procedure TForm1.Button1Click(Sender: TObject);
//Insert
begin
  if DBOleContainer1.InsertObjectDialog then
    if Assigned(DBOLEContainer1.DataSource)
    then DBOLEContainer1.DataSource.Edit;
end;

    Кнопка Destroy очищает поле: 

procedure TForm1.Button2Click(Sender: TObject);
//Destroy
begin
  DBOLEContainer1.DestroyObject;
  if Assigned(DBOLEContainer1.DataSource) then
     DBOLEContainer1.DataSource.Edit;
end;
Текст этого приложения со всеми дополнительными файлами можно взять здесь (262,6 Кб).

    Таким образом, мы получили приложение, позволяющее сохранять OLE-объекты в базах данных и свободное от указанных выше недостатков.

    В заключение поясним, как можно удалить установленный на этом шаге компонент.

    Выполним пункт меню Component | Install Packages. В появившемся окне выберем пакет, указанный на рисунке 6, и нажмем кнопку Edit:


Рис.6. Выбор пакета для редактирования

    Подтвердив открытие пакета, вы увидите окно, приведенное на рисунке 7:


Рис.7. Содержимое пакета

    Выбираем компонент, согласно рисунку 7, и нажимаем клавишу Remove для удаления компонента, а затем Compile для перекомпиляции пакета. Через некоторое время появится сообщение о деинсталляции компонента, аналогичное приведенному на рисунке 4. При закрытии окна не забудьте подтвердить сохранение изменений в пакете.

    Со следующего шага мы начнем рассматривать создание и использование серверов и контроллеров автоматизации.




Предыдущий шаг Содержание Следующий шаг