Solved

Printing a form ?

Posted on 1998-10-26
11
271 Views
Last Modified: 2010-04-30
HI
i am using the print dialog control to print a form .
but it is only printing th form on half the size of an A4 page ,How do i make it larger so it prints on the whole page.
0
Comment
Question by:CraigLazar
  • 6
  • 5
11 Comments
 
LVL 14

Accepted Solution

by:
waty earned 10 total points
ID: 1441606
Use the following code to capture the form, paste the return in a picture and print the picturebox using the size you want.

' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 24/09/98
' * Time             : 13:53
' * Module Name      : Capture_Module
' * Module Filename  : Capture.bas
' **********************************************************************
' * Comments         : Screen capture code
' *
' *
' **********************************************************************

Option Explicit

' *** declares to disable PC
Public Const SPI_SCREENSAVERRUNNING = 97

Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Boolean, ByVal fuWinIni As Long) As Long
' *** global variable for capture setting
Global Setting As Integer

Private Type PALETTEENTRY
   peRed As Byte
   peGreen As Byte
   peBlue As Byte
   peFlags As Byte
End Type

Private Type LOGPALETTE
   PALVERSION As Integer
   palNumEntries As Integer
   palPalEntry(255) As PALETTEENTRY ' Enough for 256 colors
End Type


Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End Type

Private Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "gdi32" (ByVal hdc As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "gdi32" (lpLogPalette As LOGPALETTE) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function SelectPalette Lib "gdi32" (ByVal hdc As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Type PicBmp
   Size As Long

   nType As Long
   hBmp As Long
   hPal As Long
   Reserved As Long
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long

Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 13/10/98
   ' * Time             : 09:18
   ' * Module Name      : Capture_Module
   ' * Module Filename  : Capture.bas
   ' * Procedure Name   : CreateBitmapPicture
   ' * Parameters       :
   ' *                    ByVal hBmp As Long
   ' *                    ByVal hPal As Long
   ' **********************************************************************
   ' * Comments         : Creates a bitmap type Picture object from a bitmap and palette
   ' *  hBmp
   ' * - Handle to a bitmap
   ' *
   ' *  hPal
   ' * - Handle to a Palette
   ' * - Can be null if the bitmap doesn't use a palette
   ' *
   ' *  Returns
   ' * - Returns a Picture object containing the bitmap
   ' *
   ' *
   ' **********************************************************************
   
   Dim r                As Long
   Dim Pic              As PicBmp
   
   ' *** IPicture requires a reference to "Standard OLE Types"
   Dim ipic             As IPicture
   Dim IID_IDispatch    As GUID
   
   ' *** Fill in with IDispatch Interface ID
   With IID_IDispatch
      .Data1 = &H20400
      .Data4(0) = &HC0
      .Data4(7) = &H46
   End With

   ' *** Fill Pic with necessary parts
   With Pic
      .Size = Len(Pic) ' Length of structure
      .nType = vbPicTypeBitmap ' Type of Picture (bitmap)
      .hBmp = hBmp ' Handle to bitmap
      .hPal = hPal ' Handle to palette (may be null)
   End With

   ' *** Create Picture object
   r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, ipic)
   ' *** Return the new Picture object
   Set CreateBitmapPicture = ipic
End Function

Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
   ' *** CaptureWindow
   ' *** - Captures any portion of a window
   ' ***
   ' *** hWndSrc
   ' *** - Handle to the window to be captured
   ' ***
   ' *** Client
   ' - If True CaptureWindow captures from the client area of the window
   ' *** - If False CaptureWindow captures from the entire window
   ' ***
   ' *** LeftSrc, TopSrc, WidthSrc, HeightSrc
   ' *** - Specify the portion of the window to capture
   ' *** - Dimensions need to be specified in pixels
   ' ***
   ' *** Returns
   ' - Returns a Picture object containing a bitmap of the specified
   ' *** portion of the window that was captured
   
   Dim hDCMemory        As Long
   Dim hBmp             As Long
   Dim hBmpPrev         As Long
   Dim r                As Long
   Dim hDCSrc           As Long
   Dim hPal             As Long
   Dim hPalPrev         As Long
   Dim RasterCapsScrn   As Long
   Dim HasPaletteScrn   As Long
   Dim PaletteSizeScrn  As Long

   Dim LogPal As LOGPALETTE
   ' Depending on the value of Client get the proper device context

   If Client Then
      hDCSrc = GetDC(hWndSrc) ' Get device context for client area
   Else
      hDCSrc = GetWindowDC(hWndSrc) ' Get device context for entire window
   End If

   ' *** Create a memory device context for the copy process
   hDCMemory = CreateCompatibleDC(hDCSrc)
   ' *** Create a bitmap and place it in the memory DC
   hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
   hBmpPrev = SelectObject(hDCMemory, hBmp)
   ' *** Get screen properties
   RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster capabilities
   HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette support
   PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of palette
   ' *** If the screen has a palette make a copy and realize it

   If HasPaletteScrn And (PaletteSizeScrn = 256) Then
      ' *** Create a copy of the system palette
      LogPal.PALVERSION = &H300
      LogPal.palNumEntries = 256
      r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
      hPal = CreatePalette(LogPal)
      ' *** Select the new palette into the memory DC and realize it
      hPalPrev = SelectPalette(hDCMemory, hPal, 0)
      r = RealizePalette(hDCMemory)
   End If

   ' *** Copy the on-screen image into the memory DC
   r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, _
         LeftSrc, TopSrc, vbSrcCopy)
   ' *** Remove the new copy of the the on-screen image
   hBmp = SelectObject(hDCMemory, hBmpPrev)
   ' If the screen has a palette get back the palette that was
   '     selected
   ' *** in previously

   If HasPaletteScrn And (PaletteSizeScrn = 256) Then
      hPal = SelectPalette(hDCMemory, hPalPrev, 0)
   End If

   ' *** Release the device context resources back to the system
   r = DeleteDC(hDCMemory)
   r = ReleaseDC(hWndSrc, hDCSrc)
   ' Call CreateBitmapPicture to create a picture object from t
   '     he bitmap
   ' and palette handles. Then return the resulting picture obj
   '     ect.
   Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
   
