Printing

[lavarock09]

Hey All,

I Have It To Print What is In My RichTextbox, but it goes straight to the default printer, so i want it so people can choose the printer,

how would i do this

[dglienna]

Put a combobox on a form, and then use this. The Printer Dialog doesn't work very well.

Option Explicit
 
Private Sub Combo1_Click()
  Dim p As String
  Dim prt As Printer
  p = Combo1.List(Combo1.ListIndex)
  For Each prt In Printers
    If prt.DeviceName = p Then
    Set Printer = prt
    End If
  Next prt
End Sub
 
Private Sub Form_Load()
  Dim x%
  Dim prt As Printer
  Combo1.Clear
  For Each prt In Printers
    Combo1.AddItem prt.DeviceName
  Next prt
  For x = 0 To Combo1.ListCount
      If Combo1.List(x) = Printer.DeviceName Then
      Combo1.TopIndex = x
      Combo1.ListIndex = x
      Exit Sub
    End If
  Next x
End Sub

[lavarock09]

how do i put a command button in there so that it prints when they press it

[dglienna]

You might want to use this. It will call up the print dialog.

I thought that you were printing already? The combo should be in a setup routine.

http://support.microsoft.com/kb/322710/EN-US/#7

[lavarock09]

thanx for directing me to this but...

this is the code for my form with the button in to bring up the printer dialogue box

Private Sub Command1_Click()
Dim printDlg As Printer
Set printDlg = New PrinterDlg
' Set the starting information for the dialog box based on the current
' printer settings.
printDlg[COLOR=Yellow].PrinterName[/COLOR] = Printer.DeviceName
printDlg.DriverName = Printer.DriverName
printDlg.Port = Printer.Port
 
' Set the default PaperBin so that a valid value is returned even
' in the Cancel case.
printDlg.PaperBin = Printer.PaperBin
 
' Set the flags for the PrinterDlg object using the same flags as in the
' common dialog control. The structure starts with VBPrinterConstants.
printDlg.Flags = VBPrinterConstants.cdlPDNoSelection _
                 Or VBPrinterConstants.cdlPDNoPageNums _
                 Or VBPrinterConstants.cdlPDReturnDC
Printer.TrackDefault = False
 
' When CancelError is set to True the ShowPrinterDlg will return error
' 32755. You can handle the error to know when the Cancel button was
' clicked. Enable this by uncommenting the lines prefixed with "'**".
'**printDlg.CancelError = True
 
' Add error handling for Cancel.
'**On Error GoTo Cancel
If Not printDlg.ShowPrinter(Me.hWnd) Then
    Debug.Print "Cancel Selected"
    Exit Sub
End If
 
'Turn off Error Handling for Cancel.
'**On Error GoTo 0
Dim NewPrinterName As String
Dim objPrinter As Printer
Dim strsetting As String
 
' Locate the printer that the user selected in the Printers collection.
NewPrinterName = UCase$(printDlg.PrinterName)
If Printer.DeviceName <> NewPrinterName Then
    For Each objPrinter In Printers
       If UCase$(objPrinter.DeviceName) = NewPrinterName Then
            Set Printer = objPrinter
       End If
    Next
End If
 
' Copy user input from the dialog box to the properties of the selected printer.
Printer.Copies = printDlg.Copies
Printer.Orientation = printDlg.Orientation
Printer.ColorMode = printDlg.ColorMode
Printer.Duplex = printDlg.Duplex
Printer.PaperBin = printDlg.PaperBin
Printer.PaperSize = printDlg.PaperSize
Printer.PrintQuality = printDlg.PrintQuality
 
' Display the results in the immediate (Debug) window.
' NOTE: Supported values for PaperBin and Size are printer specific. Some
' common defaults are defined in the Win32 SDK in MSDN and in Visual Basic.
' Print quality is the number of dots per inch.
With Printer
    Debug.Print .DeviceName
    If .Orientation = 1 Then
        strsetting = "Portrait. "
    Else
        strsetting = "Landscape. "
    End If
    Debug.Print "Copies = " & .Copies, "Orientation = " & _
       strsetting
    If .ColorMode = 1 Then
        strsetting = "Black and White. "
    Else
        strsetting = "Color. "
    End If
    Debug.Print "ColorMode = " & strsetting
    If .Duplex = 1 Then
        strsetting = "None. "
    ElseIf .Duplex = 2 Then
        strsetting = "Horizontal/Long Edge. "
    ElseIf .Duplex = 3 Then
        strsetting = "Vertical/Short Edge. "
    Else
        strsetting = "Unknown. "
    End If
    Debug.Print "Duplex = " & strsetting
    Debug.Print "PaperBin = " & .PaperBin
    Debug.Print "PaperSize = " & .PaperSize
    Debug.Print "PrintQuality = " & .PrintQuality
    If (printDlg.Flags And VBPrinterConstants.cdlPDPrintToFile) = _
       VBPrinterConstants.cdlPDPrintToFile Then
         Debug.Print "Print to File Selected"
    Else
         Debug.Print "Print to File Not Selected"
    End If
    Debug.Print "hDC = " & printDlg.hdc
