有人用過UltraEdit嗎?
它做到當cursor(游標)在什麼位置上
,那一行都會變成了黃色
.請問有人知道這個效果嗎?
我做了文字盒試驗
不過還是有問題
就是還是只能選有文字的部份不能選整列
而且加上顏色文字看不清楚
在一列文字按中間某些部份還會把背景變顏色
希望能幫我 解決萬分感謝
以下為我試驗的程式



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
'*******************************
' I am using the following definitions:
'*****************************
Const LF_FACESIZE = 32
Private 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 charpair*/
  bUnderlineType As Byte   ' /* Underline type          */
  bAnimation As Byte     ' /* Animated text like marching ants */
  bRevAuthor As Byte     ' /* Revision author index      */
  bReserved1 As Byte
End Type
' /* EM_SETCHARFORMAT wParam masks */
Const SCF_SELECTION = &H1&
Const SCF_ALL = &H4&
Const SCF_WORD = &H2&

Public Enum ERECSetFormatRange
ercSetFormatAll = SCF_ALL
  ercSetFormatSelection = SCF_SELECTION
  ercSetFormatWord = SCF_WORD Or SCF_SELECTION
End Enum
Const WM_USER = &H400
Const CFM_BACKCOLOR = &H4000000
Const CFE_AUTOBACKCOLOR = CFM_BACKCOLOR
Const EM_SETCHARFORMAT = (WM_USER + 68)

Public m_eCharFormatRange As ERECSetFormatRange



Public Sub SetBackColor(m_hWnd As Long, ByVal oColor As Long)
'Public Sub SetBackColor(m_hWnd As Long, ByVal oColor As OLE_COLOR)
Dim tCF2 As CHARFORMAT2
  Dim lR As Long

If oColor = -1 Then
    tCF2.dwMask = CFM_BACKCOLOR
    tCF2.dwEffects = CFE_AUTOBACKCOLOR
    tCF2.crBackColor = -1
  Else
    tCF2.dwMask = CFM_BACKCOLOR
    ''''''tCF2.crBackColor = TranslateColor(oColor)
    tCF2.crBackColor = oColor
  End If
  tCF2.cbSize = Len(tCF2)
  

  ' Form1.RichTextBox1.SelStart = 0
 'Form1.RichTextBox1.SelLength = 100

  lR = SendMessage(m_hWnd, EM_SETCHARFORMAT, SCF_SELECTION, tCF2)

End Sub





















Private Sub Form_Load()
RichTextBox1.Text = "111111111111" & vbCrLf & "222222222222" & vbCrLf _
& "33333333" & vbCrLf & "444444444" & vbCrLf & "55555555" & vbCrLf & "66666666" & vbCrLf & "777777777"
End Sub
Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
Call 改RTB背景顏色(vbWhite)
End Sub

Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
For g = RichTextBox1.SelStart To 1 Step -1
If Mid(RichTextBox1.Text, g, 2) = vbCrLf Then RichTextBox1.SelStart = g + 1: Exit For
Next g
If g = 0 Then RichTextBox1.SelStart = 0
k = InStr(RichTextBox1.SelStart + 1, RichTextBox1.Text, vbCrLf)
RichTextBox1.Span " .?!:" & vbCrLf, True, True
RichTextBox1.SelLength = RichTextBox1.SelLength + 1
Call 改RTB背景顏色(vbBlue)
End Sub
Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Call 改RTB背景顏色(vbWhite)
End Sub
Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
RichTextBox1_KeyUp 0, 0
Call 改RTB背景顏色(vbBlue)
End Sub
Sub 改RTB背景顏色(ByVal Color As Long)
SetBackColor RichTextBox1.hwnd, Color 'Color is teal
End Sub
arrow
arrow
    全站熱搜

    vbqa 發表在 痞客邦 留言(2) 人氣()