Home
Search
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
C# Helper...
 
XML RSS Feed
Follow VBHelper on Twitter
 
 
 
MSDN Visual Basic Community
 
 
 
 
 
TitlePrint text on an odd piece of paper
DescriptionThis example shows how to print text on an odd piece of paper in Visual Basic 6.
Keywordsprint, paper, unusual paper
CategoriesGraphics, Miscellany
 
I recently wanted to print on an oddly sized and shaped piece of paper. The top of the paper had an uneven edge but the bottom was flat so I needed to feed the paper in bottom-first. The design made it clear which edge was the top, however, so I couldn't print normally or the text would appear upside down.

This example prints text upside down, starting at the X and Y coordinate needed to position the text nicely on the paper. This example probably won't be too useful as it is written (unless you happen to have a piece of very similar paper) but you can use it to see how to print upside down at given coordinates.

When you click the Print button, the program reads the text to print from a text box. It loads the desited font normally and prints a space. This serves two purposes. First, printing something initializes the printer, which is necessary before creating rotated fonts. Second, the program examines teh Printer.Y property before and after printing the space to see how much vertical space to leave between lines.

Next the program sets the X and Y coordinates for the first line of text. Those were chosen for the piece of paper.

The code then saves the printer's device context (hDC), creates a font rotated 180 degrees, and selects the font into the printer.

The program loops through the lines of text, printing each. After each line, the code moves the Y coordinate for the next line up by the line spacing amount.

After it prints all of the text, the code restores the printer's original font and calls the EndDoc method to send the results to the printer.

 
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 Command1_Click()
Const FONT_SIZE As Long = 13
Const FONT_NAME As String = "ShelleyAllegro BT"

Dim txt As String
Dim lines() As String
Dim i As Integer
Dim printer_hdc As Long
Dim log_font As LOGFONT
Dim new_font As Long
Dim old_font As Long
Dim x As Long
Dim y As Long
Dim dy As Single

    txt = txtInput.Text

    ' Get dy.
    Printer.ScaleMode = vbPixels
    Printer.CurrentX = 0
    Printer.CurrentY = 0
    Printer.FontName = FONT_NAME
    Printer.FontSize = FONT_SIZE
    Printer.Print " "
    dy = Printer.CurrentY

    x = (8.5 - 3) * 1440 / Printer.TwipsPerPixelX
    y = (5.25) * 1440 / Printer.TwipsPerPixelX
    printer_hdc = Printer.hdc

    With log_font
        .lfEscapement = 1800
        .lfHeight = (FONT_SIZE * -20) / _
            Printer.TwipsPerPixelY
        .lfFaceName = FONT_NAME & vbNullChar
    End With
    new_font = CreateFontIndirect(log_font)
    old_font = SelectObject(printer_hdc, new_font)

    ' Draw the text.
    lines = Split(txt, vbCrLf)
    For i = LBound(lines) To UBound(lines)
        TextOut printer_hdc, x, y, lines(i), Len(lines(i))
        y = y - dy
    Next i

    ' Restore the original font.
    SelectObject printer_hdc, old_font
    DeleteObject new_font

    Printer.EndDoc
End Sub
 
 
Copyright © 1997-2010 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated