• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 422
  • Last Modified:

vb6 printform and the twip

I am supporting an older application that uses the 'printform' feature of VB6 to print a form to the printer. All works well as long as we use a 17" or greater monitor. Anything less and the printform gets clipped at the bottom.  Looks like VB does not paint the form if its off the bottom of the screen and that part of the image does not get forwarded to the printer.

How can I force widows to paint the entire image and forward it to the printer ?
Do I dare go into the reg and change the twip size for the current printer ? (if I can find it)
  • 8
  • 7
  • 4
1 Solution
Brook BraswellApplication Development ManagerCommented:
Could you not resize the form and it's objects to fit your screen ?
Brook BraswellApplication Development ManagerCommented:
The original for must have been written to be a certain pixel width / height.

You could modify this app to check the screen size and then do a form resize so that objects do not fall off the bottom of the screen.  You could have this function work for when the screen is smaller in the x or y and then also "resize" all the objects in the same manner.

The only other possibility would be to create a report ( such as crystal reports )  that would show the same data as what is on your current display and then print the report rather than the screen.
Martin LissOlder than dirtCommented:
If you're interested in resizing the controls as Brook suggested then take a look at this article that I wrote.
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

sidwelleAuthor Commented:
...certain pixel width / height: Yes, it must be exact because it lines up with Avery precut labels (8.5 x 11 sheet)

If I could chg the Twip count, XP would be fooled in painting the entire form ?

Do you know of any API that would force XP to paint the entire form regardless of size ?

I could re-write, but I am trying do as little as possible to support the app.
Brook BraswellApplication Development ManagerCommented:
I have done the resize with a vb6 class control I wrote.
You just pass the form to the control in the Load Event once everything is set the way you want it.
Then again in the Resize Event...

if you intend to set the Height and width then I use a global Boolean called gbNotYet so that the resize does not get continue if you set the width,  then the height such as

gbNotYet = true
Me.Width = screen.width
gbNotYet = true
me.Height = screen.height

< general Declarations>

Private clsResize As CResizer

Private sub Form_Load()

            ' your code

         Set clsResize = New CResizer
         clsResize.Initialize Me

End sub

Private Sub Form_Resize()
        if gbNotYet then Exit sub
        clsResize.ResizeControls Me

End Sub

Option Explicit

Private Type CtrlProportions
    Name As String
    Move As Boolean
    RESIZE As Boolean
    AdjustFont As Boolean
    HeightProportions As Single
    WidthProportions As Single
    TopProportions As Single
    LeftProportions As Single
    OrigHeight As Single
    OrigWidth As Single
    OrigFont As Single
    OrigBold As Boolean
    OX1 As Single
    OX2 As Single
    OY1 As Single
    OY2 As Single
    ' for the Janus Grid
    RowProp As Single
    ColHeadProp As Single
End Type

Private mProportionsArray() As CtrlProportions
Private mlngFormScaleHeight As Long
Private mLastFormScaleHeight As Long

Public Sub Initialize(frm As Form)
           Dim i As Integer
           Dim lngLeft As Long
           Dim lngLeftOffset As Long
10         On Error Resume Next
20         If Not gbResizeOn Then Exit Sub
30         mlngFormScaleHeight = frm.ScaleHeight
40         ReDim mProportionsArray(0 To frm.Controls.count - 1)
50         For i = 0 To frm.Controls.count - 1
60            With mProportionsArray(i)
70               .Name = frm.Controls(i).Name
80               .Move = True
90               .RESIZE = True
100              .HeightProportions = frm.Controls(i).Height / frm.ScaleHeight
110              .WidthProportions = frm.Controls(i).Width / frm.ScaleWidth
120              .TopProportions = frm.Controls(i).Top / frm.ScaleHeight
130              .AdjustFont = CtlHasFont(frm.Controls(i))
140              If .AdjustFont Then
150                 .OrigFont = frm.Controls(i).Font.SIZE
160                 .OrigBold = frm.Controls(i).Font.BOLD
170              Else
180                .OrigFont = 0
190                .OrigBold = False
200              End If
210              .OrigHeight = frm.Controls(i).Height
220              .OrigWidth = frm.Controls(i).Width
                 ' Controls on certain tab controls have -75000 added to their .Left prop to make them invisible.
230              lngLeftOffset = 0
240              lngLeft = frm.Controls(i).Left
250              Select Case UCase(TypeName(frm.Controls(i)))
                 Case "LINE"
260                 .OX1 = frm.Controls(i).X1
270                 .OX2 = frm.Controls(i).X2
280                 .OY1 = frm.Controls(i).Y1
290                 .OY2 = frm.Controls(i).Y2
300              Case "GRIDEX"
310                 .RowProp = frm.Controls(i).RowHeight / frm.ScaleHeight
320                 .ColHeadProp = frm.Controls(i).ColumnHeaderHeight / frm.ScaleHeight
330              End Select
                 ' This line may need to be modified to add other tab control types
