今天在整理自己以前写的棋牌游戏的时候，在RICHEDIT中插入图片的方法想不起来了。因此在网上找了一番，现将找的文章记录下来便于以后再次查找呵呵。
许多人在找RichEdit中插入GIF图片的方法，这里摘录一段我的一个程序的片段，
程序中使用了QQ中的OleImage.dll，要先象安装OCX控件一样安装，安装后产生一ImageOleLib_TLB文件，
要加入到工程中，并要安装rxRichEdit控件。
首先加入一单元InsRich(见下)，再调用函数InsertGif（见下），下面还摘选了一段我使用的
代码。
unit InsRich;
interface
uses
Windows, Messages, ActiveX;
const
REO_CP_SelectION = ULONG(-1);
REO_BELOWBASELINE = $00000002;
REO_RESIZABLE = $00000001;
REO_STATIC = $40000000;
EM_GETOLEINTERFACE = WM_USER + 60;
IID_IUnknown: TGUID = (D1: $00000000; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));
IID_IOleObject: TGUID = (D1: $00000112; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));
type
_ReObject = record
cbStruct: DWORD; { Size of structure }
cp: ULONG; { Character position of Object }
clsid: TCLSID; { Class ID of Object }
pOleObj: IOleObject; { Ole Object interface }
pstg: IStorage; { Associated storage interface }
pOleSite: IOleClientSite; { Associated Client Site interface }
sizel: TSize; { Size of Object (may be 0,0) }
dvAspect: Longint; { Display aspect to use }
dwFlags: DWORD; { Object status flags }
dwUser: DWORD; { Dword for user憇 use }
end;
TReObject = _ReObject;
TCharRange = record {Copy From RichEdit.pas}
cpMin: Integer;
cpMax: Integer;
end;
TFormatRange = record
hdc: Integer;
hdcTarget: Integer;
rectRegion: TRect;
rectPage: TRect;
chrg: TCharRange;
end;
IRichEditOle = interface(System.IUnknown)
['{00020d00-0000-0000-c000-000000000046}']
function GetClientSite(out ClientSite: IOleClientSite): HResult; stdcall;
function GetObjectCount: HResult; stdcall;
function GetLinkCount: HResult; stdcall;
function GetObject(iob: Longint; out ReObject: TReObject; dwFlags: DWORD): HResult; stdcall;
function InsertObject(var ReObject: TReObject): HResult; stdcall;
function ConvertObject(iob: Longint; rclsidNew: TIID; lpstrUserTypeNew: LPCSTR): HResult; stdcall;
function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
function SetHostNames(lpstrContainerApp: LPCSTR; lpstrContainerObj: LPCSTR): HResult; stdcall;
function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
function SetDvaspect(iob: Longint; dvAspect: DWORD): HResult; stdcall;
function HandsOffStorage(iob: Longint): HResult; stdcall;
function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
function InPlaceDeactivate: HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
function GetClipboardData(var chrg: TCharRange; reco: DWORD; out dataObj: IDataObject): HResult; stdcall;
function ImportDataObject(dataObj: IDataObject; cf: TClipFormat; hMetaPict: HGLOBAL): HResult; stdcall;
end;
implementation
end.
插入到re中，sFileName是GIF图的路径，dwUser是标识别，用一随机数。
procedure InsertGif(re: TRxRichEdit; sFileName: string; dwUser: integer);
type
tagSize = TSize;
var
FRTF: IRichEditOle;
FLockBytes: ILockBytes;
FStorage: ISTORAGE;
FClientSite: IOLECLIENTSITE;
m_lpObject: IOleObject;
m_lpAnimator: TGifAnimator;
i_GifAnimator: IGifAnimator;
reobject: TReObject;
clsid: TGuid;
sizel: tagSize;
Rect: TRect;
begin
try
if CreateILockBytesOnHGlobal(0, True, FLockBytes) <> S_OK then
begin
//showmessage('Error to create Global Heap');
exit;
end;
//????????????
if StgCreateDocfileOnILockBytes(FLockBytes, STGM_SHARE_EXCLUSIVE or
STGM_Create or STGM_READWRITE, 0, FStorage) <> S_OK then
begin
//Showmessage('Error to create storage');
exit;
end;
//??RichEdit???
Sendmessage(re.handle, EM_GETOLEINTERFACE, 0, LongInt(@FRTF));
if FRTF.GetClientSite(FClientSite) <> S_OK then
begin
//ShowMessage('Error to get ClentSite');
Exit;
end;
CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
m_lpAnimator := TGifAnimator.Create(re);
i_GifAnimator := m_lpAnimator.ControlInterface;
i_GifAnimator.LoadFromFile(sFileName);
i_GifAnimator.QueryInterface(IID_IOleObject, m_lpObject);
OleSetContainedObject(m_lpObject, True);
FillChar(ReObject, SizeOf(ReObject), 0);
ReObject.cbStruct := SizeOf(ReObject);
m_lpObject.GetUserClassID(clsid);
ReObject.clsid := clsid;
reobject.cp := REO_CP_SelectION;
//content, but not static
reobject.dvaspect := DVASPECT_CONTENT;
//goes in the same line of text line
reobject.dwFlags := REO_BELOWBASELINE; //REO_RESIZABLE |
reobject.dwUser := 0;
//the very object
reobject.poleobj := m_lpObject;
//client site contain the object
reobject.polesite := FClientSite;
//the storage
reobject.pstg := FStorage;
sizel.cx := 0;
sizel.cy := 0;
reobject.sizel := sizel;
//Sel all text
re.SelText := '';
re.SelLength := 0;
re.SelStart := re.SelStart;
reobject.dwUser := dwUser;
//Insert after the line of text
FRTF.InsertObject(reobject);
SendMessage(re.Handle, EM_SCROLLCARET, 0, 0);
//VARIANT_BOOL ret;
//do frame changing
m_lpAnimator.TriggerFrameChange();
//show it
m_lpObject.DoVerb(OLEIVERB_UIACTIVATE, nil, FClientSite, 0, re.Handle, Rect);
// m_lpObject.DoVerb(
m_lpObject.DoVerb(OLEIVERB_SHOW, nil, FClientSite, 0, re.Handle, Rect);
//redraw the window to show animation
RedrawWindow(re.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ERASENOW or RDW_ALLCHILDREN);
finally
FRTF := nil;
FClientSite := nil;
FStorage := nil;
end;
end;
以下是我程序中使用该函数的代码，供大家参考。
procedure TTextObject.AddGif(re: TRxRichEdit; sFile, sShortCut: string);
var
GifIDMap: TGifIDMap;
i, iGifID: integer;
sFileName: string;
begin
if Pos('\customface\', LowerCase(sFile)) <> 0 then
sFileName := ExtractFilePath(Application.ExeName) + sNumber + sFile
else
sFileName := ExtractFilePath(Application.ExeName) + sFile;
if not FileExists(sFileName) then Exit; // 文件不存在
Randomize;
iGifID := Random(2147483647);
i := 0;
while i < GifIDList.Count do
begin
if TGifIDMap(GifIDList.Items).iGifID = iGifID then
begin
iGifID := Random(2147483647);
i := 0;
Continue;
end;
Inc(i);
end;
InsertGif(re, sFileName, iGifID);// 调用
GifIDMap := TGifIDMap.Create;
GifIDMap.iGifID := iGifID;
GifIDMap.sFileName := sFile;
GifIDMap.sShortCut := sShortCut;
GifIDList.Add(GifIDMap);
end;
procedure TTextObject.ShowRichEdit(re: TRxRichEdit; sHeadStr: string);
var
i, iGifID, iCp: integer;
iShift: integer;
sFileName: string;
begin
re.Lines.BeginUpdate;
// 图行位置偏移量
iShift := Length(sHeadStr);
// 文本
re.Lines.BeginUpdate;
re.Clear;
re.Text := sHeadStr + Text;
re.Lines.EndUpdate;
// 插入Gif
for i := 0 to OleObjectList.Count - 1 do
begin
iCp := TOleObjectMap(OleObjectList.Items).iCp;
iGifID := TOleObjectMap(OleObjectList.Items).iGifID;
sFileName := GetFileName(iGifID);
if sFileName <> '' then // 文件存在时
begin
re.SelStart := iCp + iShift;
re.SelLength := 1;
re.SelText := '';
InsertGif(re, sFileName, iGifID); // 插入
end;
end;
re.Lines.EndUpdate;
end;
程序中使用了QQ中的OleImage.dll，要先象安装OCX控件一样安装，安装后产生一ImageOleLib_TLB文件，
要加入到工程中，并要安装rxRichEdit控件。
首先加入一单元InsRich(见下)，再调用函数InsertGif（见下），下面还摘选了一段我使用的
代码。
unit InsRich;
interface
uses
Windows, Messages, ActiveX;
const
REO_CP_SelectION = ULONG(-1);
REO_BELOWBASELINE = $00000002;
REO_RESIZABLE = $00000001;
REO_STATIC = $40000000;
EM_GETOLEINTERFACE = WM_USER + 60;
IID_IUnknown: TGUID = (D1: $00000000; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));
IID_IOleObject: TGUID = (D1: $00000112; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));
type
_ReObject = record
cbStruct: DWORD; { Size of structure }
cp: ULONG; { Character position of Object }
clsid: TCLSID; { Class ID of Object }
pOleObj: IOleObject; { Ole Object interface }
pstg: IStorage; { Associated storage interface }
pOleSite: IOleClientSite; { Associated Client Site interface }
sizel: TSize; { Size of Object (may be 0,0) }
dvAspect: Longint; { Display aspect to use }
dwFlags: DWORD; { Object status flags }
dwUser: DWORD; { Dword for user憇 use }
end;
TReObject = _ReObject;
TCharRange = record {Copy From RichEdit.pas}
cpMin: Integer;
cpMax: Integer;
end;
TFormatRange = record
hdc: Integer;
hdcTarget: Integer;
rectRegion: TRect;
rectPage: TRect;
chrg: TCharRange;
end;
IRichEditOle = interface(System.IUnknown)
['{00020d00-0000-0000-c000-000000000046}']
function GetClientSite(out ClientSite: IOleClientSite): HResult; stdcall;
function GetObjectCount: HResult; stdcall;
function GetLinkCount: HResult; stdcall;
function GetObject(iob: Longint; out ReObject: TReObject; dwFlags: DWORD): HResult; stdcall;
function InsertObject(var ReObject: TReObject): HResult; stdcall;
function ConvertObject(iob: Longint; rclsidNew: TIID; lpstrUserTypeNew: LPCSTR): HResult; stdcall;
function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
function SetHostNames(lpstrContainerApp: LPCSTR; lpstrContainerObj: LPCSTR): HResult; stdcall;
function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
function SetDvaspect(iob: Longint; dvAspect: DWORD): HResult; stdcall;
function HandsOffStorage(iob: Longint): HResult; stdcall;
function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
function InPlaceDeactivate: HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
function GetClipboardData(var chrg: TCharRange; reco: DWORD; out dataObj: IDataObject): HResult; stdcall;
function ImportDataObject(dataObj: IDataObject; cf: TClipFormat; hMetaPict: HGLOBAL): HResult; stdcall;
end;
implementation
end.
插入到re中，sFileName是GIF图的路径，dwUser是标识别，用一随机数。
procedure InsertGif(re: TRxRichEdit; sFileName: string; dwUser: integer);
type
tagSize = TSize;
var
FRTF: IRichEditOle;
FLockBytes: ILockBytes;
FStorage: ISTORAGE;
FClientSite: IOLECLIENTSITE;
m_lpObject: IOleObject;
m_lpAnimator: TGifAnimator;
i_GifAnimator: IGifAnimator;
reobject: TReObject;
clsid: TGuid;
sizel: tagSize;
Rect: TRect;
begin
try
if CreateILockBytesOnHGlobal(0, True, FLockBytes) <> S_OK then
begin
//showmessage('Error to create Global Heap');
exit;
end;
//????????????
if StgCreateDocfileOnILockBytes(FLockBytes, STGM_SHARE_EXCLUSIVE or
STGM_Create or STGM_READWRITE, 0, FStorage) <> S_OK then
begin
//Showmessage('Error to create storage');
exit;
end;
//??RichEdit???
Sendmessage(re.handle, EM_GETOLEINTERFACE, 0, LongInt(@FRTF));
if FRTF.GetClientSite(FClientSite) <> S_OK then
begin
//ShowMessage('Error to get ClentSite');
Exit;
end;
CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
m_lpAnimator := TGifAnimator.Create(re);
i_GifAnimator := m_lpAnimator.ControlInterface;
i_GifAnimator.LoadFromFile(sFileName);
i_GifAnimator.QueryInterface(IID_IOleObject, m_lpObject);
OleSetContainedObject(m_lpObject, True);
FillChar(ReObject, SizeOf(ReObject), 0);
ReObject.cbStruct := SizeOf(ReObject);
m_lpObject.GetUserClassID(clsid);
ReObject.clsid := clsid;
reobject.cp := REO_CP_SelectION;
//content, but not static
reobject.dvaspect := DVASPECT_CONTENT;
//goes in the same line of text line
reobject.dwFlags := REO_BELOWBASELINE; //REO_RESIZABLE |
reobject.dwUser := 0;
//the very object
reobject.poleobj := m_lpObject;
//client site contain the object
reobject.polesite := FClientSite;
//the storage
reobject.pstg := FStorage;
sizel.cx := 0;
sizel.cy := 0;
reobject.sizel := sizel;
//Sel all text
re.SelText := '';
re.SelLength := 0;
re.SelStart := re.SelStart;
reobject.dwUser := dwUser;
//Insert after the line of text
FRTF.InsertObject(reobject);
SendMessage(re.Handle, EM_SCROLLCARET, 0, 0);
//VARIANT_BOOL ret;
//do frame changing
m_lpAnimator.TriggerFrameChange();
//show it
m_lpObject.DoVerb(OLEIVERB_UIACTIVATE, nil, FClientSite, 0, re.Handle, Rect);
// m_lpObject.DoVerb(
m_lpObject.DoVerb(OLEIVERB_SHOW, nil, FClientSite, 0, re.Handle, Rect);
//redraw the window to show animation
RedrawWindow(re.Handle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ERASENOW or RDW_ALLCHILDREN);
finally
FRTF := nil;
FClientSite := nil;
FStorage := nil;
end;
end;
以下是我程序中使用该函数的代码，供大家参考。
procedure TTextObject.AddGif(re: TRxRichEdit; sFile, sShortCut: string);
var
GifIDMap: TGifIDMap;
i, iGifID: integer;
sFileName: string;
begin
if Pos('\customface\', LowerCase(sFile)) <> 0 then
sFileName := ExtractFilePath(Application.ExeName) + sNumber + sFile
else
sFileName := ExtractFilePath(Application.ExeName) + sFile;
if not FileExists(sFileName) then Exit; // 文件不存在
Randomize;
iGifID := Random(2147483647);
i := 0;
while i < GifIDList.Count do
begin
if TGifIDMap(GifIDList.Items).iGifID = iGifID then
begin
iGifID := Random(2147483647);
i := 0;
Continue;
end;
Inc(i);
end;
InsertGif(re, sFileName, iGifID);// 调用
GifIDMap := TGifIDMap.Create;
GifIDMap.iGifID := iGifID;
GifIDMap.sFileName := sFile;
GifIDMap.sShortCut := sShortCut;
GifIDList.Add(GifIDMap);
end;
procedure TTextObject.ShowRichEdit(re: TRxRichEdit; sHeadStr: string);
var
i, iGifID, iCp: integer;
iShift: integer;
sFileName: string;
begin
re.Lines.BeginUpdate;
// 图行位置偏移量
iShift := Length(sHeadStr);
// 文本
re.Lines.BeginUpdate;
re.Clear;
re.Text := sHeadStr + Text;
re.Lines.EndUpdate;
// 插入Gif
for i := 0 to OleObjectList.Count - 1 do
begin
iCp := TOleObjectMap(OleObjectList.Items).iCp;
iGifID := TOleObjectMap(OleObjectList.Items).iGifID;
sFileName := GetFileName(iGifID);
if sFileName <> '' then // 文件存在时
begin
re.SelStart := iCp + iShift;
re.SelLength := 1;
re.SelText := '';
InsertGif(re, sFileName, iGifID); // 插入
end;
end;
re.Lines.EndUpdate;
end;
本文转自狗窝博客51CTO博客，原文链接http://blog.51cto.com/fxh7622/540516如需转载请自行联系原作者
fxh7622
