Different printer output from running within VB5 to running .EXE ...

unique · Mar 9, 2000

The test project listed below is from the Developer’s Workshop for VB6 book, and was intended to print text at different angles in a picture box. I adapted it to also send the output to the printer, and, although it works fine whilst running from within the VB5 environment, once I compile the project and run the .EXE file the printer fails to do as it was told. I would be pleased if anyone could try this project, (paste the listings into the appropriate Form and Class Module as described), and let me know if the same problem arises, or better still, why it won’t work for my printer. 
 
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!

Different printer output from running within VB5 to running .EXE ...

unique

Technical User

Similar threads

Part and Inventory Search

Sponsor