Как вынуть картинку из RichTextBox и вставить в Image

[$Yastrebov$]

В RichTextBox будет находится только один OLE-объект - картинка и больше ничего.

В коллекции Ole-объектов соответственно будет находится тут:
RTB1.OLEObjects(0)

Хотелось бы вставить картинку в Image:
Image1.Picture = ... или Image1.Picture = LoadPicture(...)

Как это правильно реализовать без "Type Mismatch"?
Спасибо!

[$Yastrebov$]

Шаманы и повелители VB выручайте))))

[RUSYA]

Код: Выделить всё

Private Sub Command1_Click()
'First, just add plain text:
rchText1.SelText = rchText1.SelText & "Guest: " & Text1 & vbCrLf

'Then change what needs to be changed to pictures:
RefreshPics
DoEvents
rchText1.SelStart = Len(rchText1.Text) 'Put the start at the end, thats where you want to add the next line
Text1 = ""
Call Text1.SetFocus
End Sub

Private Sub Form_Load()
rchText1.OLEObjects.Clear 'Clear the ole objects to prevent errors
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
DoEvents
rchText1.OLEObjects.Clear 'You must add this or the
                            'program will crash. This doesnt
                            'happen in Windows 2k
DoEvents
End Sub

Sub RefreshPics() 'This scans the text for and (l)'s to change
Dim lFoundPos As Long           'Position of first character
                                        'of match
Dim lFindLength As Long         'Length of string to find

Dim MakeSure As Boolean 'I have this to do the procedure twice, just to "make sure"


GoTo Skip:
Start:
MakeSure = True
Skip:

lFoundPos = rchText1.Find(":)", 0, , rtfNoHighlight)
        While lFoundPos > 0
          rchText1.SelStart = lFoundPos
          'The SelLength property is set to 0 as
          'soon as you change SelStart
          rchText1.SelLength = 2
          rchText1.SelText = ""
          rchText1.OLEObjects.Add , , App.Path & "\smile.bmp" 'Add the picture after it has deleted the string
          DoEvents
          'Attempt to find the next match
          lFoundPos = rchText1.Find(sFindString, lFoundPos + 2, , rtfNoHighlight)
Wend
If MakeSure = False Then GoTo Start

' I guess by changing or adding a few lines, you
'   can make it add more pictures with different strings.

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1_Click
End Sub

[RUSYA]

а тьфу сорр, вынуть оказывается..

ну как-то так http://support.microsoft.com/default.as ... -us;119395

Завтра ещё мож подробнее поковыряю, а то спать охото

[$Yastrebov$]

ну как-то так http://support.microsoft.com/default.aspx?scid=kb;en-us;119395

Спасибо за пример, похоже на правду...

Вот только проблема в строке:
GetMetaFile MFPict, ole1 - тут ошибка

В качестве ole1, я так понимаю, нужно передавать мой RTB1 или RTB1.OLEObjects(0) Но увы, ни то, ни другое не работает!
Помогите разобраться в страшном коде от Майкрософт