Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Richtextbox + Commondialog margins and detect user settings

Status
Not open for further replies.

three57m

Programmer
Jun 13, 2006
202
US
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:

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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top