Atlanta Custom Software Development 

   Search        Code/Page

User Login



Forgot the Password?
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
» Regular Expr Tester
» Free Tools

PrintRotatedText - Display a rotated message

Total Hit ( 3984)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article



Click here to copy the following block
Const LF_FACESIZE = 32

Private Type LOGFONT
  lfHeight As Long
  lfWidth As Long
  lfEscapement As Long
  lfOrientation As Long
  lfWeight As Long
  lfItalic As Byte
  lfUnderline As Byte
  lfStrikeOut As Byte
  lfCharSet As Byte
  lfOutPrecision As Byte
  lfClipPrecision As Byte
  lfQuality As Byte
  lfPitchAndFamily As Byte
  lfFaceName As String * LF_FACESIZE
End Type

Private Declare Function SetGraphicsMode Lib "gdi32" (ByVal hdc As Long, _
  ByVal iMode As Long) As Long
Private Declare Function MulDiv Lib "Kernel32" (ByVal nNumber As Long, _
  ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
  ByVal nIndex As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias _
  "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
  ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As _
Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (dest As _
  Any, Source As Any, ByVal bytes As Long)

' Print rotated text
' The first argoment can be a form, a picture box, the Printer, and in general
' any VB object that supports the Font and the hDC properties.
' Text is the string to be printed
' Angle is the orientation, in 10th of degrees (default is 90°)
' X and Y are the printing coordinates (omit to use the current coordinates)
' Note: you get best results when using TrueType fonts

Sub PrintRotatedText(PB As Object, ByVal Text As String, _
  Optional ByVal Angle As Integer = -900, Optional x As Variant, _
  Optional y As Variant)

  Dim hfont As Long, holdfont As Long
  Dim Font As LOGFONT
  Const GM_ADVANCED = 2
  Const LOGPIXELSY = 90
  SetGraphicsMode PB.hdc, GM_ADVANCED
  ' Create a Font object, similar to the current font in PB
  ' but with a different orientation
  Font.lfHeight = -MulDiv(PB.FontSize, GetDeviceCaps(PB.hdc, LOGPIXELSY), 72)
  Font.lfWidth = 0
  Font.lfEscapement = Angle
  Font.lfOrientation = Angle
  Font.lfWeight = IIf(PB.FontBold, 700, 400)
  Font.lfItalic = IIf(PB.FontItalic, 1, 0)
  Font.lfUnderline = IIf(PB.FontUnderline, 1, 0)
  Font.lfStrikeOut = IIf(PB.FontStrikethru, 1, 0)
  Font.lfCharSet = 0
  Font.lfOutPrecision = 0
  Font.lfClipPrecision = 0
  Font.lfQuality = 2
  Font.lfPitchAndFamily = 33
  Font.lfFaceName = PB.FontName & vbNullChar
  hfont = CreateFontIndirect(Font)
  holdfont = SelectObject(PB.hdc, hfont)
  ' Account for X,Y coordinates
  If Not IsMissing(x) Then PB.CurrentX = x
  If Not IsMissing(y) Then PB.CurrentY = y
  ' do the printing
  PB.Print Text
  ' reselect the old font
  SelectObject PB.hdc, holdfont
  ' destroy the font object just created
  DeleteObject hfont
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, SQL Server and other MS technologies. He is, 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.