讨论:如何向richtextbox中插入flash影片

[rainstormmaster]

注意:是真正的插入对象,不是setparent之类的实现,要求不用剪贴板,不重新封装播放flash的控件,能实现多个影片同时播放

[迈克揉索芙特]

可以实现我上面说的功能，但是好像刷新有问题。
SendMessage hWnd, &HF, 0, 0 仅对动态GIF起作用，对wmp和flash无效。
估计这样刷新也不对，请楼主看看应该怎样做。

[rainstormmaster]

刷新的问题可以这样:
public void UpdateObjects()
{
int k = this.IRichEditOle.GetObjectCount();

for (int i = 0; i < k; i++)
{
REOBJECT reoObject = new REOBJECT();

this.IRichEditOle.GetObject(i, reoObject,
GETOBJECTOPTIONS.REO_GETOBJ_ALL_INTERFACES);

if (reoObject.dwUser == 1)
{
Point pt = this._richEdit.GetPositionFromCharIndex(reoObject.cp);
Rectangle rect = new Rectangle(pt, reoObject.sizel);

this._richEdit.Invalidate(rect, false); // repaint
}
}
}


或者QueryInterface flash控件的IViewObjectEx接口,然后调用IViewObjectEx接口的draw方法实现自绘

[rainstormmaster]

刷新的问题可以这样:
public void UpdateObjects()
{
int k = this.IRichEditOle.GetObjectCount();

for (int i = 0; i < k; i++)
{
REOBJECT reoObject = new REOBJECT();

this.IRichEditOle.GetObject(i, reoObject,
GETOBJECTOPTIONS.REO_GETOBJ_ALL_INTERFACES);

if (reoObject.dwUser == 1)
{
Point pt = this._richEdit.GetPositionFromCharIndex(reoObject.cp);
Rectangle rect = new Rectangle(pt, reoObject.sizel);

this._richEdit.Invalidate(rect, false); // repaint
}
}
}


或者QueryInterface flash控件的IViewObjectEx接口,然后调用IViewObjectEx接口的draw方法实现自绘

[zyl910]

我明白为什么“只有一个Flash控件在刷新”了

这与OLE的设计有关

在位激活（inplace activate）是指：
当点击嵌入的对象时，宿主程序将控制权交给嵌入对象，激活嵌入对象
而嵌入对象没有激活时，宿主程序只维持该嵌入对象的静态图像


解决方法：按楼上的方法手动刷新RichEdit中的所有OLE对象

[迈克揉索芙特]

或者QueryInterface flash控件的IViewObjectEx接口,然后调用IViewObjectEx接口的draw方法实现自绘
----------------------------------------------------------------
这个怎么用？请楼主指点一下。在vb里面。

[蒋晟]

看来有必要看看OLEObjects属性怎么实现的...

[韧恒]

//问题应该可以彻底的解决了，答案是出人意料的简单，我的问题主要在QI上，QI成功了，问题也就可以彻底的解决了，一会整理一下，把解决方案贴上来

期待中...

[迈克揉索芙特]

恭喜老大，敬候老大的力作。

[ZOU_SEAFARER]

小弟菜鸟，希望老大多点注释哦！！

[eslbs]

gz

[rainstormmaster]

首先在窗体上画一个richtextbox控件，一个flash控件（这个flash控件没有用上，它是为程序中动态添加flash控件做准备的，事实上这是一种无奈的做法，原因是Licenses.Add方法对flash的progid不感兴趣，当然,你也可以通过其它途径解决这个问题），一个timer控件，一个按钮：

Option Explicit
Private Const RDW_ERASE = &H4
Private Const RDW_FRAME = &H400
Private Const RDW_INTERNALPAINT = &H2
Private Const RDW_INVALIDATE = &H1
Private Const RDW_ERASENOW = &H200
Private Const RDW_ALLCHILDREN = &H80
Private Const WM_USER = &H400
Private Const EM_GETOLEINTERFACE = WM_USER + 60
Private Const EM_POSFROMCHAR = (WM_USER + 38)
Private Const WM_LBUTTONDBLCLK = &H203
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpszIID As Long, iid As Any) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Declare Function CoCreateGuid Lib "ole32.dll" (lpGUID As Any) As Long
Private Declare Function StringFromGUID2 Lib "ole32" (lpGUID As Any, ByVal lpStr As String, ByVal lSize As Long) As Long
Const ProgID_Flash = "ShockwaveFlash.ShockwaveFlash.1"
Dim mIRichEditOle As IRichEditOle

'实现这个函数的目的是为了产生不重复的字串，为controls.add服务
Private Function GetGuidID() As String
Dim pGuid(16) As Byte
Dim s As String
s = String(255, " ")
CoCreateGuid pGuid(0)
StringFromGUID2 pGuid(0), s, 255
s = Trim(s)
s = StrConv(s, vbFromUnicode)
s = Replace(s, "{", "")
s = Replace(s, "}", "")
s = Replace(s, "-", "")
GetGuidID = s
End Function


Private Sub Command1_Click()
RichTextBoxInsertFlash RichTextBox1.hwnd, "e:\MC\11.SWF"
End Sub


