This sample code will show you how to use DrawText and DrawTextEx along with some Rectangle menupulation APIs like SetRect, SetRectEmpty, OffsetRect and CopyRect. DrawText is very useful api when you want to draw text within a rectangle boundary and you want to specify various option (i.e alignment, word wrap ... etc.)
You can pass various option flag to DrawText api for different text effects. I have tried to show couple of effect in this example you can test other option by your self and I am sure it will be lot of fun.
Step-By-Step Example
- Create a standard exe project - Add the folloiwing code to form1 |
Click here to copy the following block | Option Explicit
Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
Private Type DRAWTEXTPARAMS cbSize As Long iTabLength As Long iLeftMargin As Long iRightMargin As Long uiLengthDrawn As Long End Type
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 DrawTextEx Lib "user32.dll" Alias "DrawTextExA" ( _ ByVal hDC As Long, _ ByVal lpsz As String, _ ByVal n As Long, _ ByRef lpRect As RECT, _ ByVal un As Long, _ ByRef lpDrawTextParams As Any) 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 Declare Function SetRectEmpty Lib "user32" ( _ lpRect As RECT) As Long
Private Declare Function OffsetRect Lib "user32" ( _ lpRect As RECT, _ ByVal x As Long, _ ByVal y As Long) As Long
Private Declare Function CopyRect Lib "user32" ( _ lpDestRect As RECT, _ lpSourceRect As RECT) As Long
Private Const DT_TOP = &H0 Private Const DT_LEFT = &H0 Private Const DT_CENTER = &H1 Private Const DT_RIGHT = &H2 Private Const DT_VCENTER = &H4 Private Const DT_BOTTOM = &H8 Private Const DT_WORDBREAK = &H10 Private Const DT_SINGLELINE = &H20 Private Const DT_EXPANDTABS = &H40 Private Const DT_TABSTOP = &H80 Private Const DT_NOCLIP = &H100 Private Const DT_EXTERNALLEADING = &H200 Private Const DT_CALCRECT = &H400 Private Const DT_NOPREFIX = &H800 Private Const DT_INTERNAL = &H1000 Private Const DT_EDITCONTROL = &H2000 Private Const DT_PATH_ELLIPSIS = &H4000 Private Const DT_END_ELLIPSIS = &H8000 Private Const DT_MODIFYSTRING = &H10000 Private Const DT_RTLREADING = &H20000 Private Const DT_WORD_ELLIPSIS = &H40000
Private Sub Form_Load() AutoRedraw = True
Dim Flags As Long Dim s As String Dim r As RECT, CalcR As RECT Dim RightEdge As Long
Me.ScaleMode = 3 RightEdge = Me.ScaleLeft + Me.ScaleWidth - 1
SetFont "Courier New", 10 s = "Calc rect of text demo" SetRectEmpty CalcR Flags = DT_CALCRECT DrawText hDC, s, Len(s), CalcR, Flags
CopyRect r, CalcR
OffsetRect r, 0, 50
Debug.Print r.Left, r.Right, r.Top, r.Bottom
Flags = DT_RIGHT DrawText hDC, s, Len(s), r, Flags Me.Line (r.Left, r.Top)-(r.Right, r.Bottom), , B
OffsetRect r, RightEdge - (r.Right - r.Left), 0 Flags = DT_LEFT DrawText hDC, s, Len(s), r, Flags Me.Line (r.Left, r.Top)-(r.Right, r.Bottom), , B OffsetRect r, 0, r.Bottom - r.Top + 2 SetFont "Courier New", 8, True Dim DTP As DRAWTEXTPARAMS
DTP.cbSize = Len(DTP) DTP.iLeftMargin = 10 DTP.iRightMargin = 10 DTP.iTabLength = 8
s = "This is DrawTextEx demo with 10 pix left/right margin" SetRectEmpty CalcR DrawTextEx hDC, s, Len(s), CalcR, DT_CALCRECT, DTP
SetRect r, CalcR.Left, r.Top, CalcR.Right, r.Bottom
Flags = DT_LEFT
DrawTextEx hDC, s, Len(s), r, Flags, DTP Me.Line (r.Left, r.Top)-(r.Right, r.Bottom), , B SetFont "Courier New", 12, False s = "Word wrap effect" Flags = DT_WORDBREAK SetRect r, 15, r.Bottom + 5, Me.ScaleWidth - 65 - 300, r.Bottom + 40 DrawText hDC, s, Len(s), r, Flags Me.Line (r.Left, r.Top)-(r.Right, r.Bottom), , B OffsetRect r, r.Right - r.Left + 10, 0 r.Right = r.Right + 50 s = "Verticle aligned" Flags = DT_SINGLELINE Or DT_VCENTER Or DT_CENTER DrawText hDC, s, Len(s), r, Flags Me.Line (r.Left, r.Top)-(r.Right, r.Bottom), , B Flags = DT_SINGLELINE Or DT_VCENTER Or DT_CENTER Or DT_WORD_ELLIPSIS OffsetRect r, r.Right - r.Left + 10, 0 r.Right = r.Right - 50 DrawText hDC, s, Len(s), r, Flags Me.Line (r.Left, r.Top)-(r.Right, r.Bottom), , B SetFont "Tahoma", 14
RightEdge = ScaleX(ScaleWidth, ScaleMode, vbPixels) - 1
SetRectEmpty CalcR Flags = DT_CALCRECT DrawText hDC, s, Len(s), CalcR, Flags
SetRect r, 0, r.Bottom + 2, RightEdge, CalcR.Bottom + r.Bottom + 2
Flags = DT_CENTER s = "Center aligned text" DrawText hDC, s, Len(s), r, Flags Me.Line (r.Left, r.Top)-(r.Right, r.Bottom), , B OffsetRect r, 0, CalcR.Bottom + 2 Flags = DT_LEFT s = "Left aligned text" DrawText hDC, s, Len(s), r, Flags Me.Line (r.Left, r.Top)-(r.Right, r.Bottom), , B OffsetRect r, 0, CalcR.Bottom + 2 Flags = DT_RIGHT s = "Right aligned text" DrawText hDC, s, Len(s), r, Flags Me.Line (r.Left, r.Top)-(r.Right, r.Bottom), , B End Sub
Sub SetFont(newFontname As String, newFontSize As Single, Optional IsBold As Boolean = False) Dim fnt As StdFont
Set fnt = New StdFont fnt.Name = newFontname fnt.Size = newFontSize fnt.Bold = IsBold Set Font = fnt End Sub |
|