340              If UCase(TypeName(frm.Controls(i).Container)) = "SSTAB" And lngLeft < 0 Then
350                  lngLeftOffset = 75000
360              End If
370              .LeftProportions = (lngLeft + lngLeftOffset) / frm.ScaleWidth
380           End With
390        Next i

End Sub

Public Function CtlHasFont(ByRef C As Control) As Boolean
                Dim MySize As Single
10              CtlHasFont = False
20              On Error GoTo PROC_ERR
30              MySize = C.Font.SIZE
40              CtlHasFont = True
50              Exit Function
                ' NO FONT FOR YOU
End Function

Public Sub ResizeControls(frm As Form, Optional cHgt_PCT As Single = 0, Optional cWth_PCT As Single = 0)
           Dim lngCtl As Long
           Dim lngLeftOffset As Long
           Dim dblFontSize As Double
           Dim lngHeightOffSet As Long
           Dim BackToNormal As Boolean
           Dim UseHgt_PCT As Single
           Dim UseWth_PCT As Single
10         On Error Resume Next 'comboboxes and perhaps other controls don't have a height property
20         If Not gbResizeOn Then Exit Sub
30         If cHgt_PCT = 0 And cWth_PCT = 0 Then
40            UseHgt_PCT = gHgt_PCT
50            UseWth_PCT = gWth_PCT
60         Else
70            UseHgt_PCT = cHgt_PCT
80            UseWth_PCT = cWth_PCT
90         End If
100        If UCase(frm.Name) <> "FRMMAIN" Then
110           If UCase(frm.Name) <> "TIMECLOCK" And UCase(frm.Name) <> "FRMPSMAIN" Then
120              BackToNormal = (UseHgt_PCT = 1)
130           Else
140              BackToNormal = (frm.ScaleHeight / mlngFormScaleHeight) = 1
150           End If
160        Else
170           BackToNormal = (frm.ScaleHeight / mlngFormScaleHeight) = 1
180        End If
190        For lngCtl = 0 To frm.Controls.count - 1
200            With mProportionsArray(lngCtl)
                  ' move and resize objcontrols
210               If .AdjustFont Then
220                  If BackToNormal Then
230                     dblFontSize = .OrigFont  ' frm.Controls(lngCtl).Font.SIZE * (frm.ScaleHeight / mLastFormScaleHeight)
240                     frm.Controls(lngCtl).Font.BOLD = .OrigBold
250                  Else
260                     If UCase(TypeName(frm.Controls(lngCtl))) = "COMBOBOX" Then
'160                        dblFontSize = Frm.Controls(lngCtl).Font.SIZE * ((Frm.ScaleHeight / mlngFormScaleHeight) * 0.9)
270                        dblFontSize = frm.Controls(lngCtl).Font.SIZE * ((frm.ScaleHeight / mlngFormScaleHeight) * 0.95)
280                     Else
'180                        dblFontSize = Frm.Controls(lngCtl).Font.SIZE * ((Frm.ScaleHeight / mlngFormScaleHeight) * 0.8)
290                        dblFontSize = frm.Controls(lngCtl).Font.SIZE * ((frm.ScaleHeight / mlngFormScaleHeight) * 0.9)
300                     End If
310                  End If
320               End If
330               If .AdjustFont Then
340                  If dblFontSize < .OrigFont Then
350                     dblFontSize = .OrigFont
360                  End If
370                  frm.Controls(lngCtl).Font.SIZE = dblFontSize
380               End If
390               If .Move Then
400                   lngLeftOffset = 0
                      ' This line may need to be modified to add other tab control types
410                   If UCase(TypeName(frm.Controls(lngCtl).Container)) = "SSTAB" And frm.Controls(lngCtl).Left < 0 Then
420                       lngLeftOffset = 75000
430                   End If

440                   If UCase(TypeName(frm.Controls(lngCtl).Container)) = "SSTAB" And _
                              UCase(TypeName(frm.Controls(lngCtl))) = "FRAME" And _
                              UCase(frm.Controls(lngCtl).Tag) = "FRAME" Then
450                      frm.Controls(lngCtl).Top = frm.Controls(lngCtl).Top
460                   Else
470                      frm.Controls(lngCtl).Left = .LeftProportions * frm.ScaleWidth - lngLeftOffset
480                      frm.Controls(lngCtl).Top = .TopProportions * frm.ScaleHeight
490                   End If
500               End If

