HanDs
管理员

[Delphi文章] MSN 、QQ中的动画表情实现 





学习中请遵循国家相关法律法规,黑客不作恶。没有网络安全就没有国家安全

本站需要登陆后才能查看

相信用过QQ、MSN中的动画表情对我们的吸引力了吧。在前几天我的一个小应用中需要添加这样的一个功能,首先从网上下载了RXLib2.75(包括RxRichEdit),安装后测试了一下它提供的例子$(DELPHI)\RX\Demo\RICHED2\Richedit.dpr,在使用插入GIF图片时我发现了一个严重的问题:就是GIF图片是不会动的。因为原来对COM这些技术接触较少,只有上网查询资料,首先我去了大富翁www.delphibbs.com查找,不过没有查到,后来终于在网上查到了dtianx大侠的资料(见文章前面的链接),不过我发现他提供的代码是C++下的,于是把这些代码转换了一下,使其在Delphi下也能用。以下是代码


unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ActiveX, ComCtrls, RxRichEd, ImageOleLib_TLB;
//RxRichEd单元是Rxlib下的RxRichEdit,一套增强功能的RichEdit
//ImageOleLib_TLB是从qq的ImageOle.dll引入的类型库
const
  IID_IOleObject: TGUID = (
    D1: $00000112; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00,
    $46));
  EM_GETOLEINTERFACE                  = WM_USER + 60;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Editor: TRxRichEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
  FRTF: IRichEditOle;
  FLockBytes: ILockBytes;
  FStorage: ISTORAGE;
  FClientSite: IOLECLIENTSITE;
  m_lpObject: IOleObject;
  m_lpAnimator: TGifAnimator;
  i_GifAnimator: IGifAnimator;
  reobject: TReObject;
  clsid: TGuid;
  sizel: tagSize;
  dwStart, dwEnd: DWORD;
  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(Editor.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(Self);
  i_GifAnimator := m_lpAnimator.ControlInterface;
  i_GifAnimator.LoadFromFile('c:\ti.gif');
  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
  SendMessage(Editor.Handle, EM_SETSEL, 0, -1);
  SendMessage(Editor.Handle, EM_GETSEL, dwStart, dwEnd);
  SendMessage(Editor.Handle, EM_SETSEL, dwEnd + 1, dwEnd + 1);
  //Insert after the line of text
  FRTF.InsertObject(reobject);
  SendMessage(Editor.Handle, EM_SCROLLCARET, 0, 0);
  //VARIANT_BOOL ret;
  //do frame changing
   m_lpAnimator.TriggerFrameChange();
  //show it
  m_lpObject.DoVerb(OLEIVERB_UIACTIVATE, Nil, FClientSite, 0, Editor.Handle,Rect);
 // m_lpObject.DoVerb(
  m_lpObject.DoVerb(OLEIVERB_SHOW, Nil, FClientSite, 0, Editor.Handle, Rect);
  //redraw the window to show animation
  redrawwindow(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;
end.
 


源码下载:http://rarnu.ys168.com/

Delphi技术目录内->外部程序操作.rar
 
 


学习中请遵守法律法规,本网站内容均来自于互联网,本网站不负担法律责任
MSN QQ 中的动画表情实现
#1楼
发帖时间:2016-7-9   |   查看数:0   |   回复数:0
游客组
快速回复