非常急的Private Sub RichTextBox1_Change()简单VB问题

来源：百度知道 编辑：UC知道 时间：2024/06/04 17:20:25
请将下面RichTextBox1中变颜色的程序换成变图像程序谢谢。

Private Sub RichTextBox1_Change()
Dim StartPosition As Integer
Dim Startcolor As Integer
Dim p1 As Integer
Dim n As Integer

With RichTextBox1
'换之前先提取当前的光标位置及颜色
StartPosition = .SelStart
Startcolor = &H0&

'然后循环找函数并换颜色
n = 1
Do
p1 = InStr(n, RichTextBox1.Text, "bq1.gif")
Select Case p1
Case 0
Exit Do
Case Is <> 0
.SelStart = p1
.SelLength = Len("bq1.gif")
.SelColor = &HFF&
'End If
n = p1 + Len("bq1.gif")
End Select
Loop

'换完后再把当前的光标位置及颜色恢复
.SelStart = StartPosition
.SelLength = 0
.SelColor = Startcolor

End With
End Sub

要实现的是在bq1.gif位置显示图像而不是变换其颜色。
非常感谢。
应该只需要改动不到五处，请高手帮忙。

Private Sub Command1_Click()

Dim StartPosition As Integer

Dim p1 As Integer

Dim pic As New StdPicture '定义图片对象
Dim o As OLEObject

Set pic = LoadPicture("f:\5.gif")
Clipboard.SetData pic

With RichTextBox1

'换之前先提取当前的光标位置
StartPosition = .SelStart

'然后循环找函数并换颜色
Do
p1 = InStrRev(RichTextBox1.Text, "bq1.gif")

Select Case p1
Case 0
Exit Do

Case Is <> 0
.SelStart = p1
.SelLength = Len("bq1.gif")
.SetFocus
SendKeys "^v", True
End Select
Loop

'换完后再把当前的光标位置及颜色恢复