End With
Exit Sub
'**Cancel:
'**If Err.Number = 32755 Then
'**    Debug.Print "Cancel Selected"
'**Else
'**    Debug.Print "A nonCancel Error Occured - "; Err.Number
'**End If
End Sub

but when i try to run it, it highlights the 5th line (in color yellow) and says

Compile Error: Method Or Data Member Not Found

[dglienna]

Did you download and install the control? Unzip the files, and copy them to the \windows\system32 folder. Then from a command prompt, type

regsvr32 VBprndlg.dll

You should get a message that it succeded. Then you have to restart VB and press Project - References to add the control to the IDE. Then, double-click it to add it to your form.

Let us know if you have any other problems.

Better yet, I've made it into a project. Once everthing is registered, just run this program to see everthing in operation. This worked fine for me.

[lavarock09]

1. What Is The IDE

2. Yes I Have Run The Dll File

3. What Is The Name Of The Thing I Am Looking For When I Press Ctrl T

Thanx

EDIT: Seems To Be Working Now, I Will Post If I Get Any Problems

Thanx Again

Lavarock09

[Mark Gambo]

1. What Is The IDE

2. Yes I Have Run The Dll File

3. What Is The Name Of The Thing I Am Looking For When I Press Ctrl T

Thanx

EDIT: Seems To Be Working Now, I Will Post If I Get Any Problems

Thanx Again

Lavarock09

Just to expand on what Dave posted the following code displays the Printer Dialog and the Page Dialog:

'This project needs 2 command buttons
Option Explicit
Const FW_NORMAL = 400
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_ROMAN = 16
Const CF_PRINTERFONTS = &H2
Const CF_SCREENFONTS = &H1
Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Const CF_EFFECTS = &H100&
Const CF_FORCEFONTEXIST = &H10000
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_LIMITSIZE = &H2000&
Const REGULAR_FONTTYPE = &H400
Const LF_FACESIZE = 32
Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const DM_DUPLEX = &H1000&
Const DM_ORIENTATION = &H1&
Const PD_PRINTSETUP = &H40
Const PD_DISABLEPRINTTOFILE = &H80000
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Private Type PAGESETUPDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    flags As Long
    ptPaperSize As POINTAPI
    rtMinMargin As RECT
    rtMargin As RECT
    hInstance As Long
    lCustData As Long
    lpfnPageSetupHook As Long
    lpfnPagePaintHook As Long
    lpPageSetupTemplateName As String
    hPageSetupTemplate As Long
End Type
Private Type PRINTDLG_TYPE
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    hDC As Long
    flags As Long
    nFromPage As Integer
    nToPage As Integer
    nMinPage As Integer
    nMaxPage As Integer
    nCopies As Integer
    hInstance As Long
    lCustData As Long
    lpfnPrintHook As Long
    lpfnSetupHook As Long
    lpPrintTemplateName As String
    lpSetupTemplateName As String
    hPrintTemplate As Long
    hSetupTemplate As Long
End Type
Private Type DEVNAMES_TYPE
    wDriverOffset As Integer
    wDeviceOffset As Integer
    wOutputOffset As Integer
    wDefault As Integer
    extra As String * 100
End Type
Private Type DEVMODE_TYPE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type
Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long
Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
 
Private Sub Command1_Click()
    ShowPrinter Me
End Sub
 
Private Sub Command2_Click()
    ShowPageSetupDlg
End Sub
 
Private Sub Form_Load()
    'KPD-Team 1998
    'URL: [url]http://www.allapi.net/[/url]
    'E-Mail: [email][email protected][/email]
    'Redim the variables to store the cutstom colors
    
    'Set the captions
    Command1.Caption = "ShowPrinter"
    Command2.Caption = "ShowPageSetupDlg"
End Sub
 
Private Function ShowPageSetupDlg() As Long
    Dim m_PSD As PAGESETUPDLG
    'Set the structure size
    m_PSD.lStructSize = Len(m_PSD)
    'Set the owner window
    m_PSD.hwndOwner = Me.hWnd
    'Set the application instance
    m_PSD.hInstance = App.hInstance
    'no extra flags
    m_PSD.flags = 0
 
    'Show the pagesetup dialog
    If PAGESETUPDLG(m_PSD) Then
        ShowPageSetupDlg = 0
    Else
        ShowPageSetupDlg = -1
    End If
End Function
 