End Function

Public Function CaptureScreen() As Picture
   ' *** CaptureScreen
   ' *** - Captures the entire screen
   ' ***
   ' *** Returns
   ' - Returns a Picture object containing a bitmap of the screen

   Dim hWndScreen As Long

   ' *** Get a handle to the desktop window
   hWndScreen = GetDesktopWindow()
   ' *** Call CaptureWindow to capture the entire desktop give the handle and
   ' *** return the resulting Picture object
   Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width \ Screen.TwipsPerPixelX, Screen.Height \ Screen.TwipsPerPixelY)

End Function

Public Function CaptureForm(frmSrc As Form) As Picture
   ' *** CaptureForm
   ' *** - Captures an entire form including title bar and border
   ' ***
   ' *** frmSrc
   ' *** - The Form object to capture
   ' *** Returns
   ' - Returns a Picture object containing a bitmap of the enti
   '     re form

   ' Call CaptureWindow to capture the entire form given it's w
   '     indow
   ' *** handle and then return the resulting Picture object
   Set CaptureForm = CaptureWindow(frmSrc.hwnd, False, 0, 0, _
         frmSrc.ScaleX(frmSrc.Width, vbTwips, vbPixels), _
         frmSrc.ScaleY(frmSrc.Height, vbTwips, vbPixels))

End Function

Public Function CaptureClient(frmSrc As Form) As Picture
   ' *** CaptureClient
   ' *** - Captures the client area of a form
   ' ***
   ' *** frmSrc
   ' *** - The Form object to capture
   ' ***
   ' *** Returns
   ' - Returns a Picture object containing a bitmap of the form
   ' *** s client
   ' *** area
   
   ' Call CaptureWindow to capture the client area of the form
   '     given it's
   ' *** window handle and return the resulting Picture object
   Set CaptureClient = CaptureWindow(frmSrc.hwnd, True, 0, 0, _
         frmSrc.ScaleX(frmSrc.ScaleWidth, frmSrc.ScaleMode, vbPixels), _
         frmSrc.ScaleY(frmSrc.ScaleHeight, frmSrc.ScaleMode, vbPixels))

End Function

