怎样实现彩色文字和背景

Question

请问在VB中的文本控件怎样才能实现如下的文本效果?

Answer 1

'看不到楼主的图片也可以知道用意, 一般TextBox是无法随意将部份内容换色的.'添加 Command1  Richtextbox1 并改一下 c:\test.txt 为你的.txt文件名Dim Tlen&, i&, aa$
Private Sub Form_Activate()
   Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2
   aa = "c:\test.txt"
   RichTextBox1.LoadFile aa, 1
End SubPrivate Sub Command1_Click()
   Tlen = Len(Trim(RichTextBox1.Text))
   Randomize
   For i = 1 To Tlen
      If Mid(RichTextBox1.Text, i, 1) <> "" Then
         RichTextBox1.SelStart = i
         RichTextBox1.SelLength = 1
         RichTextBox1.SelColor = QBColor(Int((Rnd * 7) + 8))
      End If
   Next i
End Sub效果图:
http://p.blog.csdn.net/images/p_blog_csdn_net/cbm666/366646/o_Richtxt.jpg

Answer 2

http://www.mndsoft.com/blog/default.asp?page=10

Answer 3

http://www.mndsoft.com/blog/article.asp?id=883

Answer 4

对不起,原先图片没有传成功,现在重新传了,要想在文本控件中实现如下的文字效果:    但不知如何达到,是否要使用第三方控件才行?还是就用VB自带的就能实现?有请高手了.CBM666的代码实现了部分的需求,但还要同时实现彩色的背景才算成功,还要探讨一下了.

Answer 5

彩色的文字可以的，如果是在RICHTEXTBOX中要再实行背景也是彩色的，可能就困难了，不过在WORD中可以实现，说明在RICHTEXTBOX中还是有可能的

Answer 6

前景色RICHTEXTBOX已经有了，找到了一个加不同背景色的在窗体中加2个Command和1个RICHTEXTBOX1，选中RICHTEXTBOX中的文字后，按Command1看看
Private Sub Form_Load()
RTBHigh.AssignControls RichTextBox1
End Sub
Private Sub Command1_Click()
RTBHigh.APIHighlightHard vbYellow
End Sub
Private Sub Command2_Click()
RTBHigh.APIHighlightHard vbBLUE
End Sub需要一个类模块 ClsAPIHighlight和一个模块1、模块内容
Public RTBHigh As New ClsAPIHighlight2、类模块 ClsAPIHighlight内容'//////////////////////这个是类模块 ClsAPIHighlight
Private m_RTB As RichTextBox
Private Const WM_USER As Long = &H400
Private Const CFM_BACKCOLOR = &H4000000
Private Const EM_GETCHARFORMAT As Long = (WM_USER + 58)
Private Const EM_SETCHARFORMAT As Long = (WM_USER + 68)
Private Const SCF_SELECTION = &H1&
Private Const LF_FACESIZE As Integer = 32Private Type CHARFORMAT2
cbSize As Integer '2
wPad1 As Integer '4
dwMask As Long '8
dwEffects As Long '12
yHeight As Long '16
yOffset As Long '20
crTextColor As Long '24
bCharSet As Byte '25
bPitchAndFamily As Byte '26
szFaceName(0 To LF_FACESIZE - 1) As Byte ' 58
wPad2 As Integer ' 60' Additional stuff supported by RICHEDIT20
wWeight As Integer ' /* Font weight (LOGFONT value) */
sSpacing As Integer ' /* Amount to space between letters */
crBackColor As Long ' /* Background color */
lLCID As Long ' /* Locale ID */
dwReserved As Long ' /* Reserved. Must be 0 */
sStyle As Integer ' /* Style handle */
wKerning As Integer ' /* Twip size above which to kern char pair*/
bUnderlineType As Byte ' /* Underline type */
bAnimation As Byte ' /* Animated text like marching ants */
bRevAuthor As Byte ' /* Revision author index */
bReserved1 As Byte
End TypePrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Sub APIHighlight(colr As Long)
Dim Ret As Long, tmpcolr As Long
Dim cf As CHARFORMAT2With cf
.cbSize = LenB(cf) 'setup the size of the character format
.dwMask = CFM_BACKCOLOR 'what to test
If .crBackColor = 0 Then
.crBackColor = colr
Else 'NOT .CRBACKCOLOR...
.crBackColor = m_RTB.BackColor
End If
Ret = SendMessage(m_RTB.hwnd, EM_SETCHARFORMAT, SCF_SELECTION, cf)
End With 'CF
End SubPublic Sub AssignControls(R As RichTextBox)'Copyright 2002 Roger Gilchrist
'lace the Call to this in Form_Load or Sub Main
'RTBLooks.AssignControls RichTextBox1, CommonDialog1Set m_RTB = REnd SubPublic Sub APIHighlightHard(BColr As Long)
APIHighlight BColrEnd Sub

Answer 7

谢谢cbm666和6742的解答,综合一下,问题已经得到了较圆满的解决了.