关于richtextbox插入图片的问题!救急!!!!!!!!!高分!

VirtualDesktop 2003-06-17 06:29:35
如何能象QQ一样在RICHTEXTBOX中插入图片而不会出现画图版那该死的菜单栏??????????????
...全文
83 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
rainstormmaster 2003-06-19
  • 打赏
  • 举报
回复
Private Sub Command1_Click()
Clipboard.Clear'这一句加上
Clipboard.SetData LoadPicture("d:\mc\AA.BMP")
RichTextBox1.SetFocus
SendKeys "^v"
End Sub
TechnoFantasy 2003-06-18
  • 打赏
  • 举报
回复
上面的代码使用了一个PictureBox,一个RichTextBox,一个CommandButton,在PictureBox1 中加入图片,点击Command1就可以在RichTextBox1中插入图片。
TechnoFantasy 2003-06-18
  • 打赏
  • 举报
回复
Private Function getTempName(Optional anExt As String = "tmp") As String
Dim tempPath As String
Dim fileName As String
Dim i As Long

Const validChars As String = "123567890qwertyuiopasdfghjklzxcvbnm"

' Create a buffer
tempPath = String$(255, " ")
' get the system path
GetTempPath 255, tempPath
' trim off the fat
tempPath = Left$(tempPath, InStr(tempPath, Chr$(0)) - 1)
' Create a buffer
fileName = Space(12)
' Put the non-random stuff into the string
Mid$(fileName, 1, 1) = "T"
Mid$(fileName, Len(fileName) - Len(anExt), 1) = "."
' Add in the specified extension, if provided ("tmp" is default)
Mid$(fileName, Len(fileName) - Len(anExt) + 1, Len(anExt)) = anExt
' fill the buffer with random stuff
Randomize
For i = 2 To Len(fileName) - 4
Mid$(fileName, i, 1) = Mid$(validChars, CLng(Rnd() * (Len(validChars)) + 1), 1)
Next i
tempPath = tempPath & fileName
' return the path name
getTempName = tempPath

End Function
Private Sub Command1_Click()
Dim aStr As String
aStr = StdPicAsRTF(Picture1.Picture)
RichTextBox1.SelRTF = aStr
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
RichTextBox1.Text = ""
End Sub

Private Sub Form_Resize()
Command1.Move 0, Me.ScaleHeight - Command1.Height, Me.ScaleWidth
Picture1.Move 0, 0, Me.ScaleWidth / 2, Me.ScaleHeight - Command1.Height
RichTextBox1.Move Me.ScaleWidth / 2, 0, Me.ScaleWidth / 2, Me.ScaleHeight - Command1.Height
End Sub
TechnoFantasy 2003-06-18
  • 打赏
  • 举报
回复
Option Explicit

Private Type Size
cx As Long
cy As Long
End Type

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type


' Used to create the metafile
Private Declare Function CreateMetaFile Lib "gdi32" Alias "CreateMetaFileA" (ByVal lpString As String) As Long
Private Declare Function CloseMetaFile Lib "gdi32" (ByVal hDCMF As Long) As Long
Private Declare Function DeleteMetaFile Lib "gdi32" (ByVal hMF As Long) As Long
' 6 APIs used to render/embed the bitmap in the metafile
Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
Private Declare Function SetWindowExtEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpSize As Size) As Long
Private Declare Function SetWindowOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI) As Long
Private Declare Function SaveDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function RestoreDC Lib "gdi32" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long
' These APIs are used to BitBlt the bitmap image into the metafile
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

' Used for creating the temporary WMF file
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MM_ANISOTROPIC = 8 ' Map mode anisotropic

Private Function StdPicAsRTF(aStdPic As StdPicture) As String

' ***********************************************************************
' Author: The Hand
' Date: June, 2002
' Company: EliteVB
'
' Function: StdPicAsRTF
' Arguments: aStdPic - Any standard picture object from memory, a
' picturebox, or other source.
'
' Description:
' Embeds a standard picture object in a windows metafile and returns
' rich text format code (RTF) so it can be placed in a RichTextBox.
' Useful for emoticons in chat programs, pics, etc. Currently does
' not support icon files, but that is easy enough to add in.
' ***********************************************************************
Dim hMetaDC As Long
Dim hMeta As Long
Dim hPicDC As Long
Dim hOldBmp As Long
Dim aBMP As BITMAP
Dim aSize As Size
Dim aPt As POINTAPI
Dim fileName As String
' Dim aMetaHdr As METAHEADER
Dim screenDC As Long
Dim headerStr As String
Dim retStr As String
Dim byteStr As String
Dim bytes() As Byte
Dim filenum As Integer
Dim numBytes As Long
Dim i As Long

' Create a metafile to a temporary file in the registered windows TEMP folder
fileName = getTempName("WMF")
hMetaDC = CreateMetaFile(fileName)

