C
ChDw
Unregistered / Unconfirmed
GUEST, unregistred user!
我为了使到TRichEdit支持显示图片增加了以下代码,但是我发现在两个TOleRichEdit中拖支图片没有问题,但是当我拖动一个文件进入这个TOleRichEdit中时则出现程序停止响应的问题。我的代码有什么问题吗?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComObj,axCtrls,activex,richedit,comctrls, StdCtrls;
type
IRichEditOleCallback = interface(IUnknown)
['{00020D03-0000-0000-C000-000000000046}']
function GetNewStorage: IStorage; safecall;
procedure GetInPlaceContext(out Frame: IOleInPlaceFrame;
out Doc: IOleInPlaceUIWindow;
var FrameInfo: TOleInPlaceFrameInfo); safecall;
procedure ShowContainerUI(fShow: Bool); safecall;
procedure QueryInsertObject(const ClsID: TCLSID; Stg: IStorage; CP: Longint); safecall;
procedure DeleteObject(OleObj: IOleObject); safecall;
procedure QueryAcceptData(dataobj: IDataObject; var cfFormat: TClipFormat;
reCO: DWord; fReally: Bool; hMetaPict: HGlobal); safecall;
function ContextSensitiveHelp(fEnterMode: Bool): HResult; stdcall;
function GetClipboardData(const ChRg: TCharRange; reCO: DWord;
out DataObj: IDataObject): HResult; stdcall;
procedure GetDragDropEffect(fDrag: Bool; grfKeyState: DWord;
var dwEffect: DWord); safecall;
procedure GetContextMenu(SelType: Word; OleObj: IOleObject;
const ChRg: TCharRange; var Menu: HMenu); safecall;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TRichEditOleCallback = class(TInterfacedObject, IRichEditOleCallback)
private
FOwner: TRichEdit;
protected
{ IRichEditOleCallback }
function GetNewStorage: IStorage; safecall;
procedure GetInPlaceContext(out Frame: IOleInPlaceFrame;
out Doc: IOleInPlaceUIWindow;
var FrameInfo: TOleInPlaceFrameInfo); safecall;
procedure ShowContainerUI(fShow: Bool); safecall;
procedure QueryInsertObject(const ClsID: TCLSID; Stg: IStorage; CP: Longint); safecall;
procedure DeleteObject(OleObj: IOleObject); safecall;
procedure QueryAcceptData(dataobj: IDataObject; var cfFormat: TClipFormat;
reCO: DWord; fReally: Bool; hMetaPict: HGlobal); safecall;
function ContextSensitiveHelp(fEnterMode: Bool): HResult; stdcall;
function GetClipboardData(const ChRg: TCharRange; reCO: DWord;
out DataObj: IDataObject): HResult; stdcall;
procedure GetDragDropEffect(fDrag: Bool; grfKeyState: DWord;
var dwEffect: DWord); safecall;
procedure GetContextMenu(SelType: Word; OleObj: IOleObject;
const ChRg: TCharRange; var Menu: HMenu); safecall;
public
constructor Create(Owner: TRichEdit);
destructor Destroy; override;
end;
TOleRichEdit = class(TRichEdit)
protected
procedure CreateHandle; override;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
constructor TRichEditOleCallback.Create(Owner: TRichEdit);
begin
inherited Create;
FOwner := Owner
end;
destructor TRichEditOleCallback.Destroy;
begin
inherited;
end;
function TRichEditOleCallback.ContextSensitiveHelp(fEnterMode: Bool): HResult;
begin
Result := E_NOTIMPL
end;
procedure TRichEditOleCallback.DeleteObject(OleObj: IOleObject);
begin
//关闭ole对象,并且不保存
OleObj.Close(OLECLOSE_NOSAVE);
end;
function TRichEditOleCallback.GetClipboardData(const ChRg: TCharRange; reCO: DWord; out DataObj: IDataObject): HResult;
begin
Result := E_NOTIMPL
end;
procedure TRichEditOleCallback.GetContextMenu(SelType: Word;
OleObj: IOleObject; const ChRg: TCharRange; var Menu: HMenu);
begin
//没有任何上下文菜单
Menu := 0
end;
procedure TRichEditOleCallback.GetDragDropEffect(fDrag: Bool;
grfKeyState: DWord; var dwEffect: DWord);
begin
//使用缺省的拖放效果
end;
procedure TRichEditOleCallback.GetInPlaceContext(
out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow;
var FrameInfo: TOleInPlaceFrameInfo);
begin
//
end;
function TRichEditOleCallback.GetNewStorage: IStorage;
var
LockBytes: ILockBytes;
begin
//从TOleContainer.CreateStorage方法中复制过来的,
//简单地说就是在内存中创建一个存储
OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
OleCheck(StgCreateDocfileOnILockBytes(LockBytes,
STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Result));
end;
procedure TRichEditOleCallback.QueryAcceptData(dataobj: IDataObject;
var cfFormat: TClipFormat; reCO: DWord; fReally: Bool;
hMetaPict: HGlobal);
begin
//接受所有拖放
end;
procedure TRichEditOleCallback.QueryInsertObject(const ClsID: TCLSID;
Stg: IStorage; CP: Integer);
begin
//接受所有插入对象
end;
procedure TRichEditOleCallback.ShowContainerUI(fShow: Bool);
begin
end;
procedure TOleRichEdit.CreateHandle;
begin
inherited;
Perform(em_SetOleCallback, 0,
Longint(TRichEditOleCallback.Create(Self) as IRichEditOleCallback))
end;
procedure TForm1.Button1Click(Sender: TObject);
var
rh : TOleRichEdit ;
begin
rh := TOleRichEdit.Create(Self);
rh.width := 300;
rh.Height := 200;
rh.Parent := Self;
rh.Lines.LoadFromFile('C:/Rtf.rtf');//这是一个带有图片的RTF
rh := TOleRichEdit.Create(Self);
rh.width := 300;
rh.Height := 200;
rh.Parent := Self;
rh.Top := 350;
rh.Lines.LoadFromFile('C:/Rtf.rtf');//这是一个带有图片的RTF
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComObj,axCtrls,activex,richedit,comctrls, StdCtrls;
type
IRichEditOleCallback = interface(IUnknown)
['{00020D03-0000-0000-C000-000000000046}']
function GetNewStorage: IStorage; safecall;
procedure GetInPlaceContext(out Frame: IOleInPlaceFrame;
out Doc: IOleInPlaceUIWindow;
var FrameInfo: TOleInPlaceFrameInfo); safecall;
procedure ShowContainerUI(fShow: Bool); safecall;
procedure QueryInsertObject(const ClsID: TCLSID; Stg: IStorage; CP: Longint); safecall;
procedure DeleteObject(OleObj: IOleObject); safecall;
procedure QueryAcceptData(dataobj: IDataObject; var cfFormat: TClipFormat;
reCO: DWord; fReally: Bool; hMetaPict: HGlobal); safecall;
function ContextSensitiveHelp(fEnterMode: Bool): HResult; stdcall;
function GetClipboardData(const ChRg: TCharRange; reCO: DWord;
out DataObj: IDataObject): HResult; stdcall;
procedure GetDragDropEffect(fDrag: Bool; grfKeyState: DWord;
var dwEffect: DWord); safecall;
procedure GetContextMenu(SelType: Word; OleObj: IOleObject;
const ChRg: TCharRange; var Menu: HMenu); safecall;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TRichEditOleCallback = class(TInterfacedObject, IRichEditOleCallback)
private
FOwner: TRichEdit;
protected
{ IRichEditOleCallback }
function GetNewStorage: IStorage; safecall;
procedure GetInPlaceContext(out Frame: IOleInPlaceFrame;
out Doc: IOleInPlaceUIWindow;
var FrameInfo: TOleInPlaceFrameInfo); safecall;
procedure ShowContainerUI(fShow: Bool); safecall;
procedure QueryInsertObject(const ClsID: TCLSID; Stg: IStorage; CP: Longint); safecall;
procedure DeleteObject(OleObj: IOleObject); safecall;
procedure QueryAcceptData(dataobj: IDataObject; var cfFormat: TClipFormat;
reCO: DWord; fReally: Bool; hMetaPict: HGlobal); safecall;
function ContextSensitiveHelp(fEnterMode: Bool): HResult; stdcall;
function GetClipboardData(const ChRg: TCharRange; reCO: DWord;
out DataObj: IDataObject): HResult; stdcall;
procedure GetDragDropEffect(fDrag: Bool; grfKeyState: DWord;
var dwEffect: DWord); safecall;
procedure GetContextMenu(SelType: Word; OleObj: IOleObject;
const ChRg: TCharRange; var Menu: HMenu); safecall;
public
constructor Create(Owner: TRichEdit);
destructor Destroy; override;
end;
TOleRichEdit = class(TRichEdit)
protected
procedure CreateHandle; override;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
constructor TRichEditOleCallback.Create(Owner: TRichEdit);
begin
inherited Create;
FOwner := Owner
end;
destructor TRichEditOleCallback.Destroy;
begin
inherited;
end;
function TRichEditOleCallback.ContextSensitiveHelp(fEnterMode: Bool): HResult;
begin
Result := E_NOTIMPL
end;
procedure TRichEditOleCallback.DeleteObject(OleObj: IOleObject);
begin
//关闭ole对象,并且不保存
OleObj.Close(OLECLOSE_NOSAVE);
end;
function TRichEditOleCallback.GetClipboardData(const ChRg: TCharRange; reCO: DWord; out DataObj: IDataObject): HResult;
begin
Result := E_NOTIMPL
end;
procedure TRichEditOleCallback.GetContextMenu(SelType: Word;
OleObj: IOleObject; const ChRg: TCharRange; var Menu: HMenu);
begin
//没有任何上下文菜单
Menu := 0
end;
procedure TRichEditOleCallback.GetDragDropEffect(fDrag: Bool;
grfKeyState: DWord; var dwEffect: DWord);
begin
//使用缺省的拖放效果
end;
procedure TRichEditOleCallback.GetInPlaceContext(
out Frame: IOleInPlaceFrame; out Doc: IOleInPlaceUIWindow;
var FrameInfo: TOleInPlaceFrameInfo);
begin
//
end;
function TRichEditOleCallback.GetNewStorage: IStorage;
var
LockBytes: ILockBytes;
begin
//从TOleContainer.CreateStorage方法中复制过来的,
//简单地说就是在内存中创建一个存储
OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
OleCheck(StgCreateDocfileOnILockBytes(LockBytes,
STGM_READWRITE or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Result));
end;
procedure TRichEditOleCallback.QueryAcceptData(dataobj: IDataObject;
var cfFormat: TClipFormat; reCO: DWord; fReally: Bool;
hMetaPict: HGlobal);
begin
//接受所有拖放
end;
procedure TRichEditOleCallback.QueryInsertObject(const ClsID: TCLSID;
Stg: IStorage; CP: Integer);
begin
//接受所有插入对象
end;
procedure TRichEditOleCallback.ShowContainerUI(fShow: Bool);
begin
end;
procedure TOleRichEdit.CreateHandle;
begin
inherited;
Perform(em_SetOleCallback, 0,
Longint(TRichEditOleCallback.Create(Self) as IRichEditOleCallback))
end;
procedure TForm1.Button1Click(Sender: TObject);
var
rh : TOleRichEdit ;
begin
rh := TOleRichEdit.Create(Self);
rh.width := 300;
rh.Height := 200;
rh.Parent := Self;
rh.Lines.LoadFromFile('C:/Rtf.rtf');//这是一个带有图片的RTF
rh := TOleRichEdit.Create(Self);
rh.width := 300;
rh.Height := 200;
rh.Parent := Self;
rh.Top := 350;
rh.Lines.LoadFromFile('C:/Rtf.rtf');//这是一个带有图片的RTF
end;
end.