Newsgroup: it.comp.lang.visual-basic
Titolo: vb.net RTF->printdocument

Sto cercando di fare una funzione in VB.net  che utilizzi le APIs per
inviare il messaggio EM_FORMATRANGE al controllo RichTextBox in modo
che stampi il contenuto nell'HDC dell'oggetto printdocument.
Non riesco a trovare l'errore nel mio codice e spero tanto che qualke
GURU mi sappia aiutare.
Ciao
Option Explicit On 
Imports System.Runtime.InteropServices
Module Module1
<StructLayout(LayoutKind.Sequential)> _
    Public Structure Rect
    Public Left As Int32
    Public Top As Int32
    Public Right As Int32
    Public Bottom As Int32
End Structure
<StructLayout(LayoutKind.Sequential)> _
    Public Structure CharRange
    Public cpMin As Int32
    Public cpMax As Int32
End Structure
<StructLayout(LayoutKind.Sequential)> _
    Public Structure FormatRange
    Public hdc As Int32
    Public hdcTarget As Int32
    Public rc As Rect
    Public rcPage As Rect
    Public chrg As CharRange
End Structure
Private Const WM_USER As Int32 = &H400
Private Const EM_FORMATRANGE As Int32 = WM_USER + 57
Private Const EM_SETTARGETDEVICE As Int32 = WM_USER + 72
Private Const PHYSICALOFFSETX As Int32 = 112
Private Const PHYSICALOFFSETY As Int32 = 113
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Integer,     ByVal wMsg As Int32, ByVal wParam As
Int32, ByVal lParam As Object) As Int32
Public Sub PrintRTF(ByVal RTF As RichTextBox, ByVal LeftMarginWidth As
Long, ByVal TopMarginHeight As Long, ByVal RightMarginWidth As Long,
ByVal BottomMarginHeight As Long, ByVal pHDC As Object)
	'pHDC is the printer HDC and it is OK (I try to draw a
rectangle with APIs and it works)
	Dim LeftOffset As Int32, TopOffset As Int32
	Dim LeftMargin As Int32, TopMargin As Int32
	Dim RightMargin As Int32, BottomMargin As Int32
	Dim rcDrawTo As Rect
	Dim rcPage As Rect
	Dim fr As FormatRange
	Dim TextLength As Int32
	Dim NextCharPosition As Int32
	Dim r As Int32
	Dim sourceHdc As GCHandle = GCHandle.Alloc(pHDC,
GCHandleType.Pinned)
	' Set printable area rect
	rcPage.Left = 200
	rcPage.Top = 200
	rcPage.Right = 1000
	rcPage.Bottom = 1000
' Set rect in which to print (relative to printable area)
	rcDrawTo.Left = 0
	rcDrawTo.Top = 0
	rcDrawTo.Right = 900
	rcDrawTo.Bottom = 1200
' Set up the print instructions
	fr.hdc = sourceHdc.AddrOfPinnedObject.ToInt32 ' Use the same
DC for measuring and rendering
	fr.hdcTarget = fr.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
	NextCharPosition = SendMessage(RTF.Handle.ToInt32,
EM_FORMATRANGE, True, fr)
End Sub
end module

 Int32, ByVal lParam As Object) As Int32
Inoltre non sono molto convinto nella parte dove 'pinni' la memoria.
Credo tu non abbia l'opzione Option Strict On, prova ad attivarla così
perlomeno elimini questo tipo di errori dovuti a cast errati, la trovi nelle
proprietà del progetto.
HTH
Corrado

