Rotator – A class for printing rotated text to screen or the printer

' ----------------------------------------' The Rotator class module'' A class for printing rotated text to a ' Form, PictureBox or the Printer'' Author: Timm Dickel ([email protected])'' ----------------------------------------' Usage:'     Dim rotTest As New Rotator'     Set rotTest.Device = Printer'     ' set all font attributes as required, e.g.'     Printer.Font.Size = 12 '     'Label strings at a variety of angles'     For nA = 0 To 359 Step 15'        rotTest.Angle = nA'        rotTest.PrintText Space(10) & Printer.Font.Name & Str(nA)'     Next'     Printer.EndDoc'' ----------------------------------------Option Explicit'API constantsPrivate Const LF_FACESIZE = 32Private Const LOGPIXELSY = 90Private 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(LF_FACESIZE - 1) As ByteEnd TypePrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _    ByVal hObject As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As _    LongPrivate Declare Function CreateFontIndirect Lib "gdi32" Alias _    "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPrivate Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As _    Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, _    ByVal nCount As Long) As LongPrivate Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _    ByVal nIndex As Long) As Long'Module-level private variablesPrivate mobjDevice As ObjectPrivate mfSX1 As SinglePrivate mfSY1 As SinglePrivate mfXRatio As SinglePrivate mfYRatio As SinglePrivate lfFont As LOGFONTPrivate mnAngle As Integer'~~~AngleProperty Let Angle(nAngle As Integer)    mnAngle = nAngleEnd PropertyProperty Get Angle() As Integer    Angle = mnAngleEnd Property'~~~PrintTextPublic Sub PrintText(sText As String)    Dim lFont As Long    Dim lOldFont As Long    Dim lRes As Long    Dim byBuf() As Byte    Dim nI As Integer    Dim sFontName As String    Dim mobjDevicehdc As Long    Dim mobjDeviceCurrentX As Single    Dim mobjDeviceCurrentY As Single        mobjDevicehdc = mobjDevice.hdc    mobjDeviceCurrentX = mobjDevice.CurrentX    mobjDeviceCurrentY = mobjDevice.CurrentY        'Prepare font name, decoding from Unicode    sFontName = mobjDevice.Font.Name    byBuf = StrConv(sFontName & Chr$(0), vbFromUnicode)    For nI = 0 To UBound(byBuf)        lfFont.lfFaceName(nI) = byBuf(nI)    Next nI        'Convert known font size to required units    lfFont.lfHeight = mobjDevice.Font.Size * GetDeviceCaps(mobjDevicehdc, _        LOGPIXELSY)  72        'Set Italic or not    If mobjDevice.Font.Italic = True Then        lfFont.lfItalic = 1    Else        lfFont.lfItalic = 0    End If    'Set Underline or not    If mobjDevice.Font.Underline = True Then        lfFont.lfUnderline = 1    Else        lfFont.lfUnderline = 0    End If    'Set Strikethrough or not    If mobjDevice.Font.Strikethrough = True Then        lfFont.lfStrikeOut = 1    Else        lfFont.lfStrikeOut = 0    End If    'Set Bold or not (use font's weight)    lfFont.lfWeight = mobjDevice.Font.Weight    'Set font rotation angle    lfFont.lfEscapement = CLng(mnAngle * 10#)    lfFont.lfOrientation = lfFont.lfEscapement        'Build temporary new font and output the string    lFont = CreateFontIndirect(lfFont)    lOldFont = SelectObject(mobjDevicehdc, lFont)    lRes = TextOut(mobjDevicehdc, XtoP(mobjDeviceCurrentX), _        YtoP(mobjDeviceCurrentY), sText, Len(sText))    lFont = SelectObject(mobjDevicehdc, lOldFont)    DeleteObject lFontEnd Sub'~~~DeviceProperty Set Device(objDevice As Object)    Dim fSX2 As Single    Dim fSY2 As Single    Dim fPX2 As Single    Dim fPY2 As Single    Dim nScaleMode As Integer    Set mobjDevice = objDevice    With mobjDevice        'Grab current scaling parameters        nScaleMode = .ScaleMode        mfSX1 = .ScaleLeft        mfSY1 = .ScaleTop        fSX2 = mfSX1 + .ScaleWidth        fSY2 = mfSY1 + .ScaleHeight        'Temporarily set pixels mode       .ScaleMode = vbPixels    '   .ScaleMode = vbMillimeters       'Grab pixel scaling parameters        fPX2 = .ScaleWidth        fPY2 = .ScaleHeight        'Reset user's original scale        If nScaleMode = 0 Then            mobjDevice.Scale (mfSX1, mfSY1)-(fSX2, fSY2)        Else            mobjDevice.ScaleMode = nScaleMode        End If        'Calculate scaling ratios just once        mfXRatio = fPX2 / (fSX2 - mfSX1)        mfYRatio = fPY2 / (fSY2 - mfSY1)    End WithEnd Property'Scales X value to pixel locationPrivate Function XtoP(fX As Single) As Long    XtoP = (fX - mfSX1) * mfXRatioEnd Function'Scales Y value to pixel locationPrivate Function YtoP(fY As Single) As Long    YtoP = (fY - mfSY1) * mfYRatioEnd Function

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

The Latest

your company's audio

4 Areas of Your Company Where Your Audio Really Matters

Your company probably relies on audio more than you realize. Whether you’re creating a spoken text message to a colleague or giving a speech, you want your audio to shine. Otherwise, you could cause avoidable friction points and potentially hurt your brand reputation. For example, let’s say you create a

chrome os developer mode

How to Turn on Chrome OS Developer Mode

Google’s Chrome OS is a popular operating system that is widely used on Chromebooks and other devices. While it is designed to be simple and user-friendly, there are times when users may want to access additional features and functionality. One way to do this is by turning on Chrome OS

homes in the real estate industry

Exploring the Latest Tech Trends Impacting the Real Estate Industry

The real estate industry is changing thanks to the newest technological advancements. These new developments — from blockchain and AI to virtual reality and 3D printing — are poised to change how we buy and sell homes. Real estate brokers, buyers, sellers, wholesale real estate professionals, fix and flippers, and beyond may