vb6 printform and the twip

Posted on 2013-02-06
Last Modified: 2013-02-07
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)
Question by:sidwelle
  • 8
  • 7
  • 4
LVL 14

Expert Comment

by:Brook Braswell
ID: 38859875
Could you not resize the form and it's objects to fit your screen ?
LVL 14

Expert Comment

by:Brook Braswell
ID: 38859894
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.
LVL 46

Expert Comment

by:Martin Liss
ID: 38860058
If you're interested in resizing the controls as Brook suggested then take a look at this article that I wrote.
Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center


Author Comment

ID: 38860061
...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.
LVL 14

Expert Comment

by:Brook Braswell
ID: 38860133
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

LVL 46

Expert Comment

by:Martin Liss
ID: 38860205
@Brook: Take a look at my code:)
LVL 46

Expert Comment

by:Martin Liss
ID: 38860227
Do you know of any API that would force XP to paint the entire form regardless of size ?
Try the attached demo project.

Author Comment

ID: 38860270

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 !
LVL 46

Expert Comment

by:Martin Liss
ID: 38860299
2.)  Find a command that will cause XP to paint and print the entire form. (API ?)
Try the attachment in post ID: 38860227.

Author Comment

ID: 38860384
Sorry, but I don't see an attachment ?
LVL 46

Expert Comment

by:Martin Liss
ID: 38860391
LVL 14

Expert Comment

by:Brook Braswell
ID: 38860460
Ha Ha...
I had adapted a project for resizing from your article about a year ago...
forgot where I got it from...( BTW Thanks )
LVL 46

Expert Comment

by:Martin Liss
ID: 38860463
You're welcome.

Author Comment

ID: 38861254
Martin, that looks like it might be what I need.

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


Author Comment

ID: 38861686
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 ?
LVL 46

Accepted Solution

Martin Liss earned 500 total points
ID: 38861744
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.

Author Comment

ID: 38861934
That worked, I just need to play w/it and clean it up a little.

I will follow up with the outcome.

Author Closing Comment

ID: 38864931
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.


LVL 46

Expert Comment

by:Martin Liss
ID: 38864953
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

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The purpose of this article is to demonstrate how we can use conditional statements using Python.
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
The goal of the video will be to teach the user the difference and consequence of passing data by value vs passing data by reference in C++. An example of passing data by value as well as an example of passing data by reference will be be given. Bot…
The viewer will learn how to user default arguments when defining functions. This method of defining functions will be contrasted with the non-default-argument of defining functions.

821 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question