Printing Text At Different Angles Works Ok... Well Nearly!

[unique]

I have been using the technique described in the reference book Microsoft Visual Basic 6 Developer's Workshop Ver 5 on page 311 for printing text at any angle. I have adapted it to also print to the printer object, and it works fine from within the Visual Basic (5) environment. But whenever I use the Setup Wizard to make a standalone application, when I run it, although it still prints to a picture box correctly, it prints everything in the normal (horizontal) manner to the printer.<br>
I am at a loss as to why it still works for the Picture Box and yet not for the Printer, and would appreciate anybody's help very much.

 

[DougP]

I guess you are printing to the same printer, same driver etc. from your compiled .EXE as from the environment.<br>
<br>

 

[unique]

I am printing to the same printer on both occasions - I have been testing my .EXE by installing and running it on my own system. I have also tried installing the .EXE and running it on a PC networked to my system, sharing the same printer - (an NEC Superscript 660 GDI printer). I have not changed the default printer driver (NEC Superscript GDI) at any stage. Would it be right to assume that both the environment and the .EXE would print to the Default driver unless otherwise directed?

 

[DougP]

Yes <br>
I suppose you tried this...<br>
<br>
Drag the .EXE icon to your desktop<br>
run the program from the environment(it should work just fine) then stop the program running in the environment then minimize the environment and run the .EXE on your desktop.<br>
don't touch anything else in between.<br>
If you get two different results then there is something going on when it's compiled.<br>

 

[unique]