510               If .RESIZE Then
520                  If UCase(frm.Controls(lngCtl).Tag) = "NO RESIZE" Then GoTo SkipControl
530                  If UCase(TypeName(frm.Controls(lngCtl))) = "LINE" Then
540                     If BackToNormal Then
550                        frm.Controls(lngCtl).X1 = .OX1
560                        frm.Controls(lngCtl).X2 = .OX2
570                        frm.Controls(lngCtl).Y1 = .OY1
580                        frm.Controls(lngCtl).Y2 = .OY2
590                     Else
600                        frm.Controls(lngCtl).X1 = frm.Controls(lngCtl).X1 * UseWth_PCT
610                        frm.Controls(lngCtl).X2 = frm.Controls(lngCtl).X2 * UseWth_PCT
620                        frm.Controls(lngCtl).Y1 = frm.Controls(lngCtl).Y1 * UseHgt_PCT
630                        frm.Controls(lngCtl).Y2 = frm.Controls(lngCtl).Y2 * UseHgt_PCT
640                     End If
650                  Else
660                     If UCase(TypeName(frm.Controls(lngCtl))) = "GRIDEX" Then
670                        frm.Controls(lngCtl).RowHeight = .RowProp * frm.ScaleHeight
680                        frm.Controls(lngCtl).ColumnHeaderHeight = .ColHeadProp * frm.ScaleHeight
690                     End If
700                     If BackToNormal Then
710                        frm.Controls(lngCtl).Width = .OrigWidth
720                        frm.Controls(lngCtl).Height = .OrigHeight
730                     Else
740                        frm.Controls(lngCtl).Width = .WidthProportions * frm.ScaleWidth
750                        If UCase(TypeName(frm.Controls(lngCtl).Container)) = "SSTAB" And _
                              UCase(TypeName(frm.Controls(lngCtl))) = "FRAME" And _
                              UCase(frm.Controls(lngCtl).Tag) = "FRAME" Then
760                           lngHeightOffSet = (.TopProportions * frm.ScaleHeight) - frm.Controls(lngCtl).Top
770                           frm.Controls(lngCtl).Height = (.HeightProportions * frm.ScaleHeight) + lngHeightOffSet
780                        Else
790                           frm.Controls(lngCtl).Height = .HeightProportions * frm.ScaleHeight
800                        End If
810                     End If
820                  End If
830                  If UCase(TypeName(frm.Controls(lngCtl))) = "COMBOBOX" Then
840                     frm.Controls(lngCtl).SelLength = 0
850                  End If

860               End If
870            End With
880        Next lngCtl
890        mLastFormScaleHeight = frm.ScaleHeight

End Sub

Open in new window

Martin LissOlder than dirtCommented:
@Brook: Take a look at my code:)
Martin LissOlder than dirtCommented:
Do you know of any API that would force XP to paint the entire form regardless of size ?
Try the attached demo project.
sidwelleAuthor Commented:

I realize that you have done some nice work here, but I am not sure what this is going to do for me ?   From what I understand, resizing the form just makes a smaller form.

Here is my understanding, correct me if I am wrong:
Windows keeps the size of the monitor in a value of  TWIPS-X and TWIPS-Y.    It then does its best to reproduce what is on the screen on Paper.  This produces (kind of) true Wysiwyg. you can then print something and hold it up to the monitor and it should almost match in size.

I see 3 options:
1.)  Make XP think the screen is bigger than what it is. (change the twip count)
2.)  Find a command that will cause XP to paint and print the entire form. (API ?)
3.)  Get a bigger monitor !
Martin LissOlder than dirtCommented:
2.)  Find a command that will cause XP to paint and print the entire form. (API ?)
Try the attachment in post ID: 38860227.
sidwelleAuthor Commented:
Sorry, but I don't see an attachment ?
Martin LissOlder than dirtCommented:
Brook BraswellApplication Development ManagerCommented:
Ha Ha...
I had adapted a project for resizing from your article about a year ago...
forgot where I got it from...( BTW Thanks )
Martin LissOlder than dirtCommented:
You're welcome.
sidwelleAuthor Commented:
Martin, that looks like it might be what I need.

Let me test for a few days and I will post back.

sidwelleAuthor Commented:
instead of capturing a snapshot, I think it would be more efficient to get the image.
I get a snap of the desktop (what ever happens to have focus at the time)

'    Call keybd_event(VK_MENU, 0, 0, 0)
'    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
'    DoEvents
'    Call keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0)
'    Call keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0)
    Clipboard.SetData Form1.Image

but now my issue is that all my controls on the form are images, all I end up with is the backgroud image that is blank.  I need to grab an image of the form with all controls painted.  Any way to do that ?
Martin LissOlder than dirtCommented:
My apologies. I just tried that project for the first time in years and it doesn't work as advertised. Here's an article from MS that purports to do what you want.
sidwelleAuthor Commented:
That worked, I just need to play w/it and clean it up a little.

I will follow up with the outcome.
sidwelleAuthor Commented:
Martin, that was excellent.

I just adapted the example to what I needed.  Didn't use 2 picture boxes, just used the image of the form the I wanted to print as the source.


Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

Select the 'About Me' tab in my profile and you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2012
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

  • 8
  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now