Question1: Why does the printer commondialog take so long when closing after clicking print.
Question2: Using the code below (or not) how can i detect if a user has chosen the selected text option or all text option in the commondialog.
I am aware that richtextbox1.selprint commondialog.hdc will automatically detect this but i would also like to include the 1inch margins (1440twips) in printing and I cannot seem to figure out a way to do both.
here is what i have mashed together so far from various snippets on the net:
Question2: Using the code below (or not) how can i detect if a user has chosen the selected text option or all text option in the commondialog.
I am aware that richtextbox1.selprint commondialog.hdc will automatically detect this but i would also like to include the 1inch margins (1440twips) in printing and I cannot seem to figure out a way to do both.
here is what i have mashed together so far from various snippets on the net:
Code:
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 Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type CharRange
cpMin As Long
cpMax As Long
End Type
Private Type FormatRange
hdc As Long
hdcTarget As Long
rc As RECT
rcPage As RECT
chrg As CharRange
End Type
'////////////////////////////////////////////////////////
Public Sub PrinterDialog(Optional LeftMarginWidth As Long = 1440, Optional TopMarginHeight As Long = 1440, Optional RightMarginWidth As Long = 1440, Optional BottomMarginHeight As Long = 1440)
Dim nLeftOffset As Long
Dim nTopOffset As Long
Dim nLeftMargin As Long
Dim nTopMargin As Long
Dim nRightMargin As Long
Dim nBottomMargin As Long
Dim fr As FormatRange
Dim rcDrawTo As RECT
Dim rcPage As RECT
Dim nTextLength As Long
Dim nNextCharPos As Long
Dim nRet As Long
On Error GoTo errhandler
Printer.TrackDefault = True
CommonDialog1.CancelError = True
With CommonDialog1
.Flags = cdlPDReturnDC Or cdlPDNoPageNums
If RichTextBox1.SelLength = 0 Then
.Flags = .Flags + cdlPDAllPages
Else
.Flags = .Flags + cdlPDSelection
End If
.ShowPrinter
If CommonDialog1.Orientation = cdlLandscape Then
Printer.Orientation = cdlLandscape
Else
Printer.Orientation = cdlPortrait
End If
On Local Error Resume Next
Printer.Print Space(1)
Printer.ScaleMode = vbTwips
nLeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX), vbPixels, vbTwips)
nTopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY), vbPixels, vbTwips)
nLeftMargin = LeftMarginWidth - nLeftOffset
nTopMargin = TopMarginHeight - nTopOffset
nRightMargin = (Printer.Width - RightMarginWidth) - nLeftOffset
nBottomMargin = (Printer.Height - BottomMarginHeight) - nTopOffset
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = Printer.ScaleWidth
rcPage.Bottom = Printer.ScaleHeight
rcDrawTo.Left = nLeftMargin
rcDrawTo.Top = nTopMargin
rcDrawTo.Right = nRightMargin
rcDrawTo.Bottom = nBottomMargin
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
fr.rc = rcDrawTo
fr.rcPage = rcPage
fr.chrg.cpMin = 0
fr.chrg.cpMax = -1
nTextLength = Len(RichTextBox1.Text)
Do
fr.hdc = Printer.hdc
fr.hdcTarget = Printer.hdc
nNextCharPos = SendMessage(RichTextBox1.hWnd, EM_FORMATRANGE, True, fr)
If nNextCharPos >= nTextLength Then: Exit Do
fr.chrg.cpMin = nNextCharPos
Printer.NewPage
Printer.Print Space(1)
Loop
Printer.EndDoc
nRet = SendMessage(RichTextBox1.hWnd, EM_FORMATRANGE, False, ByVal CLng(0))
'Printer.Print ""
'RichTextBox1.SelPrint CommonDialog1.hdc
'Printer.EndDoc
End With
Exit Sub
errhandler:
If Err = 32755 Then 'user clicked cancel
RichTextBox1.SetFocus
Exit Sub
Else
Resume Next
End If
End Sub