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

unique · Feb 10, 2000

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. 
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 · Feb 10, 2000

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

unique · Feb 10, 2000

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 · Feb 10, 2000

Yes 
I suppose you tried this... 
 
Drag the .EXE icon to your desktop 
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. 
don't touch anything else in between. 
If you get two different results then there is something going on when it's compiled.

unique · Feb 10, 2000

Thanks for the suggestion. I had not thought of trying that. 
 
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? 
 
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 · Feb 10, 2000

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

unique · Feb 10, 2000

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

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

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

unique

Technical User

DougP

MIS

unique

Technical User

DougP

MIS

unique

Technical User

DougP

MIS

unique

Technical User

Similar threads

Part and Inventory Search

Sponsor