The Windows message EM_FORMATRANGE make a RichTextBox format text for display on a device. This program uses the SendMessage API function to send this message to a RichTextBox, telling it to display its contents on a PictureBox.
Subroutine OverlayText does all the work. It initializes a FORMATRANGE structure that identifies the PictureBox and the area where the text should be drawn. It sets the char_before and char_after values to 0 and -1 to indicate that all of the text should be drawn.
After drawing the text, the routine calls SendMessage again with a NULL final parameter to make the RichTextBox free resources it has allocated.
|
Option Explicit
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 WM_USER = &H400
Private Const EM_FORMATRANGE = (WM_USER + 57)
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type CHARRANGE
char_before As Long
char_after As Long
End Type
Private Type FORMATRANGE
hdc As Long
target_hdc As Long
target_area As RECT
entire_area As RECT
char_range As CHARRANGE
End Type
' Overlay the text on the PictureBox inside
' the specified rectangle (in twips).
Private Sub OverlayText(ByVal pic As PictureBox, ByVal rch _
As RichTextBox, ByVal xmin As Single, ByVal xmax As _
Single, ByVal ymin As Single, ByVal ymax As Single)
Dim format_range As FORMATRANGE
' Prepare the FORMATRANGE structure.
With format_range
.hdc = pic.hdc
.target_hdc = pic.hdc
With .entire_area
.Left = 0
.Right = pic.ScaleX(pic.ScaleWidth, _
pic.ScaleMode, vbTwips)
.Top = 0
.Bottom = pic.ScaleY(pic.ScaleHeight, _
pic.ScaleMode, vbTwips)
End With
With .target_area
.Left = xmin
.Right = xmax
.Top = ymin
.Bottom = ymax
End With
With .char_range
.char_before = 0
.char_after = -1
End With
End With
' Display as much text as will fit.
' Setting wParam = True makes the RichTextBox
' display the text instead of just measuring it.
SendMessage rch.hwnd, _
EM_FORMATRANGE, True, format_range
' Clear resources allocated by the RichTextBox.
SendMessage rch.hwnd, EM_FORMATRANGE, False, ByVal 0&
End Sub
|