如何取出IOleObject里存放的图片

Question

这是我从网上找的一段代码
//***************************************************
//名称：GetGif
//功能：分析控件内容，取得控件中的图片对象
//输入：re：RichEdit控件；
//输出：
//返回：取得的对象列表（图片索引、图片位置）
//***************************************************
function GetGif (re: TRxRichEdit): TList;
type
   tagSize = TSize;
var
   i: integer;
   FRTF: IRichEditOle;
   ReObject: TReObject;
   lstGif: TList;
   slstRow: TStringList;
begin
   lstGif := TList.Create;
   //取得RichEdit的接口
   Sendmessage(re.handle, EM_GETOLEINTERFACE, 0, LongInt(@FRTF));   for i := 0 to FRTF.GetObjectCount - 1 do
   begin
     slstRow := TStringList.Create;
     FillChar(ReObject, SizeOf(ReObject), 0);
     ReObject.cbStruct := SizeOf(ReObject);     FRTF.GetObject (Longint (i), ReObject, REO_BELOWBASELINE);
     //如何实现把图片取出来,而不仅仅是取出位置和索引,本人对接口不太熟悉,望熟悉的朋友不吝赐教
     //ReObject.pOleObj
     slstRow.Add (IntToStr (ReObject.dwUser));
     slstRow.Add (IntToStr (ReObject.cp));
     lstGif.Add (slstRow);
   end;   Result := lstGif;
end;

Answer 1

取得RichEdit控件里面已经插入的图片对象吗？这个可能要用到流，而且要分析对象的格式。因为RichEdit控件支持GIF和JPG还有BMP等。

Answer 2

现把整个单元代码贴出来,希望大家共同研究一下
{用DELPHI、RxRichEdit控件实现类似QQ的表情输入方法}
//ImageOleLib_TLB是从qq的ImageOle.dll引入的类型库unit URichEdit;interface
uses
   Windows, Messages, SysUtils, Classes, Controls, StdCtrls, ActiveX, ComCtrls,
   RxRichEd, OleServer, ImageOleLib_TLB,  Dialogs;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));
 //表情定义
  m_arrFace: array [0..95, 0..1] of string = (
    ('0.gif',  '/wx'),
    ('1.gif',  '/pz'),
    ('2.gif',  '/se'),
    ('3.gif',  '/fd'),
    ('4.gif',  '/dy'),
    ('5.gif',  '/ll'),
    ('6.gif',  '/hx'),
    ('7.gif',  '/bz'),
    ('8.gif',  '/shui'),
    ('9.gif',  '/dk'),
    ('10.gif', '/gg'),
    ('11.gif', '/fn'),
    ('12.gif', '/tp'),
    ('13.gif', '/cy'),
    ('14.gif', '/jy'),
    ('15.gif', '/ng'),
    ('16.gif', '/kuu'),
    ('17.gif', '/feid'),
    ('18.gif', '/zk'),
    ('19.gif', '/tu'),
    ('20.gif', '/tx'),
    ('21.gif', '/ka'),
    ('22.gif', '/baiy'),
    ('23.gif', '/am'),
    ('24.gif', '/jie'),
    ('25.gif', '/kun'),
    ('26.gif', '/jk'),
    ('27.gif', '/lh'),
    ('28.gif', '/hanx'),
    ('29.gif', '/db'),
    ('30.gif', '/fendou'),
    ('31.gif', '/zhm'),
    ('32.gif', '/yiw'),
    ('33.gif', '/xu'),
    ('34.gif', '/yun'),
    ('35.gif', '/zhem'),
    ('36.gif', '/shuai'),
    ('37.gif', '/kl'),
    ('38.gif', '/qiao'),
    ('39.gif', '/zj'),
    ('40.gif', '/shan'),
    ('41.gif', '/fad'),
    ('42.gif', '/aiq'),
    ('43.gif', '/tiao'),
    ('44.gif', '/ahzo'),
    ('45.gif', '/mm'),
    ('46.gif', '/zt'),
    ('47.gif', '/maom'),
    ('48.gif', '/xg'),
    ('49.gif', '/yb'),
    ('50.gif', '/qianc'),
    ('51.gif', '/dp'),
    ('52.gif', '/bei'),
    ('53.gif', '/dg'),
    ('54.gif', '/shd'),
    ('55.gif', '/zhd'),
    ('56.gif', '/dao'),
    ('57.gif', '/zq'),
    ('58.gif', '/yy'),
    ('59.gif', '/bb'),
    ('60.gif', '/kf'),
    ('61.gif', '/fan'),
    ('62.gif', '/yw'),
    ('63.gif', '/mg'),
    ('64.gif', '/dx'),
    ('65.gif', '/wen'),
    ('66.gif', '/xin'),
    ('67.gif', '/xs'),
    ('68.gif', '/hy'),
    ('69.gif', '/lw'),
    ('70.gif', '/dh'),
    ('71.gif', '/sj'),
    ('72.gif', '/yj'),
    ('73.gif', '/ds'),
    ('74.gif', '/ty'),
    ('75.gif', '/yl'),
    ('76.gif', '/qiang'),
    ('77.gif', '/ruo'),
    ('78.gif', '/ws'),
    ('79.gif', '/shl'),
    ('80.gif', '/dd'),
    ('81.gif', '/mn'),
    ('82.gif', '/hl'),
    ('83.gif', '/mamao'),
    ('84.gif', '/qz'),
    ('85.gif', '/fw'),
    ('86.gif', '/oh'),
    ('87.gif', '/bj'),
    ('88.gif', '/qsh'),
    ('89.gif', '/xig'),
    ('90.gif', '/xy'),
    ('91.gif', '/duoy'),
    ('92.gif', '/xr'),
    ('93.gif', '/xixing'),
    ('94.gif', '/nv'),
    ('95.gif', '/nan'));
    SYSSET_CHAT_FACEPATH       = 'face\';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;