Thanks for the suggestion. I had not thought of trying that.<br>
<br>
I have tried it now though and still get two different results. I have the .EXE application installed in a different folder to my Visual Basic 5 folder. That would not effect this experiment would it?<br>
<br>
Incidentally, I have tried a similar technique taken from the Visual Basic Programmers Journal, and have found similar problems there too. Both techniques use a Class Module encapsulating (the book's word not mine!) some API functions, a LOGFONT and some required constants. I could paste it in if it would help.

 

[DougP]

No different folders would not matter.<br>
OK paste the code if it's no to long.<br>
If I don't know someone might.<br>

 

[unique]

DougP,<br>
<br>
Here is the code for the project.<br>
The form FrmRotate contains a Picture Box called PicTest.<br>
Clicking PicTest will result in some text being printed at various angles on both the Picture Box and the Printer.<br>
<br>
Cheers,<br>
Ian. <br>
<br>
~~~~~~~~Class Module : Rotator~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
<br>
'ROTATOR.CLS<br>
Option Explicit<br>
<br>
'API constants<br>
Private Const LF_FACESIZE = 32<br>
Private Const LOGPIXELSY = 90<br>
<br>
Private Type LOGFONT<br>
lfHeight As Long<br>
lfWidth As Long<br>
lfEscapement As Long<br>
lfOrientation As Long<br>
lfWeight As Long<br>
lfItalic As Byte<br>
lfUnderline As Byte<br>
lsngStrikeOut As Byte<br>
lfCharSet As Byte<br>
lfOutPrecision As Byte<br>
lfClipPrecision As Byte<br>
lfQuality As Byte<br>
lsngPitchAndFamily As Byte<br>
lfFaceName(LF_FACESIZE - 1) As Byte<br>
End Type<br>
<br>
Private Declare Function SelectObject _<br>
Lib &quot;gdi32&quot; ( _<br>
ByVal hdc As Long, _<br>
ByVal hObject As Long _<br>
) As Long<br>
<br>
Private Declare Function DeleteObject _<br>
Lib &quot;gdi32&quot; ( _<br>
ByVal hObject As Long _<br>
) As Long<br>
<br>
Private Declare Function CreateFontIndirect _<br>
Lib &quot;gdi32&quot; Alias &quot;CreateFontIndirectA&quot; ( _<br>
lpLogFont As LOGFONT _<br>
) As Long<br>
<br>
Private Declare Function TextOut _<br>
Lib &quot;gdi32&quot; Alias &quot;TextOutA&quot; ( _<br>
ByVal hdc As Long, _<br>
ByVal x As Long, _<br>
ByVal y As Long, _<br>
ByVal lpString As String, _<br>
ByVal nCount As Long _<br>
) As Long<br>
<br>
Private Declare Function GetDeviceCaps _<br>
Lib &quot;gdi32&quot; ( _<br>
ByVal hdc As Long, _<br>
ByVal intIndex As Long _<br>
) As Long<br>
<br>
'Module-level private variables<br>
Private mobjDevice As Object<br>
Private msngSX1 As Single<br>
Private msngSY1 As Single<br>
Private msngXRatio As Single<br>
Private msngYRatio As Single<br>
Private mlfFont As LOGFONT<br>
Private mintAngle As Integer<br>
<br>
'~~~Angle<br>
Property Let Angle(intAngle As Integer)<br>
mintAngle = intAngle<br>
End Property<br>
Property Get Angle() As Integer<br>
Angle = mintAngle<br>
End Property<br>
<br>
'~~~Label<br>
Public Sub Label(sText As String)<br>
Dim lngFont As Long<br>
Dim lngOldFont As Long<br>
Dim lngRes As Long<br>
Dim bytBuf() As Byte<br>
Dim intI As Integer<br>
Dim strFontName As String<br>
'Prepare font name, decoding from Unicode<br>
strFontName = mobjDevice.Font.Name<br>
bytBuf = StrConv(strFontName & Chr$(0), vbFromUnicode)<br>
For intI = 0 To UBound(bytBuf)<br>
mlfFont.lfFaceName(intI) = bytBuf(intI)<br>
Next intI<br>
'Convert known font size to required units<br>
mlfFont.lfHeight = mobjDevice.Font.Size * _<br>
GetDeviceCaps(mobjDevice.hdc, LOGPIXELSY) \ 72<br>
'Set Italic or not<br>
If mobjDevice.Font.Italic = True Then<br>
mlfFont.lfItalic = 1<br>
Else<br>
mlfFont.lfItalic = 0<br>
End If<br>
'Set Underline or not<br>
If mobjDevice.Font.Underline = True Then<br>
mlfFont.lfUnderline = 1<br>
Else<br>
mlfFont.lfUnderline = 0<br>
End If<br>
'Set Strikethrough or not<br>
If mobjDevice.Font.Strikethrough = True Then<br>
mlfFont.lsngStrikeOut = 1<br>
Else<br>
mlfFont.lsngStrikeOut = 0<br>
End If<br>
'Set Bold or not (use font's weight)<br>
mlfFont.lfWeight = mobjDevice.Font.Weight<br>
'Set font rotation angle<br>
mlfFont.lfEscapement = CLng(mintAngle * 10#)<br>
mlfFont.lfOrientation = mlfFont.lfEscapement<br>
'Build temporary new font and output the string<br>
lngFont = CreateFontIndirect(mlfFont)<br>
lngOldFont = SelectObject(mobjDevice.hdc, lngFont)<br>
lngRes = TextOut(mobjDevice.hdc, XtoP(mobjDevice.CurrentX), _<br>
YtoP(mobjDevice.CurrentY), sText, Len(sText))<br>
lngFont = SelectObject(mobjDevice.hdc, lngOldFont)<br>
DeleteObject lngFont<br>
End Sub<br>
<br>
'~~~Device<br>
Property Set Device(objDevice As Object)<br>
Dim sngSX2 As Single<br>
Dim sngSY2 As Single<br>
Dim sngPX2 As Single<br>
Dim sngPY2 As Single<br>
Dim intScaleMode As Integer<br>
Set mobjDevice = objDevice<br>
With mobjDevice<br>
'Grab current scaling parameters<br>
intScaleMode = .ScaleMode<br>
msngSX1 = .ScaleLeft<br>
msngSY1 = .ScaleTop<br>
sngSX2 = msngSX1 + .ScaleWidth<br>
sngSY2 = msngSY1 + .ScaleHeight<br>
'Temporarily set pixels mode<br>
.ScaleMode = vbPixels<br>
'Grab pixel scaling parameters<br>
sngPX2 = .ScaleWidth<br>
sngPY2 = .ScaleHeight<br>
'Reset user's original scale<br>
If intScaleMode = 0 Then<br>
mobjDevice.Scale (msngSX1, msngSY1)-(sngSX2, sngSY2)<br>
Else<br>
mobjDevice.ScaleMode = intScaleMode<br>
End If<br>
'Calculate scaling ratios just once<br>
msngXRatio = sngPX2 / (sngSX2 - msngSX1)<br>
msngYRatio = sngPY2 / (sngSY2 - msngSY1)<br>
End With<br>
End Property<br>
<br>
'Scales X value to pixel location<br>
Private Function XtoP(sngX As Single) As Long<br>
XtoP = (sngX - msngSX1) * msngXRatio<br>
End Function<br>
<br>
'Scales Y value to pixel location<br>
Private Function YtoP(sngY As Single) As Long<br>
YtoP = (sngY - msngSY1) * msngYRatio<br>
End Function<br>
<br>
~~~~~End Of Class Module ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
<br>
<br>
~~~~~FrmRotate Code follows~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>
<br>
Option Explicit<br>
<br>
Dim rotTest As New Rotator<br>
<br>
Private Sub picTest_Click()<br>
Dim intA As Integer<br>
'Prepare the font in the picture box<br>
PicTest.Scale (-1, -1)-(1, 1)<br>
With PicTest<br>
.CurrentX = 0<br>
.CurrentY = 0<br>
With .Font<br>
.Name = &quot;Courier New&quot;<br>
.Size = 10<br>
'.Bold = True<br>
'.Italic = True<br>
'.Strikethrough = True<br>
'.Underline = True<br>
'.Weight = 1000<br>
End With<br>
End With<br>
'Connect Rotator object to the picture box<br>
Set rotTest.Device = PicTest<br>
'Label strings at a variety of angles<br>
For intA = 10 To 359 Step 15<br>
rotTest.Angle = intA<br>
rotTest.Label Space(4) & PicTest.Font.Name & Str(intA)<br>
Next intA<br>
Printer.Scale (-1, -1)-(1, 1)<br>
With Printer<br>
.CurrentX = 0<br>
.CurrentY = 0<br>
With .Font<br>
.Name = &quot;Courier New&quot;<br>
.Size = 10<br>
'.Bold = True<br>
'.Italic = True<br>
'.Strikethrough = True<br>
'.Underline = True<br>
'.Weight = 1000<br>
End With<br>
End With<br>
'Connect Rotator object to the picture box<br>
Set rotTest.Device = Printer<br>
'Label strings at a variety of angles<br>
For intA = 10 To 359 Step 15<br>
rotTest.Angle = intA<br>
rotTest.Label Space(4) & Printer.Font.Name & Str(intA)<br>
Next intA<br>
Printer.EndDoc<br>
End Sub<br>
<br>
~~~~~End Of FrmRotate~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~<br>