Newsgroup: it.comp.lang.visual-basic
Titolo: AIUTO... Devo stampare una Richt TBox (o Text Box) in un punto preciso della pagina...

Devo stampare il contenuto multiline di una Richt TBox (o Text Box) in un
punto preciso della pagina...
Il testo deve essere stampato cosi' come si vede a video. Ho l'esigenza di
modificare le coordinate X, Y del
punto iniziale facendo pero' in modo che il testo non mi fuoriesca dalla
pagina.
Non riesco a definire la lunghezza di ogni linea.
Sulla rete non ho trovato particolari soluzioni...
Qualcuno mi puo' aiutare?
Grazie, Walter

 wrote in message 84vsh0$sst$1...@nslave2.tin.it...

Puoi usare l'API SendMessage. Ti permette di leggere il numero
di righe della (Rich)TextBox, e il testo delle singole righe.
Con Printer.TextWidth puoi trovare la dimensione che avrebbe
una riga stampata. Cerchi la più larga, e ricalcoli X e Y di
conseguenza, (oppure ridimensioni il font e rifai il test).
Inserisci in un modulo questo:
____________________________
Option Explicit
Public Const EM_GETLINE = &HC4
Public Const EM_GETLINECOUNT = &HBA
Public Const EM_LINEINDEX = &HBB
Public Const EM_LINEFROMCHAR = &HC9
Public Const EM_SETSEL = &HB1
Public Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByRef lParam As Byte) As Long
Public Const MaxCaratteri = 1500   ' Scale this to size of text box
Public buff(MaxCaratteri) As Byte
____________________________
...poi aggiungi nel form questa funzione:
____________________________
Function fGetLine(Box As Control, LineNumber As Long) As String
    'Dim MAX_CHAR_PER_LINE As Integer
    Dim byteLo%
    Dim byteHi%
    Dim Buffer$
    Dim K As Integer
    Dim x%
    ' This function fills the buffer with a line of text
    ' specified by LineNumber from the text box control.
    ' The first line starts at zero.
    byteLo% = MaxCaratteri And (255)  '[changed 5/15/92]
    byteHi% = Int(MaxCaratteri / 256) '[changed 5/15/92]
    Buffer$ = Chr$(byteLo%) + Chr$(byteHi%) + Space$(MaxCaratteri - 2)
    ' [Above line changed 5/15/92 to correct problem.]
    For K = 0 To MaxCaratteri
        buff(K) = 255
    Next K
    x% = SendMessage(Box.hwnd, EM_GETLINE, LineNumber, buff(0))
    fGetLine$ = ""
    For K = 0 To MaxCaratteri
        If buff(K) = 255 Then Exit For
        fGetLine = fGetLine & Chr$(buff(K))
    Next K
End Function
_____________________________
Ottieni le singole righe con questo codice:
_____________________________
    Dim NumeroLinee As Long
    Dim Linee As Long
    Dim RigaDiTesto As String
    NumeroLinee = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0&, 0&)
    ' legge il numero di linee
    For Linee = 0 To NumeroLinee
        RigaDiTesto =  fGetLine(Text1, Linee)
        Debug.Print RigaDiTesto
    Next
_____________________________
Se hai ancora problemi scrivimi.
Bye, G.
--
---------------------------------------------
    Le risposte alle tue domande le trovi
    sul Sito Comune di questo NewsGroup:
 
http://www.murialdo.it/it_lang_vb
       ... e nell'help in linea !
---------------------------------------------
Real E-address: 
gaet...@hotmail.com

 Come faccio a stampare un Rich Text Box (o una Text Box) facendo in modo
che il testo non occupi tutta la larghezza del foglio, ma dimensioni
precise? Inoltre, come posso anche indicare il tipo di carattere, formato,
ecc. (quello che compare all'interno del Common Dialog, per intenderci)?
domanda 2: usando il common dialog, appunto, e il seltext del controllo che
ti interessa.
domanda 1: cerco di raccogliere un codice per la stampa di un rtb che avevo
trovato sulla rete e che mi sembrava funzionasse abbastanza bene, con
qualche adattamento mio. e' un anno esatto che non lo guardo quindi p.f. non
chiedermi spiegazioni :)
Private Sub cmdOK_Click()
' 1 CM = 567 TWIPS
On Error GoTo errman
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
' Unload Me
Exit Sub
errman:
MsgBox Error
Exit Sub
End Sub
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
'IN UN BAS
' PRINT RTF
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 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