proprietà del progetto.
Ti ringrazio per i suggerimenti ma anche dopo questi miglioramenti non
riesco a stampare l'rtf.
Pinno la memoria perche' al sendmessage server un int32 nell hdc;
quindi suppongo che abbia bisogno del puntatore.
Ho anche provato a passare la struttura utilizzando MarshalAs, ma in
quel caso mi da un errore dicendomi che l'oggetto e già in uso.
richiamo la funzione nel seguente modo:
hdcprova = e.Graphics.GetHdc
PrintRTF(Form1.IstanzaForm1.rtbDescrizione, 0, 0, 100, 100,hdcprova)
e.Graphics.ReleaseHdc(hdcprova)
ho anche provato a fare una dll in c++ per aggirare l'ostacolo, ma mi
da lo stesso errore.
Vi prego aiutateme ;-(
Grazie mille. Ciao

Ultimi sviluppi del codice, ma nemmeno ora funziona.
Option Explicit On 
Option Strict On
Imports System.Runtime.InteropServices
Module Module1
 
    <StructLayout(LayoutKind.Sequential)> _
 Public Structure Rect
        Public Left As Int32
        Public Top As Int32
        Public Right As Int32
        Public Bottom As Int32
    End Structure
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure CharRange
        Public cpMin As Int32
        Public cpMax As Int32
    End Structure
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure FormatRange
        <MarshalAs(UnmanagedType.U4)> Public hdc As Object
        <MarshalAs(UnmanagedType.U4)> Public hdcTarget As Object
        Public rc As Rect
        Public rcPage As Rect
        Public chrg As CharRange
    End Structure
    Private Const WM_USER As Int32 = &H400
    Private Const EM_FORMATRANGE As Int32 = WM_USER + 57
    Private Const EM_SETTARGETDEVICE As Int32 = WM_USER + 72
    Private Const PHYSICALOFFSETX As Int32 = 112
    Private Const PHYSICALOFFSETY As Int32 = 113
    Private Declare Function SendMessage Lib "user32" Alias
"SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Int32, ByVal
wParam As Int32, ByVal lParam As Object) As Int32
    Public Sub PrintRTF(ByVal RTF As RichTextBox, ByVal
LeftMarginWidth As Long, ByVal TopMarginHeight As Long, ByVal
RightMarginWidth As Long, ByVal BottomMarginHeight As Long, ByVal pHDC
As Object)
        Dim LeftOffset As Int32, TopOffset As Int32
        Dim LeftMargin As Int32, TopMargin As Int32
        Dim RightMargin As Int32, BottomMargin As Int32
        Dim rcDrawTo As Rect
        Dim rcPage As Rect
        Dim fr As FormatRange
        Dim TextLength As Int32
        Dim NextCharPosition As Int32
        Dim r As Int32
        Dim sourceHdc As GCHandle = GCHandle.Alloc(pHDC,
GCHandleType.Pinned)
        ' Set printable area rect
        rcPage.Left = 200
        rcPage.Top = 200
        rcPage.Right = 1000
        rcPage.Bottom = 1000
        ' Set rect in which to print (relative to printable area)
        rcDrawTo.Left = 0
        rcDrawTo.Top = 0
        rcDrawTo.Right = 900
        rcDrawTo.Bottom = 1200
        ' Set up the print instructions
        fr.hdc = pHDC             ' Use the same DC for measuring and
rendering
        fr.hdcTarget = fr.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
        NextCharPosition = SendMessage(RTF.Handle, EM_FORMATRANGE, 0,
fr)
    End Sub
End Module

Ho qualche dubbio sull'ultimo parametro della sendmessage...
Qui trovi un esempio per VB6
http://www.vbcity.com/forums/faq.asp?fid=7&cat=RichTextBox#TID1388
http://support.microsoft.com/default.aspx?scid=kb;EN-US;q146022
Dall'esempio MS vedo che l'ultimo parametro della SM vuole un puntatore alla
struttura Formatrange
quindi passare un oggetto non è corretto, rifacendomi all'esempio MS la SM
dovrebbe essere
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" _
   (ByVal hWnd As IntPtr, ByVal msg As int32, ByVal wp As int32, _
   lp As FormatRange) As Int32
Dagli un occhiata e prova a fare una migrazione dell'esempio, per verificare
dove è il problema.
Ciao
Corrado
PS. Da quello che ho letto, quando passi da Managed code a Uanaged come nel
tuo caso,il CLR si preoccupa di pinnare la memoria quindi,almeno per i test,
non mi preoccuperei di pinnare con GCHandle.


http://support.microsoft.com/default.aspx?scid=kb;EN-US;q146022
Innanzi tutto ti ringrazio per il tuo prezioso aiuto.
Avevo visto gli esempi microsoft, ma non riesco a trasformare quella
funzione di VB6 in 
vb.net
. Il printdocumen gestisce le cose in maniera
parecchio differente:
Ho recuperato l'HDC del printdocument (dovo utilizzare quello perche'
e' gia' stato creato dal printdocument) con
hdcprova = e.Graphics.GetHdc
PrintRTF(Form1.IstanzaForm1.rtbDescrizione, 0, 0, 100, 100, hdcprova)
e.Graphics.ReleaseHdc(hdcprova)
e funziona se ad esempio richiamo nella mia funzione l'API rectangle
passandogli l'hdcprova come IntPtr.
Non so invece come passare l'hdc alla struttura FormatRange: ovvero se
la dichiaro nel modo seguente:
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure FormatRange
        <MarshalAs(UnmanagedType.U4)> Public hdc As IntPtr
        <MarshalAs(UnmanagedType.U4)> Public hdcTarget As IntPtr
        Public rc As Rect
        Public rcPage As Rect
        Public chrg As CharRange
    End Structure
