MSN / QQ 中的动画表情 在Delphi中RichEdit的实现 编译时报错 (怎样正确安装ImageOle.dll) ( 积分: 100 )

  • 主题发起人 主题发起人 tswhq
  • 开始时间 开始时间
T

tswhq

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ImageOleLib_TLB, StdCtrls, RxRichEd,ActiveX;
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.

我在安装imageole.dll时报错,没有加入ActiveX控件,但是系统还是生成了ImageOleLib_TLB,要怎样安装才能解决问题呢?
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ImageOleLib_TLB, StdCtrls, RxRichEd,ActiveX;
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.

我在安装imageole.dll时报错,没有加入ActiveX控件,但是系统还是生成了ImageOleLib_TLB,要怎样安装才能解决问题呢?
 
uses
activex;

你的哪些东西都在activex单元里面定义,引用了可以解决大部分问题
 
学识较浅,
FRTF: IRichEditOle;
这句定义的是什么啊?
 
to :chenybin
uses
activex
错是少了一点


FRTF: IRichEditOle;这是啥东东,还报错
 
兄弟,你哪里弄的代码?好像需要InsRich吧
http://www.delphibbs.com/delphibbs/dispq.asp?LID=1416157 好像说了一点你的东西
 
兄弟我在这弄的代码

http://dev.csdn.net/article/62/62911.shtm
 
你要的东西首先是,也就是你说的那个Ixxx的东西,就可以在那里找到了

http://www.2ccc.com/article.asp?articleid=710

这个装了以后
然后是ImageOle,在Delphi里面,Project--》Import Type Libaray,Add,然后找到qq的那个文件ImageOle。dll,其实就是一个TGifAnimator控件
其他的都应该明白了吧,记得结贴,谢谢
 
RX Library RxLib 控件包 D6 我早就装上了
在Delphi里面,Project--》Import Type Libaray,Add,然后找到qq的那个文件ImageOle。dll,也成功了,按他的程序一编译就报错

[Error] Unit1.pas(34): Undeclared identifier: 'IRichEditOle'
[Error] Unit1.pas(41): Undeclared identifier: 'TReObject'
[Error] Unit1.pas(43): Undeclared identifier: 'tagSize'
[Error] Unit1.pas(64): 'THEN' expected but identifier 'GetClientSite' found
[Error] Unit1.pas(76): Missing operator or semicolon
[Error] Unit1.pas(78): Missing operator or semicolon
[Error] Unit1.pas(79): Missing operator or semicolon
[Error] Unit1.pas(81): Missing operator or semicolon
[Error] Unit1.pas(83): Missing operator or semicolon
[Error] Unit1.pas(83): Undeclared identifier: 'REO_BELOWBASELINE'
[Error] Unit1.pas(84): Missing operator or semicolon
[Error] Unit1.pas(86): Missing operator or semicolon
[Error] Unit1.pas(88): Missing operator or semicolon
[Error] Unit1.pas(90): Missing operator or semicolon
[Error] Unit1.pas(91): Missing operator or semicolon
[Error] Unit1.pas(92): Missing operator or semicolon
[Error] Unit1.pas(93): Missing operator or semicolon
[Error] Unit1.pas(99): Missing operator or semicolon
[Fatal Error] Project1.dpr(5): Could not compile used unit 'Unit1.pas'
 
接受答案了.
 
新增加个单元

unit InsRich;

interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActiveX, ComCtrls;
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‘s 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;
function InsertBitmap(Editor: TRichEdit
BmpFile: string): Boolean;

implementation

function InsertBitmap(Editor: TRichEdit
BmpFile: string): Boolean;
var
FRTF: IRichEditOle;
FOle: IOleObject;
FormatEtc: tagFormatETC;
FStorage: IStorage;
FClientSite: IOleClientSite;
FLockBytes: ILockBytes;
ReObject: TReObject;
xt: TGUID;
FTemp: IUnknown;
begin
Result := false;
if not FileExists(BmpFile) then Exit;
try
SendMessage(Editor.Handle, EM_GETOLEINTERFACE, 0, Longint(@FRTF));
if not Assigned(FRTF) then Exit;
if CreateILockBytesOnHGlobal(0, true, FLockBytes) <> S_OK then Exit;
if StgCreateDocfileOnILockBytes(FLockBytes, STGM_SHARE_EXCLUSIVE or STGM_CREATE or STGM_READWRITE, 0, FStorage) <> S_OK then Exit;
FormatEtc.cfFormat := 0;
FormatEtc.ptd := nil;
FormatEtc.dwAspect := DVASPECT_CONTENT;
FormatEtc.lindex := -1;
FormatEtc.tymed := TYMED_NULL;
FRTF.GetClientSite(FClientSite);
//从文件中创建一个Ole对象
if OleCreateFromFile(GUID_NULL, PWideChar(WideString(BmpFile)), IID_IUnknown, 0, @FormatEtc, FClientSite, FStorage, FOle) <> S_OK then Exit;
FTemp := FOle;
FTemp.QueryInterface(IID_IOleObject, FOle);
OleSetContainedObject(FOle, true);
ReObject.cbStruct := SizeOf(TReObject);
FOle.GetUserClassID(xt);
ReObject.clsid := xt;
ReObject.cp := ULONG(REO_CP_SELECTION);
ReObject.dvAspect := DVASPECT_CONTENT;
ReObject.dwFlags := ULONG(REO_STATIC) or ULONG(REO_BELOWBASELINE);
ReObject.dwUser := 0;
ReObject.pOleObj := FOle;
ReObject.pOleSite := FClientSite;
ReObject.pstg := FStorage;
ReObject.sizel.cx := 0;
ReObject.sizel.cy := 0;
FRTF.InsertObject(ReObject);
finally
FRTF := nil;
FOle := nil;
end;
Result := true;
end;
end.


另外在

procedure TForm1.Button1Click(Sender: TObject);
type
tagSize = TSize;
var
添加一个tagSize类型
 
后退
顶部