Public Function CaptureActiveWindow() As Picture
   ' *** CaptureActiveWindow
   ' *** - Captures the currently active window on the screen
   ' ***
   ' *** Returns
   ' - Returns a Picture object containing a bitmap of the active window

   Dim hWndActive    As Long
   Dim r             As Long
   Dim RectActive    As RECT
   
   ' *** Get a handle to the active/foreground window
   hWndActive = GetForegroundWindow()
   ' *** Get the dimensions of the window
   r = GetWindowRect(hWndActive, RectActive)
   ' Call CaptureWindow to capture the active window given it's
   '      handle and
   ' *** return the Resulting Picture object
   Set CaptureActiveWindow = CaptureWindow(hWndActive, False, 0, 0, _
         RectActive.Right - RectActive.Left, _
         RectActive.Bottom - RectActive.Top)

End Function

Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 13/10/98
   ' * Time             : 09:18
   ' * Module Name      : Capture_Module
   ' * Module Filename  : Capture.bas
   ' * Procedure Name   : PrintPictureToFitPage
   ' * Parameters       :
   ' *                    Prn As Printer
   ' *                    Pic As Picture
   ' **********************************************************************
   ' * Comments         : Prints a Picture object as big as possible
   ' *
   ' *
   ' **********************************************************************

   Const vbHiMetric As Integer = 8
   
   Dim PicRatio      As Double
   Dim PrnWidth      As Double
   Dim PrnHeight     As Double
   Dim PrnRatio      As Double
   Dim PrnPicWidth   As Double
   Dim PrnPicHeight  As Double
   
   ' Determine if picture should be printed in landscape or portrait and
   ' *** set the orientation

   If Pic.Height >= Pic.Width Then
      Prn.Orientation = vbPRORPortrait ' Taller than wide
   Else
      Prn.Orientation = vbPRORLandscape ' Wider than tall
   End If

   ' Calculate device independent Width to Height ratio for pic
   '     ture
   PicRatio = Pic.Width / Pic.Height
   ' Calculate the dimentions of the printable area in HiMetric
   '
   PrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric)
   PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric)
   ' Calculate device independent Width to Height ratio for pri
   '     nter
   PrnRatio = PrnWidth / PrnHeight
   ' *** Scale the output to the printable area

   If PicRatio >= PrnRatio Then
      ' *** Scale picture to fit full width of printable area
      PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode)
      PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, Prn.ScaleMode)
   Else
      ' *** Scale picture to fit full height of printable area
      PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode)
      PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, Prn.ScaleMode)
   End If

   ' *** Print the picture using the PaintPicture method
   Prn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeight
   
End Sub

0
 
LVL 4

Author Comment

by:CraigLazar
ID: 1441607
Hi waty
Is there not something a little easier ?
0
 
LVL 14

Expert Comment

by:waty
ID: 1441608
I don't see one. Did you tried this code?

0
 
LVL 4

Author Comment

by:CraigLazar
ID: 1441609
Me again
Waty how do i use this enormuus length of code and were do i start calling the sub routines , if this works i will up my points for you

thanx craig
0
 
LVL 4

Author Comment

by:CraigLazar
ID: 1441610
Hi Waty
I have put into a test project and not to sure were to start
eg : should i put a command button saying print or ?
thanx craig
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 14

Expert Comment

by:waty
ID: 1441611
This is my complete module, sure you could remove unecessary functions.

Private Sub Command1_Click()

   Set Picture1.Picture = CaptureForm(Me)
   
   Printer.PaintPicture Picture1.Picture, 1, 1, Printer.Width, Printer.Height
   Printer.EndDoc

End Sub

0
 
LVL 14

Expert Comment

by:waty
ID: 1441612
I have tested this code, and works perfectly.
0
 
LVL 4

Author Comment

by:CraigLazar
ID: 1441613
Hi waty
I need to print invoices (being the form i want to print) i have not had time to test your sample code (much appreciated) ,is this sufficent to be able to print invoices ?
Craig
0
 
LVL 14

Expert Comment

by:waty
ID: 1441614
Try the previous sample, it will takes you only 2 minutes.

Add a picture on your form (outside of the visible parts),
and add the code to a test button. Click on it.... tath's all.

0
 
LVL 4

Author Comment

by:CraigLazar
ID: 1441615
Waty thanx for your help but i am going to use crystal , to be the layout and tell my client they can print there invoice from inside crystal
thanx anyway
cheers
0
 
LVL 14

Expert Comment

by:waty
ID: 1441616
Ok, I also use Crystal for listings.
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

747 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now