当前位置:编程学习 > VB >>

vb richtextbox怎么显示gif啊 就是那种动态的。

追问:我试过 不行啊 ,我这一直出错 DVASPECT_CONTENT要求常数表达式
答案:vb中的richtextbox 不支持动态图片

 

当然你非要实现这个的话,也是有办法的。。。。

用OLE的形式...

 

以下就是个转载的例子。希望对你有帮助,代码调试过了,完全可行

(声明:魏滔序原创,转贴请注明出处。)
实际上还可以嵌入其他组件,比如Windows Media Player等,下面以比较成熟的QQ的ImageOle为例。

需要组件:
ImageOle.dll   在QQ的目录下找,如果非XP系统则还需要GdiPlus.dll。
OleLib.tlb下载地址: http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip

--------------------------------------------------------------------------------------------

引用两个组件后,在窗体添加一个RichTextBox1,然后新建一个模块。将下面代码放在.bas中

 

Option Explicit
Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Public Declare Function UpdateWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
Public 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 Const WM_USER = &H400
Private Const EM_GETOLEINTERFACE = (WM_USER + 60)
Private Const EM_POSFROMCHAR = (WM_USER + 38)
Public Enum reCharPos
    reSelection = -1
End Enum
Public Enum reObjectAspect
    reObjectAspectContent = DVASPECT_CONTENT
    reObjectAspectIcon = DVASPECT_ICON
End Enum
Public Function AddClass(hwnd As Long, ObjIUnknown As stdole.IUnknown, _
      Optional ByVal CharPos As Long = reSelection, _
      Optional ByVal InitialAspect As reObjectAspect = reObjectAspectContent) As IRichEditOle
   
    Dim OleObject As olelib.IOleObject
    Dim Storage As olelib.IStorage
    Dim ClientSite As olelib.IOleClientSite
    Dim tOUIIO As olelib.OLEUIINSERTOBJECT
    Dim REOBJ As olelib.REOBJECT
    Dim CLSID As olelib.UUID
    Dim hMFPict As Long

    
    Dim mILockBytes As ILockBytes
    Set mILockBytes = CreateILockBytesOnHGlobal(0&, True)
    Set Storage = StgCreateDocfileOnILockBytes(mILockBytes, STGM_SHARE_EXCLUSIVE _
                    Or STGM_CREATE Or STGM_READWRITE, 0)    
    Dim RichEditOle As IRichEditOle
    SendMessage hwnd, EM_GETOLEINTERFACE, 0&, RichEditOle

    Set ClientSite = RichEditOle.GetClientSite
    Set OleObject = ObjIUnknown
    OleObject.GetUserClassID CLSID
    On Error Resume Next
    If hMFPict = 0 Then hMFPict = OleGetIconOfClass(CLSID, vbNullString, 1)

    If Err.Number <> 0 Then InitialAspect = reObjectAspectContent
    On Error GoTo 0
    OleSetContainedObject ObjIUnknown, 1
    With REOBJ
        .cbStruct = Len(REOBJ)
        LSet .CLSID = CLSID
        .DVASPECT = DVASPECT_CONTENT
        .cp = REO_CP_SELECTION
        .dwFlags = REO_DYNAMICSIZE
        .sizel.cx = 0
        .sizel.cy = 0
        .dwUser = 0
        Set .pStg = Storage
        Set .polesite = ClientSite
        Set .poleobj = ObjIUnknown
    End With
    RichEditOle.InsertObject REOBJ
   
    ZeroMemory REOBJ, LenB(REOBJ)
    ZeroMemory CLSID, LenB(CLSID)
     
    Set AddClass = RichEditOle
    Set OleObject = Nothing
    Set ClientSite = Nothing
    Set Storage = Nothing
    SendMessage hwnd, &HF, 0, 0
End Function

 --------------------------------------------------------

在窗体下,如下方法应用

Private Sub Command1_Click()
    Dim g As New GifAnimator
    g.LoadFromFile "C:\44.gif"
    AddClass RichTextBox1.hwnd, g
End Sub

用第三方控件:gif89,vbanigif等

上一个:求一段VB6 API读写注册表的代码
下一个:VB里关于Rich textbox控件的方法

CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,