Binaryworld - Printing using GDI printing APIs ... [ VB -> Printing ]

This sample code will show you how to perform basic print operations using GDI print APIs

- Create a standard exe project
- Add one command button control on the form1
- Add the following code in form1

Click here to copy the following block

Option Explicit
Private Declare Function StartDoc Lib "gdi32" Alias _
    "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long
Private Declare Function EndDoc Lib "gdi32" _
    (ByVal hdc As Long) As Long
Private Declare Function StartPage Lib "gdi32" _
    (ByVal hdc As Long) As Long
Private Declare Function EndPage Lib "gdi32" _
    (ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
    (ByVal hdc As Long, ByVal nindex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
    (ByVal hdc As Long) As Long

Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const PHYSICALOFFSETX = 112
Private Const PHYSICALOFFSETY = 113
Private Const LF_FACESIZE = 32
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 Type DOCINFO
  cbSize As Long
  lpszDocName As String
  lpszOutput As String
  lpszDatatype As String
  fwType As Long
End Type
Private Type MyPrinterInfo
  Handle As Long
  dpiX As Long
  dpiY As Long
  OffsetX As Long     ' the position of the top left corner of the
  OffsetY As Long     ' "printable area" of the page
End Type
Private MyPrinter As MyPrinterInfo

Private Function GetMyPrinter() As Boolean
  On Error GoTo UserCancel

  MyPrinter.Handle = Printer.hdc '//Get the default printer

  MyPrinter.dpiX = GetDeviceCaps _
      (MyPrinter.Handle, LOGPIXELSX)
  MyPrinter.dpiY = GetDeviceCaps _
      (MyPrinter.Handle, LOGPIXELSY)
  MyPrinter.OffsetX = GetDeviceCaps _
      (MyPrinter.Handle, PHYSICALOFFSETX)
  MyPrinter.OffsetY = GetDeviceCaps _
      (MyPrinter.Handle, PHYSICALOFFSETY)
  GetMyPrinter = True
  Exit Function
UserCancel:
  GetMyPrinter = False
End Function

Private Sub PrinterText(s1 As String, x As Single, y As Single)
  Dim xpos As Long, ypos As Long
  xpos = x * MyPrinter.dpiX - MyPrinter.OffsetX
  ypos = y * MyPrinter.dpiY - MyPrinter.OffsetY
  TextOut MyPrinter.Handle, xpos, ypos, s1, Len(s1)
End Sub

Private Sub Command1_Click()
  Dim iret As Long, n As Long
  Dim s1 As String, xpos As Long, ypos As Long
  Dim docinf As DOCINFO
  ' set up an initial font
  Dim log_font As LOGFONT, new_font As Long, old_font As Long
  If Not GetMyPrinter Then Exit Sub

  With log_font
    .lfEscapement = 0  ' desired rotation in tenths of a degree
    .lfHeight = 12 * (-MyPrinter.dpiY / 72)  ' 12 points
    .lfFaceName = "Verdana" & vbNullChar
    .lfWeight = 400   ' standard (bold = 700)
    .lfItalic = False
    .lfUnderline = False
  End With
  new_font = CreateFontIndirect(log_font)
  old_font = SelectObject(MyPrinter.Handle, new_font)

  ' start a document
  docinf.cbSize = Len(docinf)  ' Size of DOCINFO structure
  iret = StartDoc(MyPrinter.Handle, docinf)  'Start new document
  '///////////////////Page-1 /////////////////////////////////
  iret = StartPage(MyPrinter.Handle)  'Start a new page

  ' print a simple line of text at position (1, 1) (inches)
  For n = 1 To 10
    PrinterText "This is Line " & Format(n), 1, 1 * 0.16 * n
  Next n
  ' end page
  iret = EndPage(MyPrinter.Handle)  'End the page
  DeleteObject new_font  ' clear up the new font
  '///////////////////Page-2 /////////////////////////////////
  iret = StartPage(MyPrinter.Handle)  'Start a new page

  '//Change font again
  log_font.lfFaceName = "Courier New" & vbNullChar
  new_font = CreateFontIndirect(log_font)
  iret = SelectObject(MyPrinter.Handle, new_font)

  ' print a simple line of text at position (1, 1) (inches)
  For n = 1 To 10
    PrinterText "This is Line " & Format(n), 1, 1 * 0.16 * n
  Next n
  iret = EndPage(MyPrinter.Handle)  'End the page
  DeleteObject new_font  ' clear up the new font
  '////////////////////////////////////////////////////////////
  ' end the document
  iret = EndDoc(MyPrinter.Handle)  'End the print job
  iret = SelectObject(MyPrinter.Handle, old_font)
  iret = DeleteDC(MyPrinter.Handle)
End Sub