Printing images with GDI+

[Erwin69]

Hi,

I’m hoping that somebody can help me with the following:

My application draws a mix of graphical objects (rectangles/circles) and images on a canvas. I’m using a coordinate system where bottom left is 0,0, and the application calculates the size and location of all objects to ensure all is drawn in the correct scale. Until now I used the PaintPicture method to draw the images, but recently changed this to use GDI+, so that the app can also support png-files.

The change worked well, and everything is drawn perfectly fine as long as the canvas is a Picture Box. However, when I select the printer as the canvas, the images are not scaled properly. I’m probably missing something simple, but can’t figure out what goes wrong.

I have attached the relevant code below, and hope somebody can point me in the right direction.

Thanks in advance!

Erwin

Private Declare Function Polygon Lib "gdi32" (ByVal hDC As Long, lpPoint As PointAPI, ByVal nCount As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, hGraphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiPlus" (ByVal mGraphics As Long) As Long
Private Declare Function GdipDrawImageRectI Lib "gdiPlus" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal X As Long, ByVal Y As Long, ByVal Width As Long, ByVal Height As Long) As Long


'Wrapper around drawing the image that converts the coordinates, and calls the GDI+ function to do the actual drawing
'====================================================================================================================
Sub DrawMyImage(oTarget As Object, sMyImageName As String, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, X3 As Long, Y3 As Long, X4 As Long, Y4 As Long)
    
    Dim dTwipsPerPixelX As Double
    Dim dTwipsPerPixelY As Double
    
    'Calculate Y-coordinates to use bottom as 0,0  /  Also: GDI+ uses pixels, so we need to recalc from twips

    dTwipsPerPixelX = 1440 / GetDeviceCaps(oTarget.hDC, 88)
    dTwipsPerPixelY = 1440 / GetDeviceCaps(oTarget.hDC, 90)
        
    X1 = CLng(X1 / dTwipsPerPixelX)
    X2 = CLng(X2 / dTwipsPerPixelX)
    X3 = CLng(X3 / dTwipsPerPixelX)
    X4 = CLng(X4 / dTwipsPerPixelX)
    Y1 = CLng((g_lCanvasHeight - Y1) / dTwipsPerPixelY)
    Y2 = CLng((g_lCanvasHeight - Y2) / dTwipsPerPixelY)
    Y3 = CLng((g_lCanvasHeight - Y3) / dTwipsPerPixelY)
    Y4 = CLng((g_lCanvasHeight - Y4) / dTwipsPerPixelY)
    
    'Draw the image
    Call GDIPlusWrapper.DrawImagePos(oTarget.hDC, frmMain.m_oMyImageCol.Item(sMyImageName).MyImage, X1, Y3, (X4 - X1), (Y1 - Y2))
End Sub



'GDI+ image drawing located in GDIPlusWrapper module, called from DrawMyImage
'============================================================================
Public Sub DrawImagePos(ByVal hDC As Long, ByVal hImage As Long, ByVal destX As Long, ByVal destY As Long, ByVal destWidth As Long, ByVal destHeight As Long)
    Dim hGraphics As Long
    Dim Status As Long
                                    
    GdipCreateFromHDC hDC, hGraphics
                    
    Status = GdipDrawImageRectI(hGraphics, hImage, destX, destY, destWidth, destHeight)
            
    GdipDeleteGraphics hGraphics
End Sub



'Function to draw a rectangle, uses GDI
'======================================
Public Sub DrawRectangle(ByVal oTarget As Object, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long, ByVal lFillColor As Long, ByVal blnFillSolid As Boolean, Optional ByVal iLineThickness As Integer, Optional ByVal blnWhiteOutlineWhenBlack As Boolean, Optional blnWhiteBackground As Boolean)
    
    Dim xyPolygonPoints(1 To 4) As PointAPI
    
    With oTarget
        If (oTarget.hDC = frmMain.picPlanogram.hDC) Or (oTarget.hDC = frmPrintPreview.picPrintPreview.hDC) Or (oTarget.hDC = frmCreatePowerPointPresentation.picFullPlanogram.hDC) Then
            'Calculate coordinates in the correct measure for the screen
            X1 = X1 / Screen.TwipsPerPixelX
            X2 = X2 / Screen.TwipsPerPixelX
            X3 = X3 / Screen.TwipsPerPixelX
            X4 = X4 / Screen.TwipsPerPixelX
            Y1 = (g_lCanvasHeight - Y1) / Screen.TwipsPerPixelY
            Y2 = (g_lCanvasHeight - Y2) / Screen.TwipsPerPixelY
            Y3 = (g_lCanvasHeight - Y3) / Screen.TwipsPerPixelY
            Y4 = (g_lCanvasHeight - Y4) / Screen.TwipsPerPixelY
        Else
            'Calculate coordinates in the correct measure for the printer
            X1 = X1 / .TwipsPerPixelX
            X2 = X2 / .TwipsPerPixelX
            X3 = X3 / .TwipsPerPixelX
            X4 = X4 / .TwipsPerPixelX
            Y1 = (g_lCanvasHeight - Y1) / .TwipsPerPixelY
            Y2 = (g_lCanvasHeight - Y2) / .TwipsPerPixelY
            Y3 = (g_lCanvasHeight - Y3) / .TwipsPerPixelY
            Y4 = (g_lCanvasHeight - Y4) / .TwipsPerPixelY
        End If
        'Set color & fill
        If blnFillSolid = True Then
            If (blnWhiteOutlineWhenBlack = True) And (lFillColor = vbBlack) Then
                .ForeColor = vbWhite
            Else
                .ForeColor = vbBlack
            End If
            .FillColor = lFillColor
            .FillStyle = vbFSSolid
            .DrawStyle = vbSolid
        Else
            If blnWhiteBackground = True Then
                .ForeColor = lFillColor
                .FillColor = vbWhite
                .FillStyle = vbFSSolid
                .DrawStyle = vbSolid
            Else
                .ForeColor = lFillColor
                .FillStyle = vbFSTransparent
                .DrawStyle = vbSolid
            End If
        End If
        'Set linethickness
        If iLineThickness > 0 Then
            .DrawWidth = iLineThickness
        Else
            .DrawWidth = 1
        End If
        
        'Set the polygon points
        xyPolygonPoints(1).X = X1
        xyPolygonPoints(1).Y = Y1
        xyPolygonPoints(2).X = X2
        xyPolygonPoints(2).Y = Y2
        xyPolygonPoints(3).X = X3
        xyPolygonPoints(3).Y = Y3
        xyPolygonPoints(4).X = X4
        xyPolygonPoints(4).Y = Y4
        
        'Draw the Polygon
        Call Polygon(.hDC, xyPolygonPoints(1), 4)
            
    End With