e gli passo l'hdc direttamente.
Ho modificato il SendMessage come mi hai suggerito tu, ma non funziona
ancora.
Cio' che mi piacerebbe poi fare è ereditare la classe printdocument in
modo da fargli gestire direttamente la stampa dell'RTF contenuto nel
RichTexBox
Ciao e grazie ancora

correzione.... del post precedente
Non so invece come passare l'hdc alla struttura FormatRange: ovvero se
la dichiaro nel modo seguente:
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure FormatRange
        <MarshalAs(UnmanagedType.U4)> Public hdc As IntPtr
        <MarshalAs(UnmanagedType.U4)> Public hdcTarget As IntPtr
        Public rc As Rect
        Public rcPage As Rect
        Public chrg As CharRange
    End Structure
e gli passo l'hdc direttamente, mi dice che l'oggetto è già in uso e
cio' mi fa pensare che non ha beccato l'HDC corretto. Ecco perche
pinnavo l'HDC in memoria.

 stampa dell'RTF contenuto nel RichTexBox
Direi che questo è il modo corretto di implementare la cosa.
Ti consiglio di vedere l'esempio (in C#):
...\Microsoft.NET\FrameworkSDK\Samples\quickstart\winforms\samples\pri
nting\simplepad
Ciao.
--
BSD is for UNIX-lovers -- linux is for Windows-haters.

nting\simplepad
Guardato, ma non fa cio' che vorrei fare; infatti non utilizza
sendmessage per sfruttare la funzione di stampa del RichTextBox.
Nell'esempio calcola la larghezza della stringa e le attacca assieme,
ma non formatta i caratteri come sono formattati in RTF.
Per fare un esempio potrei fare una funzione del tipo:
Public Function StringSize(ByVal f As Font, ByVal s As String, ByVal e
As PrintPageEventArgs) As SizeF
        Dim StringFormat As New
StringFormat(StringFormat.GenericTypographic)
        StringFormat.FormatFlags =
StringFormatFlags.MeasureTrailingSpaces
        If s <> Nothing Then
            StringSize = e.Graphics.MeasureString(s, f, 5000,
StringFormat)
        Else
            StringSize = New SizeF(0, 0)
        End If
    End Function
e poi mettere in ciclo ogni riga facendo un controllo della larghezza
ed altezza di ogni carattere, ma già la funzione MesureString sopra
utilizza parecchi cicli e non vorrei appesantire troppo i miei
progetti (specie visto che c'e' già la funzione corretta nel
richtextbox)

Non ho VB.net qui quindi non posso provare direttamente percui mi è
difficile fare ulteriori prove.
La prossima settimana proverò a dare un occhiata,e' vero, la stampa è
cambiata parecchio rispetto a
VB6.
Ciao
Corrado

Questi sono gli ultimi sviluppi del mio codice. Adesso dovrei quasi
esserci solo che mi esce un'eccezione unhandled in cui mi viene detto
che l'oggetto e' gia' in uso. 
Se commento il SendMessage in cui viene passata la strutture
FormatRange sparisce l'eccezzione, quindi ne ho dedotto 3 possibilità:
1) la struttura non viene passata correttamente
2) l'hdc non viene passato correttamente
3) l'oggetto non viene liberato dal secondo sendmessage dopo il suo
utilizzo
Ciao
_______________________________________________________
Option Explicit On 
Option Strict On
Imports System.Runtime.InteropServices
Module Module1
 
    <StructLayout(LayoutKind.Sequential)> _
 Public Structure Rect
        <MarshalAs(UnmanagedType.I4)> Public Left As Int32
        <MarshalAs(UnmanagedType.I4)> Public Top As Int32
        <MarshalAs(UnmanagedType.I4)> Public Right As Int32
        <MarshalAs(UnmanagedType.I4)> Public Bottom As Int32
    End Structure
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure CharRange
        <MarshalAs(UnmanagedType.I4)> Public cpMin As Int32
        <MarshalAs(UnmanagedType.I4)> Public cpMax As Int32
    End Structure
    <StructLayout(LayoutKind.Sequential)> _
    Public Structure FormatRange
        <MarshalAs(UnmanagedType.I4)> Public hdc As IntPtr
        <MarshalAs(UnmanagedType.I4)> Public hdcTarget As IntPtr
        Public rc As Rect
        Public rcPage As Rect
        Public chrg As CharRange
    End Structure
    Private Const WM_USER As Int32 = &H400
    Private Const EM_FORMATRANGE As Int32 = WM_USER + 57
    Private Const EM_SETTARGETDEVICE As Int32 = WM_USER + 72
    Private Const PHYSICALOFFSETX As Int32 = 112
    Private Const PHYSICALOFFSETY As Int32 = 113
    Private Declare Function SendMessage Lib "user32" Alias
"SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Int32, ByVal
wParam As Int32, ByVal lParam As FormatRange) As Int32
    Private Declare Function SendMessage Lib "user32" Alias
"SendMessageA" (ByVal hwnd As IntPtr, ByVal wMsg As Int32, ByVal
wParam As Int32, ByVal lParam As IntPtr) As Int32
    Public Sub PrintRTF(ByVal RTF As RichTextBox, ByVal
LeftMarginWidth As Long, ByVal TopMarginHeight As Long, ByVal
RightMarginWidth As Long, ByVal BottomMarginHeight As Long, ByVal pHDC
As IntPtr)
        Dim LeftOffset As Int32, TopOffset As Int32
        Dim LeftMargin As Int32, TopMargin As Int32
        Dim RightMargin As Int32, BottomMargin As Int32
        Dim rcDrawTo As Rect
        Dim rcPage As Rect
        Dim fr As FormatRange
        Dim TextLength As Int32
        Dim NextCharPosition As Int32
        Dim r As Int32
        ' Set printable area rect
        rcPage.Left = 200
        rcPage.Top = 200
        rcPage.Right = 1000
        rcPage.Bottom = 1000
        ' Set rect in which to print (relative to printable area)
        rcDrawTo.Left = 0
        rcDrawTo.Top = 0
        rcDrawTo.Right = 900
        rcDrawTo.Bottom = 1200
        ' Set up the print instructions
        fr.hdc = pHDC ' Use the same DC for measuring and rendering
        fr.hdcTarget = fr.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
        NextCharPosition = SendMessage(RTF.Handle, EM_FORMATRANGE, 1,
fr)
        SendMessage(RTF.Handle, EM_FORMATRANGE, 0, IntPtr.Zero)
    End Sub
End Module
            SendMessage(RTF.Handle, EM_FORMATRANGE, 0, IntPtr.Zero)
 
    End Sub
End Module

Scusate, nel copia ed incolla ho copiato due volte la fine del modulo.

Scusate se vi ho rotto fino ad adesso.
Non scervellatevi più per me.
Ho capito tutto!
I 2 errori erano:
1) gethdc e relasehdc vanno eseguiti in coppia (uno dopo l'altro)
2) la struttura andava passata per riferimento !!!
Grazie ancora, specialmente a Corrado

Scusate se vi ho rotto fino ad adesso.
Assolutamente no ;-)
Vista la novita' dell' argomento il tuo thread e' stato sicuramente
il benvenuto :-)
-- 
ciao, hal

Prego, sono contento che hai risolto il problema, postresti postare il
codice così ci do un occhiata?
Puo sempre essere comodo ;-)
Ciao
Corrado

Puo sempre essere comodo ;-)
praticamente il sendmessage andava dichiarato cosi':
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As IntPtr, ByVal wMsg As Int32, ByVal wParam As Int32,
ByRef lParam As FormatRange) As Int32
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As IntPtr, ByVal wMsg As Int32, ByVal wParam As Int32,
ByVal lParam As IntPtr) As Int32
 
e per prendersi l'hdc bisogna:
hdcprova = e.Graphics.GetHdc
e.Graphics.ReleaseHdc(hdcprova)
poi lo usi subito dopo.
ho ancora un problema. In win 98 il codice mi genera un overflow o
underflow e non riesco a scovarlo. Hai qualche idea?

underflow e non riesco a scovarlo. Hai qualche idea?
Risolto, e' un bacco di 
VB.NET
 nell'inizializzazione del system object
FONT. 
Ciao a tutti :-)