?
Solved

Points for Sethi

Posted on 2003-03-23
3
Medium Priority
?
135 Views
Last Modified: 2010-04-07
1)Printing Options and Printing without Printform:  I have to print the graphs I have created along with a textbox summarizing the peaks.  I have created a form that is the preview I want to print.  Next I:

dim obj as printer
'change options
obj.orientation=2
obj.print quality=-3
obj. ETC, ETC, ETC

Set obj as printer
printform

Obviously, this is wrong...I need a simple working source code.
Thank for help,

RDXBrewer
0
Comment
Question by:RDXBrewer
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 18

Accepted Solution

by:
Sethi earned 1000 total points
ID: 8192318
Declare the following code in Standard Module:

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Declaration Of API's and Functions related to printing of MSChart
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '--- Declarations Related to Printing of MSChart
    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
    #If Win32 Then
       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
          Type 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
    #ElseIf Win16 Then
       Private Const RASTERCAPS As Integer = 38
       Private Const RC_PALETTE As Integer = &H100
       Private Const SIZEPALETTE As Integer = 104
       Private Type RECT
          Left As Integer
          Top As Integer
          Right As Integer
          Bottom As Integer
       End Type
       Private Declare Function CreateCompatibleDC Lib "GDI" ( _
          ByVal hDC As Integer) As Integer
       Private Declare Function CreateCompatibleBitmap Lib "GDI" ( _
          ByVal hDC As Integer, ByVal nWidth As Integer, _
          ByVal nHeight As Integer) As Integer
       Private Declare Function GetDeviceCaps Lib "GDI" ( _
          ByVal hDC As Integer, ByVal iCapabilitiy As Integer) As Integer
       Private Declare Function GetSystemPaletteEntries Lib "GDI" ( _
          ByVal hDC As Integer, ByVal wStartIndex As Integer, _
          ByVal wNumEntries As Integer, _
          lpPaletteEntries As PALETTEENTRY) As Integer
       Private Declare Function CreatePalette Lib "GDI" ( _
          lpLogPalette As LOGPALETTE) As Integer
       Private Declare Function SelectObject Lib "GDI" ( _
          ByVal hDC As Integer, ByVal hObject As Integer) As Integer
       Private Declare Function BitBlt Lib "GDI" ( _
          ByVal hDCDest As Integer, ByVal XDest As Integer, _
          ByVal YDest As Integer, ByVal nWidth As Integer, _
          ByVal nHeight As Integer, ByVal hDCSrc As Integer, _
          ByVal XSrc As Integer, ByVal YSrc As Integer, _
          ByVal dwRop As Long) As Integer
       Private Declare Function DeleteDC Lib "GDI" ( _
          ByVal hDC As Integer) As Integer
       Private Declare Function GetForegroundWindow Lib "USER" _
          Alias "GetActiveWindow" () As Integer
       Private Declare Function SelectPalette Lib "USER" ( _
          ByVal hDC As Integer, ByVal hPalette As Integer, ByVal _
          bForceBackground As Integer) As Integer
       Private Declare Function RealizePalette Lib "USER" ( _
          ByVal hDC As Integer) As Integer
       Private Declare Function GetWindowDC Lib "USER" ( _
          ByVal hwnd As Integer) As Integer
       Private Declare Function GetDC Lib "USER" ( _
          ByVal hwnd As Integer) As Integer
       Private Declare Function GetWindowRect Lib "USER" ( _
          ByVal hwnd As Integer, lpRect As RECT) As Integer
       Private Declare Function ReleaseDC Lib "USER" ( _
          ByVal hwnd As Integer, ByVal hDC As Integer) As Integer
       Private Declare Function GetDesktopWindow Lib "USER" () As Integer
       Private Type PicBmp
          Size As Integer
          Type As Integer
          hBmp As Integer
          hPal As Integer
          Reserved As Integer
       End Type
       Private Declare Function OleCreatePictureIndirect _
          Lib "oc25.dll" (PictDesc As PicBmp, RefIID As GUID, _
          ByVal fPictureOwnsHandle As Integer, IPic As IPicture) _
          As Integer
    #End If

    #If Win32 Then
         Public Function CreateBitmapPicture(ByVal hBmp As Long, _
            ByVal hPal As Long) As Picture
            Dim r As Long
      #ElseIf Win16 Then
         Public Function CreateBitmapPicture(ByVal hBmp As Integer, _
            ByVal hPal As Integer) As Picture
            Dim r As Integer
      #End If
         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.
            .Type = 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
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      '--- CaptureWindow: This API will capture the form or any portion of the form whose specifictaions are
      '--- passed as arguments into this function.
      '
      ' 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.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      #If Win32 Then
         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
            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
      #ElseIf Win16 Then
         Public Function CaptureWindow(ByVal hWndSrc As Integer, _
            ByVal Client As Boolean, ByVal LeftSrc As Integer, _
            ByVal TopSrc As Integer, ByVal WidthSrc As Long, _
            ByVal HeightSrc As Long) As Picture
            Dim hDCMemory As Integer
            Dim hBmp As Integer
            Dim hBmpPrev As Integer
            Dim r As Integer
            Dim hDCSrc As Integer
            Dim hPal As Integer
            Dim hPalPrev As Integer
            Dim RasterCapsScrn As Integer
            Dim HasPaletteScrn As Integer
            Dim PaletteSizeScrn As Integer
      #End If
         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  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 the
         ' bitmap and palette handles. Then return the resulting picture
         ' object.
         Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
      End Function
      ' PrintPictureToFitPage
      '    - Prints a Picture object as big as possible.
      '
      ' Prn
      '    - Destination Printer object.
      '
      ' Pic
      '    - Source Picture object.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture)
         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 picture.
         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 printer.
         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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Declaration Of API's and Functions related to printing of MSChart
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



Create a Picturebox on the form where you are displaying your Chart. You can create a very small invisible Picturebox control so that it is not visible at runtime. Then add the following code:

Picture1.AutoSize = True
                Set Picture1.Picture = CaptureWindow(Me.hwnd, True, 0, 40, _
                Me.ScaleX(Me.ScaleWidth, Me.ScaleMode, vbPixels), _
                Me.ScaleY(7132, Me.ScaleMode, vbPixels))
                PrintPictureToFitPage Printer, Picture1.Picture
                Printer.EndDoc
                Set Picture1.Picture = Nothing

Done ;-)
0
 

Author Comment

by:RDXBrewer
ID: 8204099
Wow!!!

There is an awful lot of code here especially in declarations.  Is all of this required or is it a general code?

Thank you...You have made my week....I really appreciate the effort.

Enjoy the points.....

Thanks,
Rob
0
 
LVL 18

Expert Comment

by:Sethi
ID: 8209151
Anytime ;-)
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

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

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
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…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses
Course of the Month14 days, 7 hours left to enroll

770 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