Printing Images and Text combined. (financial reward)
Marvin van Dongen
This is an update on a question i already asked. There's still no one who
solved my question. Hopefully a small financial reward that i will pay to
the one who can solve my problem will convince people to help me with my
problem. Besides the money you will also get my forever gratitude ;-).
Here's the original post:
Hello People,
I've got a very irritating problem with printing in VB, wich already took me
several days trying to solve it, but no succes. From the internet i've got a
very good module to print from a richtextbox with top, bottom, left and
right margins. Now i've got the layout of the page as follows: Title,
Subtitle, Image, Loads of text. The problem is that i first print the title
and subtitle, then print the image, and then the rest of the text with a
topmargin of 7000, so that i don't overlap the image. The problem is that
when there so many text that there's a second page, it takes another
topmargin of 7000, when i want it to be normal (1440, 1 inch). Does anyone
know how to fix this? I already tried to print all the text first and then
the image, but when the text goes to the 2nd page, the image get's printed
on the 2nd page to. Is there any way to go back to the first page? Printing
the image first and then all of the text doesn't work either because it
overwrites the image. I'm desperate. Any help will be VERY GREATLY
appreciated!
P.S. The way the code is now, it will print the title + subtitle first,then
the image and then the rest of the text, wich results in the large topmargin
on the 2nd page
The code in the form:
RichTextBox1.Text = rtbTitel.Text 'get the titletext in the "printing" RTB
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelLength = 1
RichTextBox1.SelText = vbCrLf & vbCrLf 'enter some spaces for the subtitle
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelLength = 1
RichTextBox1.SelRTF = rtbOmschrijving.TextRTF 'enter the subtitle
RichTextBox1.SelStart = 0
RichTextBox1.SelLength = Len(rtbTitel.Text)
RichTextBox1.SelAlignment = vbCenter 'center the title
RichTextBox1.SelFontSize = 18
RichTextBox1.SelStart = Len(rtbTitel.Text) + (Len(vbCrLf) * 2)
RichTextBox1.SelLength = Len(rtbOmschrijving.Text)
RichTextBox1.SelFontSize = 14
RichTextBox1.SelAlignment = vbCenter 'center the subtitle 2
PrintRTF RichTextBox1, 1440, 1440, 1440, 1440 'print the title+subtitle
picNew.Width = 3000
picNew.Height = 3000
picNew.AutoRedraw = True
picNew.PaintPicture Image1.Picture, 0, 0, picNew.ScaleWidth,
picNew.ScaleHeight, 0, 0 'put the picture in a "printing" Picture control
Printer.PaintPicture picNew.Image, 3000 + 1300, 1440 + 1300, 3000, 3000
'print the image
RichTextBox1.Text = "" 'empty the printing RTB
rtbIngredienten.SelStart = 0
rtbIngredienten.SelLength = 1
Dim rtbFont As String
rtbFont = rtbIngredienten.SelFontName
RichTextBox1.SelFontName = rtbFont
RichTextBox1.SelFontSize = 14
RichTextBox1.SelUnderline = True
RichTextBox1.SelBold = True
RichTextBox1.SelText = "Ingrediënten" & vbCrLf 'put a header above the 2nd
piece of text
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelLength = 1
RichTextBox1.SelRTF = rtbIngredienten.TextRTF
rtbBereiding.SelStart = 0
rtbBereiding.SelLength = 1
rtbFont = rtbBereiding.SelFontName
RichTextBox1.SelFontName = rtbFont
RichTextBox1.SelFontSize = 14
RichTextBox1.SelUnderline = True
RichTextBox1.SelBold = True
RichTextBox1.SelText = vbCrLf & vbCrLf & "Bereiding" & vbCrLf 'put another
header in the 2nd piece of text
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelStart = Len(RichTextBox1.Text)
RichTextBox1.SelLength = 1
RichTextBox1.SelRTF = rtbBereiding.TextRTF
PrintRTF RichTextBox1, 1440, 7000, 1440, 1440 ' print the 2nd piece of text
with the topmargin of 7000
The code of the printing module:
Option Explicit
Private Type RECT
Left As Long
TOp As Long
Right As Long
Bottom As Long
End Type
Private 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
Private 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
Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function SendMessage Lib "USER32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, _
lp As Any) As Long
Private 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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' PrintRTF - Prints the contents of a RichTextBox control using the
' provided margins
'
' RTF - A RichTextBox control to print
'
' LeftMarginWidth - Width of desired left margin in twips
'
' TopMarginHeight - Height of desired top margin in twips
'
' RightMarginWidth - Width of desired right margin in twips
'
' BottomMarginHeight - Height of desired bottom margin in twips
'
' Notes - If you are also using WYSIWYG_RTF() on the provided RTF
' parameter you should specify the same LeftMarginWidth and
' RightMarginWidth that you used to call WYSIWYG_RTF()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _
TopMarginHeight As Long, RightMarginWidth As Long, BottomMarginHeight
As Long)
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 NextCharPosition As Long
Dim r
' Start a print job to get a valid Printer.hDC
Printer.Print Space(1)
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(RTF.Text)
' Loop printing each page until done
Do
' Print the page by sending EM_FORMATRANGE message
NextCharPosition = SendMessage(RTF.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
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
r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal _
CLng(0))
End Sub
Greetz,
Marvin van Dongen
Norm Cook
rtbBereiding, size of the loaded images etc.
However, any time you do a Printer.Print, make sure the Printer.CurrentX &
Printer.CurrentY are set as you need them and in the proper scale, as
defined in Printer.ScaleMode.
"Marvin van Dongen" <marvin...@NOSPAMwanadoo.nl> wrote in message
news:VIKZa.87890$0W5.2...@pollux.casema.net...
Marvin van Dongen
Thnx for trying to help me. Here's some more info:
rtbIngredienten and rtbBereiding are both RTB controls with a variable
amount of text with full markup. The image size is also variable, but is
resized to the same size every time, namely 3000x3000. The comment about the
Printer.CurrentX, CurrentY and Scalemode are not relevant (i think) because
i use a module wich doesn't use these things at all, but calls a API. I hope
you can help me!
Greetz,
Marvin
"Norm Cook" <norm...@cableone.net> schreef in bericht
news:vjff6r6...@corp.supernews.com...
Jeff Bennett
I have two possible solutions for you.
One uses the RichTextBox you already have
The other uses our ALLText HT/Pro as a replacement.
I'm not sure of all your requirements - it's likely the first with the
RichText control should meet your needs, otherwise consider ALLText.
Solution 1 - rather than printing each part of this document
separately as you do now, why don't you include the image in the rtf
control as well and then just have one large document that get's
printed all at once.
Solution 2 - using ALLText -
Well solution 1 is also very easy using ALLText,
- but in addition, with ALLText you can specify different top margins
for the first page and following pages. So you can tell ALLText to
start first page 7000 twips from the top and then all following pages
at 1440 twips from the top. Even better, when ALLText is done
printing the last page it will tell you where it left off so you can
start printing something else at that location on the same page.
* * Please include a copy of this note with your reply
Jeff Bennett President
Je...@Bennet-Tec.Com
Bennet-Tec Information Systems, Inc
50 Jericho Tpk, Jericho, NY 11753
Phone 516 997 5596, Fax - 5597
WWW.Bennet-Tec.Com
RELIABLE Component Software
and Software Development Services
* TList/Pro * ALLText HT/Pro * MetaDraw *
====================== ======================
"Marvin van Dongen" <marvin...@NOSPAMwanadoo.nl> wrote in message news:<VIKZa.87890$0W5.2...@pollux.casema.net>...
Marvin van Dongen
Thnx alot for your answer. I'll definitly consider buying ALLText. But first
i want to try to implement the image into an RTF control. The only problem
there is, for as far as i know, is that an RTF control can only implement
JPG files. Maybe i'll consider only permitting JPG files to be opened then.
Please give me some information about implementing an image into the RTF.
Thnx alot,
Marvin
"Jeff Bennett" <bt...@yahoo.com> schreef in bericht
news:4afa8f08.03081...@posting.google.com...
Schmidt
Try this simple example:
'***Into a Form (with one RichtextBox1-Control)
Private Type RECT: L As Long: T As Long: R As Long: B 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
Private Const EM_FORMATRANGE As Long = &H439
Private Declare Function SendMessage& Lib "USER32" Alias "SendMessageA" _
(ByVal hwnd&, ByVal msg&, ByVal wp&, lp As Any)
Private Sub Form_Click()
Dim SArr$(101), i&
Printer.Print "" 'init
'print some small RTF (not forcing a pagebreak)
RichTextBox1.Text = "Some Header-Text"
Debug.Print RTFPrint(RichTextBox1, 1300, 1300, 1300)
'print a picture
Printer.PaintPicture LoadPicture("c:\test.bmp"), _
3000 + 1300, 1440 + 1300, 3000, 3000
'and now some larger RTF (forcing a pagebreak)
SArr(0) = "Start " & UBound(SArr) - 1 & "-Lines"
For i = 1 To UBound(SArr) - 1
SArr(i) = "Line " & i
Next i
SArr(UBound(SArr)) = "End " & UBound(SArr) - 1 & "-Lines"
RichTextBox1.Text = Join(SArr, vbCrLf)
Debug.Print RTFPrint(RichTextBox1, 1300, 7000, 1300)
Printer.EndDoc
End Sub
Private Function RTFPrint&(RTF As RichTextBox, L, ByVal T, NewT)
Dim FR As FormatRange, Rct As RECT
Printer.ScaleMode = vbTwips
FR.rcPage.R = Printer.Width: FR.rcPage.B = Printer.Height
FR.hdcTarget = Printer.hdc: FR.hdc = Printer.hdc
Do
FR.chrg.cpMax = -1
FR.rc.T = T: FR.rc.B = Printer.ScaleHeight
FR.rc.L = L: FR.rc.R = Printer.ScaleWidth
FR.chrg.cpMin = SendMessage(RTF.hwnd, EM_FORMATRANGE, 1, FR)
RTFPrint = FR.rc.B 'Bottom of drawn rectangle
If SendMessage(RTF.hwnd, EM_FORMATRANGE, 0, FR) <= FR.chrg.cpMin Then
Exit Do
Else
Printer.NewPage
T = NewT
End If
Loop
SendMessage RTF.hwnd, EM_FORMATRANGE, 0, ByVal 0& 'free Res.
End Function
Olaf
Marvin van Dongen
If you'd be standing in front of me now, i would kiss you;-). You're my
absolute hero!!! This code works a beauty. I''ve already got it up and
running, but will spend some time trying to understand the code. The last
question i have is if it's possible to have a bottom margin as well. Please
send me an email, so that we can talk about the financial reward.
Greetings,
Marvin
"Schmidt" <s...@online.de> schreef in bericht
news:et3ysnMY...@TK2MSFTNGP10.phx.gbl...
Schmidt
> The last question i have is if it's possible to have a bottom margin as
well.
Of course.
I have made this small changes in the example below.
> Please send me an email, so that we can talk about the financial reward.
Not neccessary, your "frontal kiss" is more than enough <g>.
Olaf
'***Into a Form (with RichtextBox1)
Private Type RECT: L As Long: T As Long: R As Long: B 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
Private Const EM_FORMATRANGE As Long = &H439
Private Declare Function SendMessage& Lib "USER32" Alias "SendMessageA" _
(ByVal hwnd&, ByVal msg&, ByVal wp&, lp As Any)
Private Sub Form_Click()
Dim SArr$(101), Rct As RECT, NewRct As RECT, i&, Ret&, PicSize&
Dim LeftMargin&, RightMargin&, TopMargin&, BottomMargin&
LeftMargin = 1300: RightMargin = 1300
TopMargin = 1300: BottomMargin = 1300
Printer.Print "" 'init
'print some small RTF (not forcing a pagebreak)
RichTextBox1.Text = "Some Header-Text" & vbCrLf & "Header-NewLine"
Rct.L = LeftMargin: Rct.R = Printer.Width - RightMargin
Rct.T = TopMargin: Rct.B = Printer.Height - BottomMargin
NewRct = Rct 'NewPages like first Page
Ret = RTFPrint(RichTextBox1, Rct, NewRct)
'print a picture directly after the Text (Look at Ret-Value)
PicSize = 3000
Printer.PaintPicture LoadPicture("c:\test.bmp"), _
LeftMargin, Ret, PicSize, PicSize
'and now some larger RTF (forcing a pagebreak)
SArr(0) = "Start " & UBound(SArr) - 1 & "-Lines"
For i = 1 To UBound(SArr) - 1
SArr(i) = "Line " & i
Next i
SArr(UBound(SArr)) = "End " & UBound(SArr) - 1 & "-Lines"
RichTextBox1.Text = Join(SArr, vbCrLf)
Rct.L = LeftMargin: Rct.R = Printer.Width - RightMargin
Rct.T = Ret + PicSize: Rct.B = Printer.Height - BottomMargin
NewRct = Rct: NewRct.T = TopMargin
Ret = RTFPrint(RichTextBox1, Rct, NewRct)
'print a picture again (directly after the Text)
PicSize = 1000
Printer.PaintPicture LoadPicture("c:\test.bmp"), _
LeftMargin, Ret, PicSize, PicSize
Printer.EndDoc
End Sub
Private Function RTFPrint&(RTF As RichTextBox, R As RECT, NewR As RECT)
Dim FR As FormatRange, PageCount&
Printer.ScaleMode = vbTwips
FR.rcPage.R = Printer.Width: FR.rcPage.B = Printer.Height
FR.hdcTarget = Printer.hdc: FR.hdc = Printer.hdc
Do
FR.chrg.cpMax = -1
If PageCount = 0 Then FR.rc = R Else FR.rc = NewR
FR.chrg.cpMin = SendMessage(RTF.hwnd, EM_FORMATRANGE, 1, FR)
PageCount = PageCount + 1: RTFPrint = FR.rc.B 'Bottom of drawn rect
If SendMessage(RTF.hwnd, EM_FORMATRANGE, 0, FR) <= FR.chrg.cpMin Then
Exit Do
Else
Printer.NewPage
Marvin van Dongen
THANK YOU, VIELEN DANK, DANK U WEL, GRAZIE MOLTO, MERCI BEAUCOUP,
OBRIGADO,GRACIAS MUCHO......and much more :-P.
I think i've made my point..........
Greetings,
Marvin
"Schmidt" <s...@online.de> schreef in bericht
news:esbixfZY...@TK2MSFTNGP12.phx.gbl...