在UDP即时通讯软件中实现类似于QQ的动画表情，在richEdit控件中插入gif动画表情。发送的时候将表情转为命令，接收之后，再将命令转换为相应的动画表情。需要引用一个QQ的DLL，文件在附件中。将此DLL导入到DELPHI中。
源码及DLL 附件下载地址：http://www.j2soft.cnunit URichEdit;interfaceuses Windows, Messages, SysUtils, Classes, Controls, StdCtrls, ActiveX, ComCtrls, RxRichEd, OleServer, ImageOleLib_TLB, coconst, UConst, 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));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; 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 := 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;//***************************************************//名称：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; 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); 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;end.
