TDBOleContainer (in verbindung mit DBCtrlGrid)

[doctor-x]

Habe einnen teil der lösung

der nachfolgende code bringt zumindest schon mal die verschiedenen inhalte der OleContainer
in den verschiedenen datensätzen zum vorschein, jedoch stimmt die reighenfolge nicht.
Soll heißen, der inhalt des jeweiligen OleContainers gehört jeweils zu einem anderen Datensatz.

Hat jemand eine idee wie man das noch behebt???

Delphi-Quellcode:

unit DBOleContainer;

interface

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

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

procedure Register;

implementation

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

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

function TDBOleContainer.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
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;

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

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

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

procedure TDBOleContainer.DataChange(Sender: TObject);
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;
      Modified := False;
    end; // else CreateObject('ChemDraw.Document.6.0', False);
  end;
//  if HandleAllocated then RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
end;

procedure TDBOleContainer.EditingChange(Sender: TObject);
begin
end;

procedure TDBOleContainer.UpdateData(Sender: TObject);
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);
  finally
    FieldStream.Free;
    MemStream.Free;
  end;
end;

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

procedure TDBOleContainer.Save;
begin
  UpdateData(Self);
end;

procedure TDBOleContainer.WMPaint(var Msg: TWMPaint);
var
  FieldStream: TStream;
  MemStream: TMemoryStream;
begin
  inherited;
  if not (csPaintCopy in ControlState) then begin

  end else 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;
        Modified := False;
      end;// else CreateObject('ChemDraw.Document.6.0', False);
    end;
  end;
end;

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

end.