End Sub

[Niya]

Can you post the code that does the printing. I am assuming you're rendering to a DC to print as well. If so, show the code that gets the DC as well.

[Erwin69]

Hi Niya,

Simplified it is this:

   Printer.Print " "
   Call DrawMyImage(Printer, sMyImageName, lDrawX1, lDrawY1, lDrawX2, lDrawY2, lDrawX3, lDrawY3, lDrawX4, lDrawY4)
   Printer.EndDoc

(Obviously the DrawMyImage routine is nested in a For-Next loop in the real code to process all the objects. Also the other parameters are assigned the values for the specific object.)

The wrapper function passes the object on which should be drawn, i.e. picMyPictureBox or Printer. The wrapper function passes the selected object's hDC on to the GDI+ function.

Hope this was what you were looking for.

Regards,
Erwin

[LaVolpe]

When you say image is not scaled properly? How far off is it? You may have to set the printer's scalemode to pixels? Or scale the image to printer's scalemode?

If neither the above work, look at these GDI+ functions: GdipSetPageScale & GdipSetPageUnit

[georgekar]

Maybe dpix and dpiy isn't same...
In screen we have square pixels, but in printer this isn't right, we have non square pixels. So we have to make a dc with square pixels with the number of pixels as the total pixels in height and width printer has. But our dc (now with square pixels) must draw a circle like an ellipse, using the ratio as dpix/dpiy. So any Y distance must treated as y*ratio. So we print using ratio in Y in a dc with square pixels and then that we stretchblit to the printer dc. using 1/ratio, so the printer take that and expand it to ratio/1........
that's all...

(the best is to draw to the printer dc only...using the ratio and to not convert 2 times)

[georgekar]

http://www.vbforums.com/showthread.p...light=scrollio
You can find cDib class to use it. This class has special printer functions that uses the dpiX<>dpiY situation..

To understand what you have to do...just see the routine that prints photos to printer...
A myDM() has all the properties of the printer that we want to use (all properties that we can alter in the printer driver).

