Newsgroup: it.comp.lang.visual-basic
Titolo: stampa rtf

Ciao a tutti!
Problema:
Quando cerco di stampare il contenuto di una RichTextBox su foglio A4, mi
stampa con una larghezza superiore a quella del foglio e quindi non si
riesce a leggere.
Io uso il seguente codice:
Private Sub print_Click()
Dim c, i
CD1.ShowPrinter
c = CD1.Copies
For i = 1 To c
Printer.Print rtfIstruzioni.Text
Printer.NewPage
Next i
End Sub
e ho una stampante a getto d'inchiostro collegata al pc via parallela
(niente rete o simili), e win2000.
Qualcuno sa poi perchè la stampa procede lo stesso anche se clicco annulla
nella finestra di dialogo stampante?
Grazie
DEGRA

 ha scritto

il codice qui sotto l'ho trovato e funziona. dovrai un po' adattarlo.
la gestione dello spool e' una delle cose piu' indegne in windows, solo
parzialmente migliorata in nt4/5. cmq di solito la stampante direi finisca
quantomento di fare quello che ha nel buffer. se mandi 50 pagine di una
riga, premere annulla serve a poco.
ciao, a.
' dichiarazioni
Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
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
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
Global Const WM_USER As Long = &H400
Global Const EM_FORMATRANGE As Long = WM_USER + 57
Global Const EM_SETTARGETDEVICE As Long = WM_USER + 72
Global Const PHYSICALOFFSETX As Long = 112
Global Const PHYSICALOFFSETY As Long = 113
Declare Function SendMessage _
Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal WP As Long, lp As Any) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal
lpsz2 As String) As Long
Declare Function GetDeviceCaps _
Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
'Declare Function SendMessage _
'Lib "user32" Alias "SendMessageA" _
'(ByVal hwnd As Long, ByVal Msg As Long, _
'ByVal WP As Long, lp As Any) As Long
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 Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _
        TopMarginHeight, RightMarginWidth, BottomMarginHeight)
    On Error GoTo errman
    Dim LeftOffset As Long, TopOffset As Long
    Dim LeftMargin As Long, TopMargin As Long
    Dim RightMargin As Long, BottomMargin As Long
    Dim fr As FormatRange
    Dim rcDrawTo As Rect
    Dim rcPage As Rect
    Dim TextLength As Long
    Dim r As Long
    Dim J
    For J = 1 To Val(frmStampa.txtCopies) ' aggiunto io => # copie
        frmStampa.lblPrintingPage = 1
        frmStampa.lblPrintingCopy = Val(frmStampa.lblPrintingCopy) + 1
        DoEvents
            Dim NextCharPosition As Long
            Printer.Print Space(1) ' Start a print job to get a valid
Printer.hDC
            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(frmStampa.RTFPrint.Text)
            Do  ' Loop printing each page until done
                ' Print the page by sending EM_FORMATRANGE message
                NextCharPosition = SendMessage(frmStampa.RTFPrint.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.NewPage                  ' Move on to next page
                frmStampa.lblPrintingPage = Val(frmStampa.lblPrintingPage) +
1
                DoEvents
                Printer.Print Space(1) ' Re-initialize hDC         fr.hDC =
Printer.hDC
                fr.hdcTarget = Printer.hdc
            Loop
            ' Commit the print job
        Printer.EndDoc      ' Allow the RTF to free up memory
    Next J
    r = SendMessage(frmStampa.RTFPrint.hwnd, EM_FORMATRANGE, False, ByVal
CLng(0))
    Exit Sub
errman:
    MsgBox Error
    Exit Sub
End Sub
'uso
Private Sub cmdOK_Click()
    ' 1 CM = 567 TWIPS
    On Error GoTo errman
framePrinting.Enabled = True
lblPC.Enabled = True
lblPrintingCopy.Enabled = True
lblPP.Enabled = True
lblPrintingPage.Enabled = True
    Dim LM As Long, TM As Long, RM As Long, BM As Long
    LM = Val(txtLM) * 567
    TM = Val(txtTM) * 567
    RM = Val(txtRM) * 567
    BM = Val(txtBM) * 567
    With frmMain.ActiveForm.RTF
        'RTFPrint .Left = .Left
        'RTFPrint .Top = .Top
        RTFPrint.Width = Width
        RTFPrint.Height = Height
        RTFPrint.RightMargin = .RightMargin
        RTFPrint.SelFontName = .SelFontName
        RTFPrint.SelFontSize = .SelFontSize
        RTFPrint.SelBold = .SelBold
        RTFPrint.SelItalic = .SelItalic
        If optPrintAll Then
            RTFPrint.Text = .Text
        ElseIf optPrintSel Then
            RTFPrint.Text = .SelText
        End If
    End With
    RTFPrint.SelLength = 0
    PrintRTF RTFPrint, LM, TM, RM, BM
framePrinting.Enabled = False
lblPC.Enabled = False
lblPrintingCopy.Enabled = False
lblPP.Enabled = False
lblPrintingPage.Enabled = False
txtCopies = 1
'    Unload Me
    Exit Sub
errman:
    MsgBox Error
framePrinting.Enabled = False
lblPC.Enabled = False
lblPrintingCopy.Enabled = False
lblPP.Enabled = False
lblPrintingPage.Enabled = False
txtCopies = 1
    Exit Sub
End Sub