Insert GIF animated expressions in the Delphi RichEdit control

Delphi inserts GIF animated expressions into the RichEdit control
In the UDP instant messaging software, a GIF animated expression is inserted into the RichEdit control.
Convert the facial expression into a command when sending it. After receiving the command, convert it into an animated facial expression.
You need to reference a qq dll file in the attachment. Import the DLL to 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 login 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

//************************************** *************
// Name: insertgif
// Function: insert an image
// Input: Re: RichEdit control; sfilename: file name to be inserted;
// Dwuser: (ID, random number, which must be replaced by the "Index" of the file name)
// Output:
// Return:
//************************************** *************
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 store ');
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;

//************************************** *************
// Name: getgif
// Function: analyze the control content and obtain the image objects in the control.
// Enter the re: RichEdit control;
// Output:
// Return: List of retrieved objects (image index and Image Location)
//************************************** *************
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;

//************************************** *************
// Name: convertmsgtocmd
// Function: analyze the control content and replace the expression with the corresponding command
// Enter the re: RichEdit control;
// Output:
// Return: converted message content
//************************************** *************
Function convertmsgtocmd (Re: trxrichedit): string;
VaR
I: integer;
Lstgif: tlist;
Strmsg: widestring;
Slstrow, slstmsg: tstringlist;
Begin
// Parse the message text and separate all the content and put it in the list.
Slstmsg: = tstringlist. Create;
Strmsg: = Re. text;
For I: = 1 to length (strmsg) Do
Begin
Slstmsg. Add (strmsg [I]);
End;

// Get the expression and replace it with a command
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;

//************************************** *************
// Name: convertmsgtoface
// Function: analyze the message content and replace the command with the corresponding expression
// Input: Re: RichEdit control; strmsg: Message content;
// Output:
// Return:
//************************************** *************
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.