Re: Find The Text :-)
- From: "Mike Williams" <mikea@xxxxxxxxxxxxxxxxx>
- Date: Sun, 22 Jul 2007 22:13:50 +0100
"Ivar" <ivar.ekstromer000@xxxxxxxxxxxx> wrote in message news:lWKoi.1613$S91.138@xxxxxxxxxxxxxxxxxxxxxxx
I ask this question to see what (if any) ideas are given, it's
a kind of find the Rect of the text question . . . question is
how to find the left and top (in pixels) of the text that is selected in the cboFind combo box with in the serch text.
I can think of all sorts of ways of doing this kind of thing, and Larry has already given you some good pointers for one method. Here's another different method in which you let a VB Control do all the work for you. The Control need not be visible, but I have left it visible in the example so that you can see how it wraps the text in exactly the same way as your own if you pass it the appropriate messages. I actually intended to use a standard multiline TextBox, but for some reason I couldn't get the EM_POSFROMCHARACTER message to work with it (perhaps it was something to do with Vista or perhaps it was the previous contents of the top half of this bottle of Australian Shiraz or perhaps I was doing something wrong?). Anyway, it all works fine with a RichTextBox. The general idea is to send the RTB a message telling it to set its formatting rectangle to the same size as your own DrawText rectangle (so that we don't need to mess about with calculating its borders) in order to make it wrap the same text in the same way. Then you use the standard RTB Find function to find the character position of your search text and then you send the RTB a message asking it for the pixel position of the top left corner of the first character cell in the found text. The following example is basically your own posted code with the above stuff added. You'll need to add a RichTextBox to your Form. The code at the moment just draws a red dot onto your DrawText rectangle at the calculated position, but the rest (drawing a rectangle around or underlining or whatever the text) should be trivial. Note that the red dot is drawn at the top left corner of the character cell, so it looks as though it is slightly in the wrong place, but it is not. It's just that a character cell has a fair amount of "white space" above the characters and often some at the left. You can adjust for this if you would prefer the dot to be drawn elsewhere on the character. Anyway, here's the code for you to check out. Don't forget to add a RichTextBox.
Mike
Option Explicit
Private Declare Function SendMessageAny Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
wParam As Any, lParam As Any) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Const EM_POSFROMCHAR = &HD6
Private Const EM_SETRECT = &HB3
Private Declare Function DrawText Lib "user32" Alias _
"DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, _
ByVal nCount As Long, lpRect As RECT, _
ByVal wFormat As Long) As Long
Private Declare Function SetRect Lib "user32" _
(lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const DT_LEFT As Long = &H0
Private Const DT_RIGHT As Long = &H2
Private Const DT_CENTER As Long = &H1
Private Const DT_WORDBREAK As Long = &H10
Private alignFix(0 To 2) As Long
Private Sub cboAlign_Click()
If Not Me.Visible Then Exit Sub
DrawTheText
End Sub
Private Sub cboFind_Click()
If Not Me.Visible Then Exit Sub
DrawTheText
End Sub
Private Sub Command1_Click()
Print cboAlign.List(cboAlign.ListIndex)
End Sub
Private Sub Form_Load()
alignFix(1) = 2: alignFix(2) = 1
Me.ScaleMode = vbPixels
Me.AutoRedraw = True
With cboFind
..AddItem "Windows"
..AddItem "goes"
..AddItem "er fo"
..AddItem "programming"
..AddItem "ile cer"
..AddItem "For"
..Move 350, 20
..ListIndex = 0
..Visible = True
End With
With cboAlign
..AddItem "Left"
..AddItem "Center"
..AddItem "Right"
..ItemData(0) = DT_LEFT
..ItemData(1) = DT_CENTER
..ItemData(2) = DT_RIGHT
..Move 350, 50
..Visible = True
..ListIndex = 0
End With
DrawTheText
End Sub
Private Sub DrawTheText()
Dim S As String
Dim R As RECT
Me.Cls
S = "This chapter goes beyond the fundamentals of "
S = S & "Visual Basic programming and introduces a variety "
S = S & "of features that make it easier for you to create "
S = S & "powerful, flexible applications."
S = S & vbCrLf
S = S & "For example, you can load multiple projects into "
S = S & "a single session of the programming environment, "
S = S & "work with Windows registry settings, or selectively "
S = S & "compile certain parts of your program." & vbCrLf
S = S & "Set RichTextBox Visible to False after testing."
SetRect R, 20, 20, 280, 500
DrawText Me.hdc, S, Len(S), R, _
cboAlign.ItemData(cboAlign.ListIndex) + DT_WORDBREAK
Dim r1 As RECT
r1.Left = 0: r1.Right = R.Right - R.Left + 1
r1.Top = 0: r1.Bottom = R.Bottom - R.Top
RichTextBox1.Width = ScaleX(r1.Right + 50, vbPixels, ScaleMode)
RichTextBox1.Height = ScaleY(r1.Bottom + 50, vbPixels, ScaleMode)
SendMessageAny RichTextBox1.hwnd, EM_SETRECT, 0, r1
RichTextBox1.Text = S
RichTextBox1.SelStart = 0
RichTextBox1.SelLength = Len(RichTextBox1.Text)
RichTextBox1.SelAlignment = alignFix(cboAlign.ListIndex)
Dim p1 As POINTAPI, cPos As Long
cPos = RichTextBox1.Find(cboFind.List _
(cboFind.ListIndex), 0, , rtfMatchCase)
SendMessageAny RichTextBox1.hwnd, EM_POSFROMCHAR, _
p1, ByVal cPos
DrawWidth = 3
PSet (R.Left + p1.X, R.Top + p1.Y), vbRed
End Sub
.
- Follow-Ups:
- Re: Find The Text :-)
- From: Ivar
- Re: Find The Text :-)
- References:
- Find The Text :-)
- From: Ivar
- Find The Text :-)
- Prev by Date: Re: PS Re: Random Access Data File Treatment
- Next by Date: Re: DataReport in Visual Basic 6
- Previous by thread: Re: Find The Text :-)
- Next by thread: Re: Find The Text :-)
- Index(es):
Relevant Pages
|