' Set the map mode to MM_ANISOTROPIC
SetMapMode hMetaDC, MM_ANISOTROPIC
' Set the metafile origin as 0, 0
SetWindowOrgEx hMetaDC, 0, 0, aPt
' Get the bitmap's dimensions
GetObject aStdPic.Handle, Len(aBMP), aBMP
' Set the metafile width and height
SetWindowExtEx hMetaDC, aBMP.bmWidth, aBMP.bmHeight, aSize
' save the new dimensions
SaveDC hMetaDC
' OK. Now transfer the freakin image to the metafile
screenDC = GetDC(0)
hPicDC = CreateCompatibleDC(screenDC)
ReleaseDC 0, screenDC
hOldBmp = SelectObject(hPicDC, aStdPic.Handle)
BitBlt hMetaDC, 0, 0, aBMP.bmWidth, aBMP.bmHeight, hPicDC, 0, 0, vbSrcCopy
SelectObject hPicDC, hOldBmp
DeleteDC hPicDC
DeleteObject hOldBmp
' "redraw" the metafile DC
RestoreDC hMetaDC, True
' close it and get the metafile handle
hMeta = CloseMetaFile(hMetaDC)

' GetObject hMeta, Len(aMetaHdr), aMetaHdr
' delete it from memory
DeleteMetaFile hMeta

' Do the RTF header for the object. This little bit is sometimes required on
' earlier versions of the rich text box and in certain operating systems
' (WinNT springs to mind)
headerStr = "{\rtf1\ansi"
' Picture specific tag stuff
headerStr = headerStr & _
"{\pict\picscalex100\picscaley100" & _
"\picw" & aStdPic.Width & "\pich" & aStdPic.Height & _
"\picwgoal" & aBMP.bmWidth * Screen.TwipsPerPixelX & _
"\pichgoal" & aBMP.bmHeight * Screen.TwipsPerPixelY & _
"\wmetafile8"

' Get the size of the metafile
numBytes = FileLen(fileName)
' Create our byte buffer for reading
ReDim bytes(1 To numBytes)
' get a free file number
filenum = FreeFile()
' open the file for input
Open fileName For Binary Access Read As #filenum
' read the bytes
Get #filenum, , bytes
' close the file
Close #filenum
' Generate our hex encoded byte string
byteStr = String(numBytes * 2, "0")
For i = LBound(bytes) To UBound(bytes)
If bytes(i) > &HF Then
Mid$(byteStr, 1 + (i - 1) * 2, 2) = Hex$(bytes(i))
Else
Mid$(byteStr, 2 + (i - 1) * 2, 1) = Hex$(bytes(i))
End If
Next i
' stick it all together
retStr = headerStr & " " & byteStr & "}"
' Add in the closing RTF bit
retStr = retStr & "}"

StdPicAsRTF = retStr
On Local Error Resume Next
' Kill the temporary file
If Dir(fileName) <> "" Then Kill fileName
End Function
lihonggen0 2003-06-18
  • 打赏
  • 举报
回复
不用那么复杂!

Private Sub Command1_Click()
Clipboard.SetData LoadPicture("f:\AA.BMP")
RichTextBox1.SetFocus
SendKeys "^v"

End Sub

引力场变动源 2003-06-18
  • 打赏
  • 举报
回复
最简单的,把图片拷到剪贴版,再粘贴到RICHTEXTBOX就可以了。(用VB的剪贴版操作功能最好,不要用SENDKEYS)
zhixin1007 2003-06-18
  • 打赏
  • 举报
回复
如果是IMAGE、 PICTURE,如下
Private Sub Command1_Click()
Clipboard.SetData picture.image
RichTextBox1.SetFocus
'粘贴
End Sub
VirtualDesktop 2003-06-17
  • 打赏
  • 举报
回复
谢了
那如果图片是IMAGE的PICTURE属性改怎么办?
zhixin1007 2003-06-17
  • 打赏
  • 举报
回复
可以,反正粘贴就行了
rainstormmaster 2003-06-17
  • 打赏
  • 举报
回复
用SendMessage干什么,直接bitblt传过去就是了
zhixin1007 2003-06-17
  • 打赏
  • 举报
回复
补充
粘贴的API
声明:
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

调用:
RichTextbox.SetFocus
SendMessage RichTextbox.hwnd, &H302, 0, ByVal 0&

另:上面的ClipBoard.SelData 改为 ClipBoard.SetData
zhixin1007 2003-06-17
  • 打赏
  • 举报
回复
晕!!!我提醒你一下,利用剪贴板!!!
CLIPBOARD。SELDATA LOADPICTURE(C:\AA.BMP)
然后对RICHTEXTBOX调用粘贴(API可以实现)
VirtualDesktop 2003-06-17
  • 打赏
  • 举报
回复
ADD完后就会在RICHTEXTBOX所在的窗体出现画图版的菜单
我要的是没菜单的啊
所以不能给分~
lihonggen0 2003-06-17
  • 打赏
  • 举报
回复
RichTextBox1.OLEObjects.Add , , "f:\aa.bmp"
lihonggen0 2003-06-17
  • 打赏
  • 举报
回复
richtextbox的OLE插入方式有三种:
1、拖放:该对象在richtextbox中将显示为一个文件名加图标的形式,BMP图象也不例外,只不过它的图标是一个其本身的缩略图;
2、richtextbox1.OLEOBJECTS.ADD方式:
richtextbox1.OLEOBJECTS.ADD ,,"文件名"
或richtextbox1.OLEOBJECTS.ADD ,,,"对象类型"

1,451

社区成员

发帖
与我相关
我的任务
社区描述
VB 控件
社区管理员
  • 控件
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