DBOleContainer (Die Lösung)

[doctor-x]

Hallo an alle!

Ich habe es nach langem hin und her glaube ich endlich geschafft meinen DBOleContainer fertig zu stellen
und er funktioniert sogar im DBCtrlGrid. :-D

Wehrmutstropfen:
Man muss im property OleClasName die jeweils verwendete Ole-Klasse eintragen , da sonst ein editiren eines lehren feldes fehlschlägt!

Voraussetzung: Man besitzt die nach meiner beschreibung umgestrickte OleCtnrs Unit! Siehe Hier

Folgenden Code könnt ihr einfach kopieren, unter dem Dateinamen 'DBOleContainer.pas' speichern und dann
unter Komponente --> Komponente installieren.. auswählen und installieren.
(Ihr müst vieleicht noch den Klassen vorfahren ändern. kommt darauf an wie ihr die Klase in der veränderten OleCtnrs genannt habt!)

Und das wichtigste sich freuen :wink:

PS: über ein feedback währe ich dankbar 8)

Hier der Code:

Delphi-Quellcode:

unit DBOleContainer;

//Diese Unit wurde in Borland Delphi 7 erstellt.
//Erstellt von W. Heidler am: 08.04.2009
//Letzte Änderung von W. Heidler am: 28.04.2009

interface

uses
  SysUtils, Classes, Controls, WHOleContainer, DBCtrls, DB, Messages, Windows, Forms,
  ActiveX, OleDlg, Menus, ComObj, OleConst;

type
  TDBOleContainer = class(TWHOleContainer)
  private
    FDataLink: TFieldDataLink;
    FOleClassName: string;
    procedure LoadFromField;
    procedure SaveToField;
    procedure DataChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Field: TField read GetField;
    procedure Change; override;
  published
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property OleClassName: string read FOleClassName write FOleClassName;
  end;

procedure Register;

implementation

procedure TDBOleContainer.LoadFromField;
var
  FieldStream: TStream;
  MemStream: TMemoryStream;
begin
  if FDataLink.Field <> nil then begin
    if not FDataLink.Field.IsNull then begin
      try
        MemStream := TMemoryStream.Create;
        FieldStream := FDataLink.Field.DataSet.CreateBlobStream(Field, bmRead);
        MemStream.LoadFromStream(FieldStream);
        LoadFromStream(MemStream);
      finally
        FieldStream.Free;
        MemStream.Free;
      end;
    end else CreateObject(FOleClassName, Iconic);
  end;
end;

procedure TDBOleContainer.SaveToField;
var
  FieldStream: TStream;
  MemStream: TMemoryStream;
begin
  try
    MemStream := TMemoryStream.Create;
    SaveToStream(MemStream);
    FDataLink.Field.DataSet.Edit;
    FieldStream := FDataLink.Field.DataSet.CreateBlobStream(Field, bmWrite);
    MemStream.SaveToStream(FieldStream);
    Modified := False;
  finally
    FieldStream.Free;
    MemStream.Free;
  end;
end;

procedure TDBOleContainer.DataChange(Sender: TObject);
begin
  LoadFromField;
end;

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

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

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

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

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

procedure TDBOleContainer.WMPaint(var Msg: TWMPaint);
var
  FieldStream: TStream;
  MemStream: TMemoryStream;
begin
  if not Focused then LoadFromField else Changed;
  inherited;
end;

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

constructor TDBOleContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
end;

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

procedure TDBOleContainer.Change;
begin
  SaveToField;
  inherited;
end;

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

end.

[doctor-x]

Hab noch einen fehler gefunden. Im anhnag die verbesserte version.