Answer 3

   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;   procedure InsertGif(re: TRxRichEdit; sFileName: string; dwUser: integer);
   function GetGif (re: TRxRichEdit): TList;
   function ConvertMsgToCmd (re: TRxRichEdit): string;
   procedure ConvertMsgToFace (re: TRxRichEdit; strMsg: string);implementation//***************************************************
//名称：InsertGif
//功能：插入图片
//输入：re：RichEdit控件；sFileName：要插入的文件名；
//       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 := dwUser;//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;  

Answer 4

//***************************************************
//名称：GetGif
//功能：分析控件内容，取得控件中的图片对象
//输入：re：RichEdit控件；
//输出：
//返回：取得的对象列表（图片索引、图片位置）
//***************************************************
function GetGif (re: TRxRichEdit): TList;
type
   tagSize = TSize;
var
   i: integer;
   FRTF: IRichEditOle;
   ReObject: TReObject;
   lstGif: TList;
   slstRow: TStringList;
begin
   lstGif := TList.Create;
   //取得RichEdit的接口
   Sendmessage(re.handle, EM_GETOLEINTERFACE, 0, LongInt(@FRTF));   for i := 0 to FRTF.GetObjectCount - 1 do
   begin
     slstRow := TStringList.Create;
     FillChar(ReObject, SizeOf(ReObject), 0);
     ReObject.cbStruct := SizeOf(ReObject);     FRTF.GetObject (Longint (i), ReObject, REO_BELOWBASELINE);
     //如何实现把图片取出来
     //ReObject.pOleObj
     slstRow.Add (IntToStr (ReObject.dwUser));
     slstRow.Add (IntToStr (ReObject.cp));
     lstGif.Add (slstRow);
   end;   Result := lstGif;