Public Sub ShowPrinter(frmOwner As Form, Optional PrintFlags As Long)
    '-> Code by Donald Grover
    Dim PrintDlg As PRINTDLG_TYPE
    Dim DevMode As DEVMODE_TYPE
    Dim DevName As DEVNAMES_TYPE
 
    Dim lpDevMode As Long, lpDevName As Long
    Dim bReturn As Integer
    Dim objPrinter As Printer, NewPrinterName As String
 
    ' Use PrintDialog to get the handle to a memory
    ' block with a DevMode and DevName structures
 
    PrintDlg.lStructSize = Len(PrintDlg)
    PrintDlg.hwndOwner = frmOwner.hWnd
 
    PrintDlg.flags = PrintFlags
    On Error Resume Next
    'Set the current orientation and duplex setting
    DevMode.dmDeviceName = Printer.DeviceName
    DevMode.dmSize = Len(DevMode)
    DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
    DevMode.dmPaperWidth = Printer.Width
    DevMode.dmOrientation = Printer.Orientation
    DevMode.dmPaperSize = Printer.PaperSize
    DevMode.dmDuplex = Printer.Duplex
    On Error GoTo 0
 
    'Allocate memory for the initialization hDevMode structure
    'and copy the settings gathered above into this memory
    PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevMode))
    lpDevMode = GlobalLock(PrintDlg.hDevMode)
    If lpDevMode > 0 Then
        CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
        bReturn = GlobalUnlock(PrintDlg.hDevMode)
    End If
 
    'Set the current driver, device, and port name strings
    With DevName
        .wDriverOffset = 8
        .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
        .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
        .wDefault = 0
    End With
 
    With Printer
        DevName.extra = .DriverName & Chr(0) & .DeviceName & Chr(0) & .Port & Chr(0)
    End With
 
    'Allocate memory for the initial hDevName structure
    'and copy the settings gathered above into this memory
    PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(DevName))
    lpDevName = GlobalLock(PrintDlg.hDevNames)
    If lpDevName > 0 Then
        CopyMemory ByVal lpDevName, DevName, Len(DevName)
        bReturn = GlobalUnlock(lpDevName)
    End If
 
    'Call the print dialog up and let the user make changes
    If PrintDialog(PrintDlg) <> 0 Then
 
        'First get the DevName structure.
        lpDevName = GlobalLock(PrintDlg.hDevNames)
        CopyMemory DevName, ByVal lpDevName, 45
        bReturn = GlobalUnlock(lpDevName)
        GlobalFree PrintDlg.hDevNames
 
        'Next get the DevMode structure and set the printer
        'properties appropriately
        lpDevMode = GlobalLock(PrintDlg.hDevMode)
        CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
        bReturn = GlobalUnlock(PrintDlg.hDevMode)
        GlobalFree PrintDlg.hDevMode
        NewPrinterName = UCase$(Left(DevMode.dmDeviceName, InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
        If Printer.DeviceName <> NewPrinterName Then
            For Each objPrinter In Printers
                If UCase$(objPrinter.DeviceName) = NewPrinterName Then
                    Set Printer = objPrinter
                    'set printer toolbar name at this point
                End If
            Next
        End If
 
        On Error Resume Next
        'Set printer object properties according to selections made
        'by user
        Printer.Copies = DevMode.dmCopies
        Printer.Duplex = DevMode.dmDuplex
        Printer.Orientation = DevMode.dmOrientation
        Printer.PaperSize = DevMode.dmPaperSize
        Printer.PrintQuality = DevMode.dmPrintQuality
        Printer.ColorMode = DevMode.dmColor
        Printer.PaperBin = DevMode.dmDefaultSource
        On Error GoTo 0
    End If
End Sub

[dglienna]

M$ finally wrapped that up into a control. It comes in handy!

[lavarock09]

thank you but...(theres always a but isn't there)

how do i make it so it prints what is in my richtextbox?

[Mark Gambo]

M$ finally wrapped that up into a control. It comes in handy!

Dave,
I have d/l the new Dialog control, so do I need to still use all of that mess that I posted? Also How do I print to a specific area in a RTB?

[Mark Gambo]

thank you but...(theres always a but isn't there)

how do i make it so it prints what is in my richtextbox?

Lavarock,
I am attempting to write my own report writer using a RTB and I have found the following code to print the contains of a RTB:

Option Explicit
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_GETLINECOUNT = &HBA
Private Const WM_PASTE = &H302
 
Public intPageNumber As Integer
 
Public Const WM_USER As Long = &H400
Public Const EM_FORMATRANGE As Long = WM_USER + 57
Public Const EM_SETTARGETDEVICE As Long = WM_USER + 72
Public Const PHYSICALOFFSETX As Long = 112
Public Const PHYSICALOFFSETY As Long = 113
 
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
 
Public Type Rect
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
Public Type CharRange
  cpMin As Long ' First character of range (0 for start of doc)
  cpMax As Long ' Last character of range (-1 for end of doc)
End Type
 
Private Type FormatRange
  hdc As Long ' Actual DC to draw on
  hdcTarget As Long ' Target DC for determining text formatting
  rc As Rect ' Region of the DC to draw to (in twips)
  rcPage As Rect ' Region of the entire DC (page size) (in twips)
  chrg As CharRange ' Range of text to draw (see above declaration)
End Type
 
Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _
                        TopMarginHeight, RightMarginWidth, BottomMarginHeight, _
                        Optional blnPrintPageNum As Boolean = False)
 
Dim LeftOffset As Long
Dim TopOffset As Long
Dim LeftMargin As Long
Dim TopMargin As Long
Dim RightMargin As Long
Dim BottomMargin As Long
Dim fr As FormatRange
Dim rcDrawTo As Rect
Dim rcPage As Rect
Dim TextLength As Long
Dim NextCharPosition As Long
Dim r As Long
Dim strPageText As String
 
' Start a print job to get a valid Printer.hDC
Printer.Print Space(1)
'strOrientation
Printer.ScaleMode = vbTwips
 
' Get the offsett to the printable area on the page in twips
LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX), vbPixels, vbTwips)
TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY), vbPixels, vbTwips)
 
