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!

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

PictureBox RTB Preview 1

Status
Not open for further replies.
three57m

three57m

Programmer
Jun 13, 2006
202
US
Ok here is the situation.

The code below is close "I THINK" , but I cannot seem to get the picturebox to accurately display what the printer would print with accurate margins etc..
note: everything is set to twips and as the msdn states 1440 twips = 1 logical inch so the goal is to display 1 inch margins and also print with 1 inch "THE PRINTING IS WORKING FINE" the preview is not.

I hammered together a quick test example to make it easier for anyone to assist.

Thank You.

Code: 
Option Explicit


'Add 2 command buttons
'Add 1 HScrollBar
'Add 1 VScrollBar
'Add 1 RichTextBox
'Add 1 PictureBox AND PLACE A PictureBox "Picture2" within the first picturebox
'Paste code and test

'I have been pasting all of this code to the RTB, Printing, and Previewing
'and trying various changes with no success.
'my goal is for the last line of the print out to match the last line of the preview
'with margin of 1 inch in preview
'thank you for any help.

Private Const WM_USER = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57

Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113

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 RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
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 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 Sub Command1_Click()
    'PREVIEW
    ShowPreview
End Sub

Private Sub Command2_Click()
    'PRINT
    PrintPage
End Sub

Private Sub Form_Load()
    
    'Size and position User Interface
    Me.Height = 9000
    Me.Width = 12500
    '
    Picture1.Top = 120
    Picture1.Left = 120
    Picture1.Width = 10000
    Picture1.Height = 4000
    '
    HScroll1.Top = Picture1.Top + Picture1.Height
    HScroll1.Left = 120
    HScroll1.Width = Picture1.Width
    '
    VScroll1.Top = 120
    VScroll1.Left = Picture1.Left + Picture1.Width
    VScroll1.Height = Picture1.Height
    '
    RichTextBox1.Top = HScroll1.Top + HScroll1.Height
    RichTextBox1.Left = 120
    RichTextBox1.Width = Picture1.Width
    RichTextBox1.Height = 4000
    '
    Command1.Top = 120
    Command1.Left = 10500 + VScroll1.Width
    '
    Command2.Top = RichTextBox1.Top
    Command2.Left = 10500 + VScroll1.Width
    
    'Add Captions
    Command1.Caption = "Preview"
    Command2.Caption = "Print Page"
    
    'Autoverb for mouse paste
    RichTextBox1.AutoVerbMenu = True
    
    'RTB Font
    RichTextBox1.Font.Name = "Courier New"
    RichTextBox1.Font.Size = 10
    
    'Set scroll bars to 100
    HScroll1.Max = 100
    VScroll1.Max = 100
    
    'Setup PicBox for display
    Picture2.AutoRedraw = True
    Picture2.Appearance = 0
    Picture2.BorderStyle = 0
    Picture2.BackColor = vbWhite
    Picture2.ScaleMode = vbTwips
    
    'Position & Set Picture2 to paper size
    Picture2.Top = 0
    Picture2.Left = 0
    Picture2.Height = 15840 'because 1440 twips = 1 inch and paper will be 11 in H
    Picture2.Width = 12240 'because 1440 twips = 1 inch and paper will be 8.5 in W
    
End Sub

