GFRotatedText/GFRotatedText.frm

VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3 'Windows‑Standard
   Begin VB.CommandButton Command1
      Caption         =   "Command1"
      Height          =   315
      Left            =   2700
      TabIndex        =   1
      Top             =   2820
      Width           =   1875
   End
   Begin VB.PictureBox Picture1
      Height          =   2595
      Left            =   120
      ScaleHeight     =   2535
      ScaleWidth      =   4395
      TabIndex        =   0
      Top             =   120
      Width           =   4455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2000, 2001 by Louis. Use to print rotated text (font name and size fixed) into a picture box.
'
'NOTE (stolen annotation):
'>>>
'Windows expects the LOGFONTVar size to be in pixels and to be negative if you
'are specifying the character height you want.
'<<< (oh what)
'
'GFRotated Text
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 Long
'GFRotatedText
Private Const LF_FACESIZE = 32
'GFRotatedText
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 Sub Command1_Click()
    'on error resume next
    Picture1.PSet (50 * Screen.TwipsPerPixelX, 150 * Screen.TwipsPerPixelY), 0
    Call GFRotatedText_Print(Picture1, "Hello brothers", 90, 50, 150)
End Sub

Private Sub GFRotatedText_Print(ByRef PrintPictureBox As PictureBox, ByVal PrintText As String, ByVal PrintTextRotationAngle As Integer, ByVal PrintXPos As Long, ByVal PrintYPos As Long)
    'on error resume next 'prints rotated text with fixed font name and size into a picture box
    Const FONTSIZE = 10 'desired point size of LOGFONTVar
    Dim LOGFONTVar As LOGFONT
    Dim FontHandle As Long
    Dim FontHandleUnchanged As Long
    Dim PrintPictureBoxScaleModeUnchanged As Integer
    Dim Temp As Long
    'verify
    If Len(PrintText) = 0 Then Exit Sub 'nothing to print
    'preset
    PrintPictureBoxScaleModeUnchanged = PrintPictureBox.ScaleMode
    PrintPictureBox.ScaleMode = vbPixels 'important
    'begin
    LOGFONTVar.lfEscapement = PrintTextRotationAngle * 10 '0.1 degree rotation
    LOGFONTVar.lfOrientation = LOGFONTVar.lfEscapement
    LOGFONTVar.lfFaceName = "ARIAL" + Chr$(0) 'string has constant length
    LOGFONTVar.lfHeight = (FONTSIZE * ‑20) / Screen.TwipsPerPixelY
    FontHandle = CreateFontIndirect(LOGFONTVar)
    FontHandleUnchanged = SelectObject(PrintPictureBox.hdc, FontHandle)
    PrintPictureBox.CurrentX = PrintXPos
    PrintPictureBox.CurrentY = PrintYPos
    PrintPictureBox.Print PrintText
    Temp = SelectObject(PrintPictureBox.hdc, FontHandleUnchanged) 'reset
    Temp = DeleteObject(FontHandle) 'reset
    'restore scale mode
    PrintPictureBox.ScaleMode = PrintPictureBoxScaleModeUnchanged
End Sub


[END OF FILE]