Once
Win95/98 and the newer Win32-designed apps hit the streets, it became apparent to many that not incorporating the newer interface features
dated an application. One of these features has been discussed in SHAddToRecentDocs: Add Entries to Recent Documents List.
Another interface-feature that marks your VB application a 'real
Windows app' is the ability to display a string with ellipses when its length exceeds the width of its target single-line textbox or
label. With nary a SendMessage in sight, this technique is nonetheless a snap using the DrawText API combined with its DT_CALCRECT
flag.
The principle is simple:
using a wrapper function, you pass the control to receive the text,
along with the string itself and a flag indicating the style of the
output. The routine calls GetWindowRect for the control passed, and
using the dimensions contained in the returned RECT structure passes
the string, RECT structure and a padded buffer to the DrawText API. The
DrawText API uses the RECT information to calculate the size of the
control into which the string is to fit, and based on its result, fills
the passed buffer string with the ellipsed string. The string style
depends on the style parameter passed (DT_PATH_ELLIPSIS adds the
ellipses at a point somewhere mid-string, while DT_END_ELLIPSIS
truncates and ellipses the text at the end).
When a string that is shorter than the calculated control size is
passed, DrawText returns the passed string unchanged, therefore the
routine can be called whenever an informational string is to be
displayed with assurance the string will be reformatted if required.
The illustration shows the source string in a textbox, and the
resulting ellipsed strings assigned to labels and a textbox. I've set
the label's backcolor to white (and removed the border) in order to
demonstrate the effect and how the string fits within the control
passed. (Clicking the form will clears the controls to try again). Also
listed are several other DrawText format messages which also may have a
role in your application.
This demo is updated from the original posted in 1998 to accommodate
controls inside frames or picture boxes, which the old routine
incorrectly handled.
|
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'Determines the width and height of
'the rectangle. If there are multiple
'lines of text, DrawText uses the width
'of the rectangle pointed to by the lpRect
'parameter and extends the base of the
'rectangle to bound the last line of text.
'If there is only one line of text, DrawText
'modifies the right side of the rectangle so
'that it bounds the last character in the line.
'In either case, DrawText returns the height
'of the formatted text but does not
'draw the text.
Private Const DT_CALCRECT = &H400
'Replaces part of the given string with
'ellipses, if necessary, so that the result
'fits in the specified rectangle. The given
'string is not modified unless the DT_MODIFYSTRING
'flag is specified. You can specify
'DT_END_ELLIPSIS to replace characters at
'the end of the string, or DT_PATH_ELLIPSIS
'to replace characters in the middle of the
'string. If the string contains backslash
'(\) characters, DT_PATH_ELLIPSIS preserves
'as much as possible of the text after the
'last backslash.
Private Const DT_PATH_ELLIPSIS = &H4000
Private Const DT_END_ELLIPSIS = &H8000&
'Modifies the given string to match the
'displayed text. This flag has no effect
'unless the DT_END_ELLIPSIS or
'DT_PATH_ELLIPSIS flag is specified.
Private Const DT_MODIFYSTRING = &H10000
'Expands tab characters. The default number of
'characters per tab is eight.
Private Const DT_EXPANDTABS = &H40
'Turns off processing of prefix characters.
'Normally, DrawText interprets the mnemonic-prefix
'character & as a directive to underscore the
'character that follows, and the mnemonic-prefix
'characters && as a directive to print a
'single &. By specifying DT_NOPREFIX, this
'processing is turned off.
Private Const DT_NOPREFIX = &H800
'Breaks words. Lines are automatically broken
'between words if a word would extend past the
'edge of the rectangle specified by the lpRect
'parameter. A carriage return-linefeed sequence
'also breaks the line.
Private Const DT_WORDBREAK = &H10
'Sets tab stops. Bits 15-8 (high-order byte
'of the low-order word) of the uFormat parameter
'specify the number of characters for each tab.
'The default number of characters per tab is eight.
Private Const DT_TABSTOP = &H80
'Truncates text that does not fit in the
'rectangle and adds ellipses.
Private Const DT_WORD_ELLIPSIS = &H40000
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" _
(ByVal hDC As Long, _
ByVal lpString As String, _
ByVal nCount As Long, _
lpRect As RECT, _
ByVal uFormat As Long) As Long
Private Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) As Long
Private Sub Form_Click()
Text2.Text = ""
Text3.Text = ""
Label1.Caption = ""
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
End Sub
Private Sub Command1_Click()
Dim sItem As String
sItem = Text1.Text
'draw the different ellipse styles
'to different controls
'controls on the form
Label1.Caption = EllipseText(Label1, sItem, DT_PATH_ELLIPSIS)
Label2.Caption = EllipseText(Label2, sItem, DT_END_ELLIPSIS)
Text2.Text = EllipseText(Text2, sItem, DT_PATH_ELLIPSIS)
'controls in a frame
Label3.Caption = EllipseText(Label3, sItem, DT_PATH_ELLIPSIS)
Label4.Caption = EllipseText(Label4, sItem, DT_END_ELLIPSIS)
Text3.Text = EllipseText(Text3, sItem, DT_PATH_ELLIPSIS)
End Sub
Private Function EllipseText(ctl As Control, _
ByVal sItem As String, _
DT_STYLE As Long) As String
Dim rc As RECT
With ctl
'store the string in the tag
'for later use
.Tag = sItem
'Obtain the rectangle in which to display
'the text by retrieving the size of the
'control rectangle.
If TypeOf ctl Is Label Then
rc.Left = 0
rc.Right = ctl.Width \ Screen.TwipsPerPixelX
Else
GetWindowRect ctl.hwnd, rc
End If
'tweak size
rc.Left = rc.Left * 0.96
rc.Right = rc.Right * 0.96
'call DrawText with the DT_MODIFYSTRING
'parameter to modify the sItem string
Call DrawText(hDC, sItem, -1, rc, _
DT_CALCRECT Or DT_MODIFYSTRING Or DT_STYLE)
'if string was modified (no longer
'matches he original string), set the
'control's tooltip property to the
'full string
If sItem <> .Tag Then .ToolTipText = .Tag
End With
'assign the text to the function return
EllipseText = sItem
End Function |