Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools


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  '//lpDrawTextParams=DRAWTEXTPARAMS

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  '/Pix
  RightEdge = Me.ScaleLeft + Me.ScaleWidth - 1

  '////////////////////////////////////////////////////////////////////////
  SetFont "Courier New", 10
  'this will allow us to determine the size of the string
  s = "Calc rect of text demo"
  SetRectEmpty CalcR
  Flags = DT_CALCRECT
  DrawText hDC, s, Len(s), CalcR, Flags

  'retain the original rect for size information purposes
  CopyRect r, CalcR

  OffsetRect r, 0, 50

  'this is proof that we have determined the size
  Debug.Print r.Left, r.Right, r.Top, r.Bottom

  'we will draw it at the top left of the screen
  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
  'we will draw it at the top left of the screen
  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
  '//DrawText hDC, s, Len(s), r, Flags
  Dim DTP As DRAWTEXTPARAMS

  DTP.cbSize = Len(DTP)  '//structure size
  DTP.iLeftMargin = 10  '//10 pix left margin
  DTP.iRightMargin = 10  '//10 pix right margin
  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
  
  'This will draw the same string directly below the last one...
  s = "Word wrap effect"
  Flags = DT_WORDBREAK  '//Word wrap effect
  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
  '////////////////////////////////////////////////////////////////////////
  'mess with the forms font a bit more again...
  SetFont "Tahoma", 14

  'calculate full width of the screen
  RightEdge = ScaleX(ScaleWidth, ScaleMode, vbPixels) - 1

  'this will allow us to determine the size of the NEW string
  SetRectEmpty CalcR
  Flags = DT_CALCRECT
  DrawText hDC, s, Len(s), CalcR, Flags

  'manipulate the current R rect...
  'r still holds the bounds of the last printed test
  SetRect r, 0, r.Bottom + 2, RightEdge, CalcR.Bottom + r.Bottom + 2

  'draw the new string
  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
  'draw the new string
  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
  'draw the new string
  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


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.