end;//***************************************************
//名称：ConvertMsgToCmd
//功能：分析控件内容，将表情替换成相应的命令
//输入：re：RichEdit控件；
//输出：
//返回：转换之后的消息内容
//***************************************************
function ConvertMsgToCmd (re: TRxRichEdit): string;
var
   i: integer;
   lstGif: TList;
   strMsg: WideString;
   slstRow, slstMsg: TStringList;
begin
   //分解消息文本内容，将所有内容分隔之后放到列表中
   slstMsg := TStringList.Create;
   strMsg := re.Text;
   for i := 1 to Length (strMsg) do
   begin
     slstMsg.Add (strMsg[i]);
   end;   //取得表情，将表情替换成命令
   lstGif := GetGif (re);
   for i := lstGif.Count - 1 downto 0 do
   begin
     slstRow := TStringList (lstGif.Items[i]);     slstMsg.Insert (StrToInt (slstRow.Strings[1]), 
         m_arrFace[StrToInt (slstRow.Strings[0]), 1]);
     slstRow.Free;
   end;
   lstGif.Free;   strMsg := StringReplace (slstMsg.Text, #13#10, '', [rfReplaceAll]);
   slstMsg.Free;   Result := strMsg;
end;//***************************************************
//名称：ConvertMsgToFace
//功能：分析消息内容，将命令换成相应的表情
//输入：re：RichEdit控件；strMsg：消息内容；
//输出：
//返回：
//这个有点问题
//***************************************************
{procedure ConvertMsgToFace (re: TRxRichEdit; strMsg: string);
var
   i, nFind: integer;
   strPath: string;
   strMessage: WideString;
begin
   if StrPos (PChar (strMsg), '/') = nil then
   begin
     exit;
   end;   strMessage := strMsg;
   strPath := ExtractFilePath (ParamStr (0)) + SYSSET_CHAT_FACEPATH;
   for i := 0 to Length (m_arrFace) - 1 do
   begin
     nFind := Pos (PChar (m_arrFace[i, 1]), strMessage);
     if nFind = 0 then
       continue
     else begin
       re.SelStart := nFind - 2;
       re.SelLength := Length (m_arrFace[i, 1]);
       InsertGif (re, strPath + m_arrFace[i, 0], i);
     end;
   end;
end;
}
//*************************************************** 
//名称：ConvertMsgToFace 
//功能：分析消息内容，将命令换成相应的表情 
//输入：re：RichEdit控件；strMsg：消息内容； 
//输出： 
//返回：
//这个是修改过的
//*************************************************** 
procedure ConvertMsgToFace (re: TRxRichEdit; strMsg: string); 
var
 i, nFind: integer; 
 strPath: string; 
 strMessage: WideString; 
begin 
 if StrPos (PChar (strMsg), '/') = nil then 
 begin 
   exit; 
 end; 
 re.Lines.Append(strMsg); 
 re.Lines.Count; 
 strMessage := re.Text; 
 strMessage := StringReplace (strMessage,''#13#10'', ' ', [rfReplaceAll]); 
 strPath := ExtractFilePath (ParamStr (0)) + SYSSET_CHAT_FACEPATH; 
 for i := 0 to Length (m_arrFace) - 1 do 
 begin 
   while True do 
   begin 
     nFind := Pos (PChar (m_arrFace[i, 1]), strMessage); 
     if nFind =0 then 
       Break 
     else begin 
       re.SelStart := nFind-1; 
       re.SelLength := Length (m_arrFace[i, 1]); 
       strMessage := StringReplace (strMessage,PChar (m_arrFace[i, 1]), ' ', [rfIgnoreCase]); 
       InsertGif (re, strPath + m_arrFace[i, 0], i); 
     end; 
   end; 
 end; end; 
end. 

Answer 5

    m_lpAnimator := TGifAnimator.Create(re); 
为什么提示’找不到指定的模块‘谢谢

Answer 6

 m_lpAnimator := TGifAnimator.Create(re); 
   为什么提示'找不到指定的模块' 谢谢