'在richtextbox的当前光标处插入flash，flash的movie为mFile
Private Sub RichTextBoxInsertFlash(ByVal mHwnd As Long, ByVal mFile As String)
Dim mILockBytes As ILockBytes
Dim mIStorage As IStorage
Dim mIOleClientSite As IOleClientSite
Dim mIOleObject As IOleObject
Dim mReObject As REOBJECT
Dim mUUID As UUID
'创建Global Heap，实例化mILockBytes
Set mILockBytes = CreateILockBytesOnHGlobal(0&, True)
If ObjPtr(mILockBytes) = 0 Then
MsgBox "Error to create Global Heap"
Exit Sub
End If
'创建storage，实例化mIStorage
Set mIStorage = StgCreateDocfileOnILockBytes(mILockBytes, STGM_SHARE_EXCLUSIVE _
Or STGM_CREATE Or STGM_READWRITE, 0)
If ObjPtr(mIStorage) = 0 Then
MsgBox "Error to create storage"
Exit Sub
End If
'向richtextbox发送EM_GETOLEINTERFACE消息获得IRichEditOle接口，实例化mIRichEditOle
SendMessage mHwnd, EM_GETOLEINTERFACE, 0, mIRichEditOle
If ObjPtr(mIRichEditOle) = 0 Then
MsgBox "Error to get IRichEditOle"
Exit Sub
End If
'调用GetClientSite函数，实例化mIOleClientSite
Set mIOleClientSite = mIRichEditOle.GetClientSite
If ObjPtr(mIOleClientSite) = 0 Then
MsgBox "Error to get ClientSite"
Exit Sub
End If
'动态添加flash控件，用于解决插入多个影片的问题
Dim mFlash As ShockwaveFlashObjectsCtl.ShockwaveFlash
Set mFlash = Controls.Add(ProgID_Flash, "mc" + GetGuidID)
mFlash.Movie = mFile
'查询IOleObject接口
Set mIOleObject = mFlash.Object
OleSetContainedObject mIOleObject, True
mIOleObject.GetUserClassID mUUID
'填充mReObject
With mReObject
.cbStruct = LenB(mReObject)
.clsid = mUUID
.cp = REO_CP_SELECTION
.DVASPECT = DVASPECT_CONTENT
.dwFlags = REO_BELOWBASELINE ' Or REO_RESIZABLE
.sizel.cx = 0
.sizel.cy = 0
.dwUser = 0
Set .poleobj = mIOleObject
Set .polesite = mIOleClientSite
Set .pStg = mIStorage
End With
'在richtextbox的当前光标处插入flash
mIRichEditOle.InsertObject mReObject
' '释放资源
ZeroMemory mReObject, LenB(mReObject)
ZeroMemory mUUID, LenB(mUUID)
Set mIOleClientSite = Nothing
Set mIStorage = Nothing
Set mILockBytes = Nothing
Set mIOleObject = Nothing
End Sub


Private Sub UpdateObjects()
Dim i As Long, RE As REOBJECT
If ObjPtr(mIRichEditOle) = 0 Then Exit Sub
i = mIRichEditOle.GetObjectCount
Dim PT As olelib.Point
Dim k As Long, mSIZE As SIZE, RT As RECT
For k = 0 To i - 1
RE.cbStruct = LenB(RE)
mIRichEditOle.GetObject k, RE, REO_GETOBJ_ALL_INTERFACES
SendMessage RichTextBox1.hwnd, EM_POSFROMCHAR, VarPtr(PT), ByVal RE.cp
mSIZE = RE.sizel
With RT
.Left = PT.x
.Top = PT.y
.Right = mSIZE.cx * 192 / 5080 + PT.x
.Bottom = PT.y + mSIZE.cy * 192 / 5080
End With
InvalidateRect Me.RichTextBox1.hwnd, RT, False
Next
End Sub


Private Sub Form_Load()
Timer1.Interval = 80 '数值越小，闪烁的越厉害
Timer1.Enabled = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim obj As Object
For Each obj In Me.Controls
If TypeName(obj) = "shockwaveflash" And Left(obj.Name, 2) = "mc" Then
Controls.Remove obj
End If
Next
Set mIRichEditOle = Nothing
RichTextBox1.TextRTF = "" '关键代码，释放richtextbox占用的资源，否则程序不能正确退出
End Sub

Private Sub Form_Resize()
RichTextBox1.Move 0, 0, Me.ScaleWidth
End Sub

Private Sub Timer1_Timer()
UpdateObjects
End Sub

[rainstormmaster]

目前存在的问题,刷新的时候闪烁的很厉害,不过我的机器现在有问题,无法使用subclassing,等我修好机器,再看看能否通过自绘解决问题

[rainstormmaster]

http://blog.csdn.net/rainstormmaster/archive/2006/02/09/595210.aspx

[蒋晟]

估计flash是故意不面向桌面程序的……插入对象需要容器和控件都支持一系列特定的接口……

[迈克揉索芙特]

好像不能对插入的组件进行交互，比如这个flash或wmp等。
楼主的刷新方法很“强迫”，肯定不是最好的方法。QQ的那个Gif组件就没有问题，仅在插入的适合对RichText刷新一下就行了。可以静态插入(引用的方式)并多个同时动态显示。
正如楼上所说：“估计flash是故意不面向桌面程序的……插入对象需要容器和控件都支持一系列特定的接口……”
如果对这些组件进行一次封装可能会好些，但是违背了楼主的初衷。

[rainstormmaster]

//好像不能对插入的组件进行交互

没错，是这样的，不过这个不难解决，事实上插入一个空对象,得到对象的rect后,再调用setparent,移动flash控件到指定区域,就什么都解决了,不过这个不是我想要的

[f56_2000]

帮忙顶一下，顺便接分

[迈克揉索芙特]

我用了更笨的办法：
自定义一个控件，在里面添加Flash控件和Timer控件。
Timer负责刷新自定义控件。
这样就不抖了

[迈克揉索芙特]

楼主，有办法在vb中制作可以插入的类吗？
怎么写这个类？

[rainstormmaster]

事实上我的方法也并不好,即使使用setparent也需要用subclassing

//楼主，有办法在vb中制作可以插入的类吗？

从理论上说只要在class中实现了ioleobject或者idataobject接口应该就可以了,不过,没写过这样的代码