Public Sub ThumbnailPaintPrinter(copiesNUM As Long, Optional ByVal zf As Single = -1, Optional ByVal FitToPic As Boolean = True, Optional CROP As Boolean = False, Optional over As Boolean = False, Optional ByVal fr As Long = 0, Optional ByVal offsetx As Long = 0, Optional ByVal offsety As Long, Optional ByVal border As Long = 0, Optional ByVal rtxy As Double = 1#, Optional pname As String = "")
   Dim oldSc As Long, dummy1 As Boolean, dummy2 As Boolean, sw As Long, sh As Long
   Dim swProbe As Long, shProbe As Long, osh As Double
   Dim myleft As Long, mytop As Long, mywidth As Long, myheight As Long
   Dim lox As Long, loy As Long
   
     Dim a As Single
   '  Exit Sub

   CopiesCount copiesNUM, MyDM()
   MakePrinterhDC Printer, pname
   needPrinterHDC Printer
     If over Then
   swProbe = GetDeviceCaps(p_hdc, PHYSICALWIDTH) 'DestPic.ScaleX(DestPic.width, 1, 3)
   shProbe = GetDeviceCaps(p_hdc, PHYSICALHEIGHT) ' DestPic.ScaleY(DestPic.height, 1, 3)
   Else
   swProbe = GetDeviceCaps(p_hdc, HORZRES) 'sw
   shProbe = GetDeviceCaps(p_hdc, VERTRES) ' sh
   End If
    sw = GetDeviceCaps(p_hdc, HORZRES)
   sh = GetDeviceCaps(p_hdc, VERTRES)
      lox = GetDeviceCaps(p_hdc, LOGPIXELSX)
   loy = GetDeviceCaps(p_hdc, LOGPIXELSY)
If lox > loy Then
m_logy = 1
m_logx = loy / lox
ElseIf loy > lox Then
m_logy = lox / loy
m_logx = 1
End If
swProbe = swProbe * m_logx
shProbe = shProbe * m_logy
sw = sw * m_logx
sh = sh * m_logy
   Dim osw As Long
 If rtxy = 0 Then rtxy = 1
   If sw < sh Then
    'osw = offsetx: offsetx = -offsety:
    'offsety = -osw
    rtxy = 1 / rtxy
   End If
    ' offsety = 0
  
  ' End If
   
    If zf <= 0 Then
        If Not FitToPic Then
            StretchPicture p_hdc, (sw - width) / 2 + offsetx, ((sh - height) / 2 + offsety), , , , , , , , rtxy
        Else
            If CROP Then
                   
                    sh = sh - 2 * fr
                    sw = sw - 2 * fr
                    If shProbe < swProbe Then
                    osh = shProbe / sh
                        shProbe = CLng(sw * shProbe / swProbe) - border * 2 / osh
                        swProbe = sw - border * 2 * osh
                   Else
                   osh = swProbe / sw
            
                        swProbe = CLng(sh * swProbe / shProbe) - 2 * border / osh
                        shProbe = sh - 2 * border * osh
                   End If
       
                 If (swProbe / width) > (shProbe / height) Then
                    zf = width / swProbe
                    If swProbe > shProbe Then
                        StretchPicture p_hdc, CLng(fr) + offsetx + CLng(border * osh), CLng((sh - sw * shProbe / swProbe) / 2 + fr) + offsety + border, sw - border * 2, CLng(sw * shProbe / swProbe) - border * 2, 0, CLng((height - shProbe * zf)) / 2, width, CLng(shProbe * zf), , rtxy
                    Else
                        StretchPicture p_hdc, CLng(fr) + CLng((sw - sh * swProbe / shProbe) / 2) + offsetx + CLng(border / osh), CLng(fr) + offsety + border, CLng(sh * swProbe / shProbe) - 2 * border, sh - 2 * border, 0, CLng((height - shProbe * zf)) / 2, width, CLng(shProbe * zf), , rtxy
                    End If
                Else
                    zf = height / shProbe
                    If swProbe > shProbe Then
                     StretchPicture p_hdc, CLng(fr) + offsetx + CLng(border * osh), CLng((sh - sw * shProbe / swProbe) / 2 + fr) + offsety + border, sw - border * 2, CLng(sw * shProbe / swProbe) - border * 2, (width - swProbe * zf) / 2, 0, CLng(swProbe * zf), height, , rtxy
                    Else
                     StretchPicture p_hdc, CLng(fr) + CLng((sw - sh * swProbe / shProbe) / 2) + offsetx + border, CLng(fr) + offsety + CLng(border * osh), CLng(sh * swProbe / shProbe) - 2 * border, sh - 2 * border, (width - swProbe * zf) / 2, 0, CLng(swProbe * zf), height, , rtxy
                 End If
                  End If
             Else
                If (swProbe / width) < (shProbe / height) Then
                    zf = sw / width
                Else
                    zf = sh / height
                End If
                StretchPicture p_hdc, (sw - width * zf) / 2 + offsetx, (sh - height * zf) / 2 + offsety, CLng(width * zf), CLng(height * zf), , , , , , rtxy
            End If
        End If
    Else
        zf = zf / 100#
        If Not FitToPic Then
            StretchPicture p_hdc, Abs((sw - width * zf) / 2), Abs((sh - height * zf) / 2), width * zf, height * zf, , , , , , rtxy
        Else
            If sw / width < sh / height Then
                zf = zf * sw / width
            Else
                zf = zf * sh / height
            End If
                StretchPicture p_hdc, (sw - width * zf) / 2, (sh - height * zf) / 2, width * zf, height * zf, , , , , , rtxy
        End If
    End If
    FreePrinterHdc
    CopiesCount (1), MyDM()
    last_zf = zf
    m_logx = 1: m_logy = 1
End Sub

[Erwin69]

I still owe you guys feedback, but it has been a bit hectic...

Further testing is required, but based on initial testing I'd say that the GdipSetPageUnit function was the one that solved the problem. A big thanks to LaVolpe to point me in that direction!!!

[LaVolpe]

Please do follow up. I'm sure others will happen across your thread for related problems. When you do update/follow up, if you've tested images that have embedded DPI (usually JPGs and often enough: PNG) did those cause you any additional heartburn & if so, how did you get past those issues?

[Erwin69]

Yep, I'll do, but it may take a bit of time. I'm running a small, yet international company, with loads of things going on, so it's not always possible to focus on one thing at the time. Mostly it's juggling a number of balls at the same time, and at this point it's getting close to too many balls...