|
|
Title | Make "checkboxes" in a Rich Text Box |
Keywords | Rich Text, ETF, RichTextBox, checkbox, check, choice |
Categories | Controls |
|
|
When the program starts, it creates the rich text. It remembers the first and last characters in the list of choices so it can later tell if the user is clicking on a choice.
|
|
Private Strings As Collection
Private FirstCharacter As Integer
Private LastCharacter As Integer
Private Sub Form_Load()
Dim i As Integer
Dim txt As String
' Load the strings.
Set Strings = New Collection
Strings.Add "Click on the text below to select foods " & _
"that you like:" & vbCrLf & vbCrLf
Strings.Add "Ice cream" & vbCrLf
Strings.Add "Cookies" & vbCrLf
Strings.Add "Spinach" & vbCrLf
Strings.Add "Cake" & vbCrLf
Strings.Add "Hamburgers" & vbCrLf
Strings.Add "Quiche" & vbCrLf
Strings.Add "Lima Beans"
' Display the text.
For i = 1 To Strings.Count
txt = txt & Strings(i)
Next i
RichTextBox1.Text = txt
RichTextBox1.SelStart = Len(Strings(1))
RichTextBox1.SelLength = 1
For i = 2 To Strings.Count
RichTextBox1.SelIndent = 240
RichTextBox1.SelStart = RichTextBox1.SelStart + _
Len(Strings(i))
RichTextBox1.SelLength = 1
Next i
' Remember the first and last choice
' character numbers.
FirstCharacter = Len(Strings(1)) + 1
LastCharacter = Len(txt)
End Sub
|
|
When the user clicks on the control, the program uses the SendMessage API function to send the EM_CHARFROMPOS message to the RichTextBox. SendMessage returns the index of the character the user clicked. The program then toggles that position's SelBullet value.
|
|
Private Type POINTAPI
X As Long
Y As Long
End Type
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
Private Const EM_CHARFROMPOS& = &HD7
Private Sub RichTextBox1_MouseDown(Button As Integer, Shift _
As Integer, X As Single, Y As Single)
Dim pt As POINTAPI
Dim pos As Long
' Convert the position to pixels.
pt.X = ScaleX(X, ScaleMode, vbPixels)
pt.Y = ScaleY(Y, ScaleMode, vbPixels)
' Get the character number
pos = SendMessage(RichTextBox1.hWnd, EM_CHARFROMPOS, _
0&, pt)
' See if this character lies in one of the choices.
If pos >= FirstCharacter And pos <= LastCharacter Then
RichTextBox1.SelStart = pos
RichTextBox1.SelLength = 0
RichTextBox1.SelBullet = Not RichTextBox1.SelBullet
End If
End Sub
|
|
My book Ready-to-Run Visual Basic Code Library shows other tricks for working with text positioning, tab alignment, and so forth.
|
|
|
|
|
|