delphi RichEdit控件中插入GIF动画表情

delphi在RichEdit控件中插入GIF动画表情
在UDP即时通讯软件中实现类似于QQ的动画表情，在richEdit控件中插入gif动画表情。
发送的时候将表情转为命令，接收之后，再将命令转换为相应的动画表情。
需要引用一个QQ的DLL，文件在附件中。将此DLL导入到DELPHI中。

unit URichEdit;

interface
uses
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.

delphi RichEdit控件中插入GIF动画表情相关推荐

在ListCtrl控件中插入图标
在ListCttrl控件(Report风格)的使用上,有时需要向子列中插入图标,例如要制作一个下载软件,我们计划在控件的第一列用图标的形式显示下载状态:排队.下载中.出错等等,第二列计划用图标显示下载 ...
richedit php,VC中RichEdit 控件的使用
在mfc中使用工具栏里的RichEdit 控件时,应该在程序初始话时加入AfxInitRichEdit,或者 AfxInitRichEdit2 否则的话程序会起不来.也没有任何错误信息. 这俩函数 ...
【汉化】DevExpress插件中RichEdit控件的自定义汉化方法
本文实现方法参考:http://blog.csdn.net/ljsql/article/details/5487460 DevExpress插件,官方提供的汉化包中关于RichEdit控件的汉化基本没 ...
delphi 图表控件_将基本图表集成到Delphi应用程序中
delphi 图表控件 In most modern database applications some kind of graphical data representation is pref ...
Delphi WebBrowser控件的使用（大全 good）
Delphi WebBrowser控件的使用 WebBrowser控件属性: 1.Application 如果该对象有效,则返回掌管WebBrowser控件的应用程序实现的自动化对象(ID ...
教程-Delphi第三方控件安装卸载指南
1 只有一个DCU文件的组件.DCU文件是编译好的单元文件,这样的组件是作者不想把源码公布.一般来说,作者必须说明此组件适合Delphi的哪种版本,如果版本不对,在安装时就会出现错误.也正是因为没有源 ...
vc向richedit控件写RTF格式内容（表格）
RTF格式文本以前很少接触过,因工作原因,需要向richedit控件插入表格. 从度娘上搜索了一些基本内容,下了RTF规范,也没有仔细研究.对于一些简单的表格,可以采用"逆向工程" ...
MFC RichEdit控件使用方法大全
RichEdit简介 RichEdit的意思是"富文本编辑控件",在Edit的基础上添加了很多功能,如对不同字体.字号.文本颜色.背景色.插入Ole对象的支持,Windows系统的 ...
edptrayicon怎么卸载_教程-Delphi第三方控件安装卸载指南
1 只有一个DCU文件的组件.DCU文件是编译好的单元文件,这样的组件是作者不想把源码公布.一般来说,作者必须说明此组件适合Delphi的哪种版本,如果版本不对,在安装时就会出现错误.也正是因为没有源 ...

delphi RichEdit控件中插入GIF动画表情

delphi RichEdit控件中插入GIF动画表情相关推荐

最新文章

热门文章