' Calculate the Left, Top, Right, and Bottom margins
LeftMargin = LeftMarginWidth - LeftOffset
TopMargin = TopMarginHeight - TopOffset
RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset
 
' Set printable area rect
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleWidth
rcPage.Bottom = Printer.ScaleHeight
 
' Set rect in which to print (relative to printable area)
rcDrawTo.Left = LeftMargin
rcDrawTo.Top = TopMargin
rcDrawTo.Right = RightMargin
rcDrawTo.Bottom = BottomMargin
 
' Set up the print instructions
fr.hdc = Printer.hdc ' Use the same DC for measuring and rendering
fr.hdcTarget = Printer.hdc ' Point at printer hDC
fr.rc = rcDrawTo ' Indicate the area on page to draw to
fr.rcPage = rcPage ' Indicate entire size of page
fr.chrg.cpMin = 0 ' Indicate start of text through
fr.chrg.cpMax = -1 ' end of the text
 
' Get length of text in RTF
TextLength = Len(RTF.Text)
 
' Loop printing each page until done
Do
' Print the page by sending EM_FORMATRANGE message
NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, True, fr)
If NextCharPosition >= TextLength Then Exit Do 'If done then exit
fr.chrg.cpMin = NextCharPosition ' Starting position for next page
 
'Printer.CurrentX = Printer.ScaleWidth - Len("Page " & intPageNumber)
 
If blnPrintPageNum Then 'This printer the page number in the lower righthand column of every page
    strPageText = "Page " & intPageNumber
    Printer.CurrentX = RightMargin - Len(strPageText)
    Printer.CurrentY = BottomMargin
    Printer.Print strPageText
    intPageNumber = intPageNumber + 1
End If
 
Printer.NewPage ' Move on to next page
 
Printer.Print Space(1) ' Re-initialize hDC
 
 
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
Loop
 
' Commit the print job
'Printer.CurrentX = Printer.ScaleWidth - Len("Page " & intPageNumber)
 
If blnPrintPageNum Then 'This printer the page number in the lower righthand column of every page
    strPageText = "Page " & intPageNumber
    Printer.CurrentX = RightMargin - Len(strPageText)
    Printer.CurrentY = BottomMargin
    Printer.Print strPageText
End If
 
Printer.EndDoc
 
' Allow the RTF to free up memory
r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal CLng(0))
End Sub

... and you call it like this:

PrintRTF RichTextBox1, 1440, 1440, 1440, 1440, True  ' 1440 Twips = 1 Inch

The 1440 are the number of twips for each of the margins (1440 twips equals one inch).

Hope this helps!

[lavarock09]

sorry, i am confused, A Lot!

What Do I Do?

[lavarock09]

ok, now i have it done, i cant choose which printer

[dglienna]

I've just added a richtextbox to my example, called rtb.
Add this line to the Print button

Debug.Print "hDC = " & printDlg.hDC
End With
[B]rtb.SelPrint printDlg.hDC
[/B]Exit Sub

[lavarock09]

my print button code is now

Private Sub Command1_Click()
PrintRTF Form1.RichTextBox1, 1440, 1440, 1440, 1440, True  ' 1440 Twips = 1 Inch
Debug.Print "hDC = " & PrintDlg.hdc
Form1.RichTextBox1.SelPrint PrintDlg.hdc
End Exit
End Sub

and that is just wrong