VB Forum / General 2 / August 2004

"Albert BOLLE" <Albert.Bolle@ulg.ac.be>'s wild thoughts were
released on Fri, 27 Aug 2004 15:01:58 +0200 bearing the
following fruit:

This is common and should be expected.

What do you mean by 'fails'

Jan Hyde (VB MVP)

You asked this exact same question in this newsgroup on 22nd July, Albert. I
asked you to post your code and when I looked at it I told you that it would
not work and I posted some sample code for you showing you how to do it. In
your code you were using the Printer.Print method to print your rotated
text. That will *not* work, Albert. I told you it wouldn't work. I also told
you why your code would not work, and I included some code of my own for
you. Basically, once you have created your rotated font you *cannot* access
any of the VB Printer object's properties or use any of its methods or the
rotated text will fail. That means that you *must* obtain the Printer.hDC
property and store it in a variable *before* you create the rotated font.
You must then use the TextOut API method to print the text to the stored
hDC. You cannot use the Printer.Print method. Are you now doing it that way?
In your reply all those weeks ago you were a little ambiguous, so just
answer me a little question now with a simple "yes" or "no" answer . . .
does the following code work for you? Paste it into a VB Form containing one
Command Button and click the button. Does it work?

Mike

Option Explicit
Private 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 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
Private 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 Long

Private Sub RotatedText(textstring As String, angle As Long)
' Prints rotated text at the current printer x and y
' coordinates at a specified angle (in tenths of a degree
' in an anti clockwise direction (zero is normal text)
Dim MyHdc As Long
Dim oldmode As Long, xpix As Long, ypix As Long
Dim log_font As LOGFONT
Dim new_font As Long, old_font As Long
With Printer
 xpix = .ScaleX(.CurrentX - .ScaleLeft, .ScaleMode, vbPixels)
 ypix = .ScaleY(.CurrentY - .ScaleTop, .ScaleMode, vbPixels)
MyHdc = .hdc
End With
With log_font
.lfEscapement = angle
.lfHeight = (Printer.Font.Size * -20) / Printer.TwipsPerPixelY
.lfFaceName = Printer.Font.Name & vbNullChar
If Printer.Font.Bold = True Then
 .lfWeight = 700
Else
 .lfWeight = 400
End If
 .lfItalic = Printer.Font.Italic
 .lfUnderline = Printer.Font.Underline
End With
new_font = CreateFontIndirect(log_font)
old_font = SelectObject(MyHdc, new_font)
TextOut MyHdc, xpix, ypix, textstring, Len(textstring)
SelectObject MyHdc, old_font
DeleteObject new_font
End Sub

Private Sub Command1_Click()
Dim angle As Long, s1 As String
Printer.ScaleMode = vbInches
Printer.Font.Name = "Times New Roman"
Printer.Font.Size = 14
' always start every print job with a simple Print statement
Printer.Print
Printer.CurrentX = 4
Printer.CurrentY = 4.5
For angle = 0 To 3150 Step 450 ' angle is in tenths of a degree
s1 = "Whisky and Coke is a wonderful drink "
s1 = s1 + "(" + Format(angle \ 10) + Chr(186) + ")"
RotatedText s1, angle
Next angle
Printer.EndDoc
End Sub