to
aulBlue
你的第三个想法我也曾经试过，不过没有成功。
我认为比较可行的办法是用OleContainer来实现。
另外有一位高手提供了一个DBOleContainer控件，你可以实验一下，如果成功的话，把你的代码也
给我mail一份：watter@sina.com
控件DBOleContainer的单元文件代码：
unit DBOleContainer;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
OleCtnrs, DB, DBCtrls, dbtables;
type
TDBOleContainer = class(TOleContainer)
private
FFixedOleClassName : String;
FConfirmDelete:Boolean;
FDataLink :TFieldDataLink;
FLocked: Boolean
FOLEEditing:Boolean;
procedure DataChange(Sender :TObject);
function GetDataField:string;
function GetDataSource:TDataSource;
function GetField:TField;
function GetReadOnly: Boolean;
procedure SetDataField(Value:string);
procedure SetDataSource(Value:TDataSource);
procedure SetReadOnly(Value:Boolean);
procedure UpdateData(Sender :TObject);
procedure CMExit(var Message:TWMNoParams);MESSAGE CM_Exit;
protected
procedure Changed;override;
procedure DblClick;override;
procedure Notification(AComponent: TComponent;
Operation: TOperation)
override;
public
property Field:TField read GetField;
constructor Create(Owner:TComponent);override;
destructor Destroy;override;
procedure Active;
procedure KeyUp(var Key: Word
Shift: TShiftState)
override;
published
property ConfirmDelete:Boolean read FConfirmDelete write FConfirmDelete default True;
property DataField:string read GetDataField write SetDataField;
property DataSource:TDataSource read GetDataSource write SetDataSource;
property ReadOnly:Boolean read GetReadOnly write SetReadOnly default false;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('User Controls', [TDBOleContainer]);
end;
//---------------------------------------------------------------------------
constructor TDBOleContainer.Create(Owner:TComponent);
begin
inherited Create(Owner);
ConfirmDelete:=True;
ControlStyle := ControlStyle + [csReplicatable];
FDataLink := TFieldDataLink.create;
FDataLink.Control := self;
FDataLink.OnDataChange := DataChange;
FDataLink.OnUpdateData := UpdateData;
AllowInPlace:=False;
FLocked:=False;
FOLEEditing:=False;
FFixedOleClassName:='';
end;
//---------------------------------------------------------------------------
destructor TDBOleContainer.Destroy;
begin
FDataLink.Control := nil;
FDataLink.OnDataChange := nil;
FDataLink.OnUpdateData := nil;
FDataLink.free;
inherited Destroy;
end;
//---------------------------------------------------------------------------
procedure TDBOleContainer.Changed;
begin
if FOLEEditing then Exit;
if (csDesigning in ComponentState) then
FFixedOleClassName:=inherited OleClassName
else if not FLocked then
begin
if FDataLink.Active and (not FDataLink.ReadOnly) then
begin
if not FDataLink.Editing then
begin
FDataLink.OnDataChange := nil;
FDataLink.Edit;
FDataLink.OnDataChange := DataChange;
end;
if FDataLink.Editing then
begin
FDataLink.Modified;
inherited Changed;
end
else
DataChange(nil);
end
else
DataChange(nil);
end;
end;
procedure TDBOleContainer.Active;
begin
if not (State in [osEmpty]) then
begin
FDataLink.OnDataChange := nil;
try
DoVerb(ovShow);
except
FDataLink.DataSet.Edit;
try
DoVerb(ovShow);
except
end;
end;
FDataLink.OnDataChange := DataChange;
end
else (*if FDataLink.CanModify and InsertObjectDialog then
begin
if not FDataLink.Editing then
begin
FDataLink.OnDataChange := nil;
FDataLink.Edit;
FDataLink.OnDataChange := DataChange;
end;
DoVerb(ovShow);
end;
*)
if FDataLink.CanModify then
begin
FOLEEditing:=True;
if InsertObjectDialog then
begin
inherited DblClick;
if not FDataLink.Editing then
begin
FDataLink.OnDataChange := nil;
FDataLink.Edit;
FDataLink.OnDataChange := DataChange;
end;
end;
FOLEEditing:=False;
Changed;
end;
end;
//---------------------------------------------------------------------------
procedure TDBOleContainer.DblClick;
begin
{$IFDEF OLD_VER}
if not (State in [osEmpty]) then
DoVerb(ovShow)
else
begin
if FDataLink.CanModify and InsertObjectDialog then
begin
inherited DblClick;
if not FDataLink.Editing then
begin
FDataLink.OnDataChange := nil;
FDataLink.Edit;
FDataLink.OnDataChange := DataChange;
end;
end;
end;
{$ELSE}
if not (State in [osEmpty]) then
DoVerb(ovShow)
else
begin
if FDataLink.CanModify then
begin
FOLEEditing:=True;
if InsertObjectDialog then
begin
inherited DblClick;
if not FDataLink.Editing then
begin
FDataLink.OnDataChange := nil;
FDataLink.Edit;
FDataLink.OnDataChange := DataChange;
end;
end;
FOLEEditing:=False;
Changed;
end;
end;
{$ENDIF}
end;
//---------------------------------------------------------------------------
procedure TDBOleContainer.DataChange(Sender :TObject);
var
Stream: TStream;
begin
if (csDesigning in ComponentState) then exit;
FLocked:=True;
Self.Iconic:=False;
Self.AllowInPlace:=False;
if not (State in [osEmpty]) then
Self.DestroyObject;
if FDataLink.Active and Assigned(FDataLink.Field) and
(not FDataLink.Field.IsNull) and (FDataLink.Field.IsBlob) then
begin
Stream:=FDataLink.DataSet.CreateBlobStream(FDataLink.Field,bmRead);
try
LoadFromStream(Stream);
except
end;
Stream.Free;
end
else if (FFixedOleClassName<>'') then
CreateObject(FFixedOleClassName,Self.Iconic);
Self.Modified:=False;
Self.Iconic:=False;
FLocked:=False;
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;
//---------------------------------------------------------------------------
function TDBOleContainer.GetReadOnly: Boolean;
begin
Result:=FDataLink.ReadOnly;
end;
//---------------------------------------------------------------------------
procedure TDBOleContainer.SetDataField(Value:string);
begin
FDataLink.FieldName := Value;
end;
//---------------------------------------------------------------------------
procedure TDBOleContainer.KeyUp(var Key: Word
Shift: TShiftState);
begin
if(Key in [VK_DELETE,VK_SPACE]) and (not (State in [osEmpty])) and
(not FDataLink.ReadOnly) and FDataLink.CanModify and FConfirmDelete and
(Application.MessageBox('删除OLE文档内容?','确认',
MB_YESNO+MB_DEFBUTTON1+MB_ICONQUESTION)=IDYES) then
begin
if not FDataLink.Editing then
begin
FDataLink.OnDataChange := nil;
FDataLink.Edit;
FDataLink.OnDataChange := DataChange;
end;
if FDataLink.Editing then
begin
Self.DestroyObject;
FDataLink.Modified;
end;
end;
inherited;
end;
//---------------------------------------------------------------------------
procedure TDBOleContainer.SetDataSource(Value:TDataSource);
begin
if (Value <> nil) then
Value.FreeNotification(self);
FDataLink.DataSource := Value;
end;
//---------------------------------------------------------------------------
procedure TDBOleContainer.SetReadOnly(Value:Boolean);
begin
FDataLink.ReadOnly:=Value;
end;
//---------------------------------------------------------------------------
procedure TDBOleContainer.UpdateData(Sender :TObject);
var
Stream: TStream;
begin
if (FDataLink.Field.IsBlob) and FDataLink.DataSource.AutoEdit then
begin
if State in [osEmpty] then
Field.Clear
else
begin
Stream:=FDataLink.DataSet.CreateBlobStream(FDataLink.Field,bmReadWrite);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
end;
end;
//---------------------------------------------------------------------------
procedure TDBOleContainer.CMExit(var Message:TWMNoParams);
begin
try
FDataLink.UpdateRecord;
except
if CanFocus then
SetFocus;
raise;
end;
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;
end.
