Prdemo: Visual Basic Version

The Visual Basic version of Prdemo displays a Printer dialog box through the CommonDialog control's ShowPrinter() method. We obtain the printer device context from the CommonDialog hDC property.

'*****************************************************************************
'                                                                            *
'  Prdemo.frm                                                                *
'                                                                            *
'  This program shows how to print the contents of a virtual buffer.  It     *
'  first loads a 640x480 BMP file into a virtual buffer and displays it.     *
'  When the user clicks the Print selection on the top-level menu, a 6-inch  *
'  by 4-inch copy of the BMP image is sent to the selected printer.          *
'                                                                            *
'*****************************************************************************
Const vbWidth = 640
Const vbHeight = 480
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Private Sub Form_Activate()
   Call fg_realize(hPal)
   Refresh
End Sub
Private Sub Form_Load()
   ScaleMode = 3
   Call fg_setdc(hDC)
   hPal = fg_defpal()
   Call fg_realize(hPal)
   Call fg_vbinit
   hVB = fg_vballoc(vbWidth, vbHeight)
   Call fg_vbopen(hVB)
   Call fg_vbcolors
   Call fg_showbmp(App.Path & "\PORCH.BMP", 0)
End Sub
Private Sub Form_Paint()
   Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
End Sub
Private Sub Form_Resize()
   cxClient = ScaleWidth
   cyClient = ScaleHeight
   Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
   Call fg_vbclose
   Call fg_vbfree(hVB)
   Call fg_vbfin
End Sub
Private Sub mnuPrint_Click()
   On Error GoTo ErrHandler
   CommonDialog1.CancelError = True
   CommonDialog1.Flags = cdlPDReturnDC Or cdlPDReturnDC Or cdlPDNoSelection
   CommonDialog1.PrinterDefault = False
   CommonDialog1.ShowPrinter
   Call fg_printdc(CommonDialog1.hDC)
   If fg_printer(10) = 0 Then
      Screen.MousePointer = 11
      Call fg_vbprint(0, vbWidth - 1, 0, vbHeight - 1, 0, 600, 0, 400, 2)
      Call fg_printer(1)   ' NEWFRAME
      Call fg_printer(11)  ' ENDDOC
      Screen.MousePointer = 0
   Else
      Call MsgBox("Printer setup failed", vbCritical, "Error")
   End If
ErrHandler:  ' user pressed Cancel button
End Sub
Private Sub mnuExit_Click()
   Unload Me
End Sub