asked on

Printing with different fonts through API

I need to use the API rather than the printer object because the printer I will be printing to may not exist on the local machine (though "Add Printers"), but will be accessable through the network.

I need to print a line on one font, then print a line in another font.

Someting like this:

This is Arial, 18 pt, Bold

This is New Times Roman, 12 pt, regular

What I have so far:

Dim lhPrinter As Long
Dim lReturn As Long
Dim lpcWritten As Long
Dim lDoc As Long
Dim i
Dim myPrinter As String
Dim MyDocInfo As DOCINFO
Dim sText As String

myPrinter = "\\mynetwork\printer1"
lReturn = OpenPrinter(myPrinter, lhPrinter, 0)
If lReturn = 0 Then
MsgBox "The Printer doesn't exist."
Exit Sub
End If

MyDocInfo.pDocName = "Clif's Print Test"
MyDocInfo.pOutputFile = vbNullString
MyDocInfo.pDatatype = vbNullString
lDoc = StartDocPrinter(lhPrinter, 1, MyDocInfo)

Call StartPagePrinter(lhPrinter)

sText = "This is Arial, 18 pt, Bold" & vbCrLf
'Need to change font to Arial, 18 pt, Bold
lReturn = WritePrinter(lhPrinter, ByVal sText, Len(sText), lpcWritten)
sText = "This is New Times Roman, 12 pt, regular" & vbCrLf
'Need to change font to New Times Roman, 12 pt, regular
lReturn = WritePrinter(lhPrinter, ByVal sText, Len(sText), lpcWritten)

lReturn = EndPagePrinter(lhPrinter)
lReturn = EndDocPrinter(lhPrinter)
lReturn = ClosePrinter(lhPrinter)

ASKER CERTIFIED SOLUTION

mladenovicz

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Clif

ASKER

mladenovicz,

The code you provided the link to does work, however using the code for a basis in changing fonts doesn't seem to work (or I just don't know what I'm doing)

I have tried the following (modifying the code from the link you provided):

lf.lfHeight = 18 * GetDeviceCaps(hPrintDc, LOGPIXELSY) \ 72
lf.lfWidth = 0
lf.lfEscapement = 0
lf.lfOrientation = 0
lf.lfWeight = 900
lf.lfItalic = False
lf.lfUnderline = False
lf.lfStrikeOut = False
lf.lfCharSet = DEFAULT_CHARSET
lf.lfOutPrecision = OUT_DEFAULT_PRECIS
lf.lfClipPrecision = CLIP_DEFAULT_PRECIS
lf.lfQuality = DEFAULT_QUALITY
lf.lfPitchAndFamily = DEFAULT_PITCH
lf.lfFaceName = StrConv("Arial" & Chr$(0), vbFromUnicode)
hFontArial = CreateFontIndirect(lf) 'Create the normal font

lf.lfHeight = 12 * GetDeviceCaps(hPrintDc, LOGPIXELSY) \ 72
lf.lfWidth = 0
lf.lfEscapement = 0
lf.lfOrientation = 0
lf.lfWeight = 500
lf.lfItalic = False
lf.lfUnderline = False
lf.lfStrikeOut = False
lf.lfCharSet = DEFAULT_CHARSET
lf.lfOutPrecision = OUT_DEFAULT_PRECIS
lf.lfClipPrecision = CLIP_DEFAULT_PRECIS
lf.lfQuality = DEFAULT_QUALITY
lf.lfPitchAndFamily = DEFAULT_PITCH
lf.lfFaceName = StrConv("Times New Roman" & Chr$(0), vbFromUnicode)
hFontTimes = CreateFontIndirect(lf) 'Create the times new roman font

'Select normal font structure and save previous font info
hOldfont = SelectObject(hPrintDc, hFontArial)
sText = "This is Arial, 18 pt, Bold"
'Send text to printer, starting at location 100, 100
result = TextOut(hPrintDc, 100, 100, sText, Len(sText))
'Reset font back to original
result = SelectObject(hPrintDc, hOldfont)

'Select times font structure and save previous font info
hOldfont = SelectObject(hPrintDc, hFontTimes)
sText = "This is New Times Roman, 12 pt, regular"
'Send text to printer, starting at location 100, 120
result = TextOut(hPrintDc, 100, 120, sText, Len(sText))
'Reset font back to original
result = SelectObject(hPrintDc, hOldfont)

Nothing gets printed at all. Just a blank sheet of paper emerges from the printer.

Clif

ASKER

I'm an idiot.

The code sample I gave you that I said wasn't working wasn't exactly what I had in my VB 6 app. In my app I had accidentally remmed out the sText = "...". So it was printing, just empty strings.

It does work perfectly.

Thanks.

mladenovicz

You're welcomed ;)