Delphi RichEdit的實現MSN / QQ 中的動畫表情

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.