Public Sub ShowPreview()
    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 nRet             As Long
    
    '1440 for desired 1inch margins
    
    Printer.TrackDefault = True
    Printer.Orientation = 1
    
    Printer.ScaleMode = vbTwips
    
    nLeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX), vbPixels, vbTwips)
    nTopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY), vbPixels, vbTwips)
    
    nLeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX), vbPixels, vbTwips)
    nTopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY), vbPixels, vbTwips)
    
    nLeftMargin = 1440 - nLeftOffset
    nTopMargin = 1440 - nTopOffset
    nRightMargin = Printer.Width - (1440 - nLeftOffset)
    nBottomMargin = Printer.Height - (1440 - 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.rc = rcDrawTo
    fr.rcPage = rcPage
    
    fr.chrg.cpMin = 0
    fr.chrg.cpMax = -1
    nTextLength = Len(RichTextBox1.Text)
    
    
    fr.rc = rcDrawTo
    fr.rcPage = rcPage
    fr.hdc = Picture2.hdc
    fr.hdcTarget = Printer.hdc
    
    SendMessage RichTextBox1.hwnd, EM_FORMATRANGE, True, fr
    
   
    
    Picture2.Print
    
    'Allow RichTextBox to free up memory
    nRet = SendMessage(RichTextBox1.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
    
    
End Sub


Public Sub PrintPage()
    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 nRet             As Long
    
    '1440 for desired 1inch margins
    
    Printer.TrackDefault = True
    Printer.Orientation = 1
    Printer.Print Space(0)
    Printer.ScaleMode = vbTwips
    
    nLeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX), vbPixels, vbTwips)
    nTopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY), vbPixels, vbTwips)
    
    nLeftMargin = 1440 - nLeftOffset
    nTopMargin = 1440 - nTopOffset
    nRightMargin = Printer.Width - (1440 - nLeftOffset)
    nBottomMargin = Printer.Height - (1440 - 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.rc = rcDrawTo
    fr.rcPage = rcPage
    
    fr.chrg.cpMin = 0
    fr.chrg.cpMax = -1
    nTextLength = Len(RichTextBox1.Text)
    
    
    fr.rc = rcDrawTo
    fr.rcPage = rcPage
    fr.hdc = Printer.hdc
    fr.hdcTarget = Printer.hdc
    
    SendMessage RichTextBox1.hwnd, EM_FORMATRANGE, True, fr
    
    Printer.Print
    
    Printer.EndDoc
    
    'Allow RichTextBox to free up memory
    nRet = SendMessage(RichTextBox1.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
    
    
End Sub


'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'''All code below this line is for the scroll bars''''
Private Sub VScroll1_Change()
   Call tp
End Sub

Private Sub VScroll1_Scroll()
   Call tp
End Sub
Private Sub HScroll1_Change()
   Call lft
End Sub

Private Sub HScroll1_Scroll()
   Call lft
End Sub
Private Sub tp()
   Dim l As Double
   Dim a As Double
   Dim X As Double
   
   X = VScroll1.Value
   a = Picture2.Height - Picture1.Height
   l = (a * X) / 100
   Picture2.Top = -l

End Sub

Private Sub lft()
   Dim l As Double
   Dim a As Double
   Dim X As Double
   
   X = HScroll1.Value
   a = Picture2.Width - Picture1.Width
   l = (a * X) / 100
   Picture2.Left = -l

End Sub
 
Sort by date Sort by votes
strongm, my code is based mostly on this link, are you saying i am missing something from the support link?
 
Upvote 0 Downvote
The link shows how to set up the RTB so that it displays EXACTLY the same as the print - so you should not need a seperate preview in a picturebox. In particular you seem to have ignored the use of EM_SETTARGETDEVICE, which makes everything nice and easy.
 
Upvote 0 Downvote
>certain fonts incorrectly causing characters to be truncated on the right

I've been using EM_FORMATRANGE for years under a variety of situations (WYSIWYG printing, measuring the length of mixed font strings, etc) and never encountered this. And VB's RTB itself uses EM_FORMATRANGE to print to the printer object - .SelPrint is just a wrapper for it, so I'd expect the output to the printer device to be clipped as well if EM_FORMATRANGE is to blame.

Could you provide an example of a font for which this occurs, and I can then see and perhaps understand the clipping you are referring to?


Ok , by adding the following to my original example

Code: 
Private Sub Form_Activate()
    RichTextBox1.Text = "Private Const CFE_SUPERSCRIPT As Long = &H2THETRAILINGSEVEN1234567"
    RichTextBox1.SelStart = 1
    RichTextBox1.SelLength = Len(RichTextBox1.Text)
    RichTextBox1.SelFontName = "Courier New"
    RichTextBox1.SelFontSize = 12
End Sub
[\code]


we see that the 7 at the end is truncated.

I tried with EM_SETTARGETDEVICE without success



I am sure I am missing something here but it really appears that EM_FORMATRANGE is sending a truncated image for the picbox and not the printer, so I thought if I could get the printer contents instead of the em_format problem may be solved.

As for using an actual RTB with EM_SETTARGETDEVICE  for the display It does display the exact contents (correct first char to last) but it does not always show the exact same word wrap as the printer.
 
Upvote 0 Downvote
Cutting and pasting your original code into a form here and then adding your amendment - no clipping of the 7. And using it in one of my WYSIWYG RTB experiments also shows no clipping of the same text

Can you confirm OS, and VB service pack level?
 
Upvote 0 Downvote
And just to verify if I take the exact code above with added amendement I lose the 7. If I add 8 I lose 78 if I add 9 it finally wraps.
 
Upvote 0 Downvote
SP6 That I load from VB60SP6-KB957924-x86-ENU.msi
 
Upvote 0 Downvote
Actually this "VB60SP6-KB957924-x86-ENU.msi " is the VB6 SP6 Update...so I would have used Vs6sp6B.exe for sp6 and then the update.
 
Upvote 0 Downvote
Think we may have to blame the printer driver ...

Can you change drivers, and see if you get the same problem?
 
Upvote 0 Downvote
So yes it turned out the driver caused this. My printer is a cheap HP4260 that I have had for a while. I tested with several drivers and all was fine. So I guess my only question would be why would this happen? Anyway, I sincerely thank you strongm, I was not thinking along these lines (printer drivers) at all so thanks again.

Sincerely, Ron
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Ken01
  • Locked
  • Question
Display Imageboxes on a PictureBox 1
Replies
1
Views
194
strongm
strongm
2009luca
  • Locked
  • Question
DISPLAYING pdf in picturebox
Replies
9
Views
453
sal21
sal21
Ken01
  • Locked
  • Question
VB picturebox graphics 1
Replies
1
Views
187
Andrzejek
Andrzejek
2009luca
  • Locked
  • Question
CENTER image in picturebox
Replies
4
Views
309
Andrzejek
Andrzejek
sal21
  • Locked
  • Question
LOAD image in picturebox from url...
Replies
1
Views
247
strongm
strongm

Part and Inventory Search

Sponsor

Back
Top