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


Code:
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