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

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:
Heading photo, Metadata.

What is Metadata?

What is metadata? Well, It’s an odd concept to wrap your head around. Metadata is essentially the secondary layer of data that tracks details about the “regular” data. The regular

XDR solutions

The Benefits of Using XDR Solutions

Cybercriminals constantly adapt their strategies, developing newer, more powerful, and intelligent ways to attack your network. Since security professionals must innovate as well, more conventional endpoint detection solutions have evolved

AI is revolutionizing fraud detection

How AI is Revolutionizing Fraud Detection

Artificial intelligence – commonly known as AI – means a form of technology with multiple uses. As a result, it has become extremely valuable to a number of businesses across

AI innovation

Companies Leading AI Innovation in 2023

Artificial intelligence (AI) has been transforming industries and revolutionizing business operations. AI’s potential to enhance efficiency and productivity has become crucial to many businesses. As we move into 2023, several

data fivetran pricing

Fivetran Pricing Explained

One of the biggest trends of the 21st century is the massive surge in analytics. Analytics is the process of utilizing data to drive future decision-making. With so much of

kubernetes logging

Kubernetes Logging: What You Need to Know

Kubernetes from Google is one of the most popular open-source and free container management solutions made to make managing and deploying applications easier. It has a solid architecture that makes