TDBOleContainer (in verbindung mit DBCtrlGrid)

[doctor-x]

Hallo an alle.

Ich bin auf der suche nach einer TDBOleContainer componente, habe angefangen mir eine selbst zusammen zu basteln, aber folgendes problem dabei:

Auf einem DBCtrlGrid zeigt der OleConteiner immer nur den aktiven (Markirten) Datensatz an und nicht den jeweils dazugehörigen.

ich denke das man das im Paint ereigniss irgendiwe einbeziehen muss, aber ich weiß leider nicht wie...

Hier mal mein Code:

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 CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  protected
    procedure Paint; override;
  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

uses
  Wolf;

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;
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.Paint;
begin
  //????????
end;

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

end.

[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.

[doctor-x]

Hab die richtige anzeige dann letztendlich auch noch hin bekommen, aber jetzt gibt es ein problem wenn ich den inhalt es Containers bearbeiten will

Delphi-Quellcode:

procedure TDBOleContainer.WMPaint(var Msg: TWMPaint);
var
  FieldStream: TStream;
  MemStream: TMemoryStream;
begin
  inherited;
  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;