Perspective Correction Code Sample

'Epsilon neighbourhood of the anchor points. If you click near the
'anchor point, if the distance is less than Epsilon, you will drag
'this anchor point.
Const Epsilon = 7

'This Graphics is necessary to display anchor points
Private objGraphics As Graphics

'Index of currently selected anchor point
Dim lngCurPoint As Long

'X and Y of points in source bitmap
Dim arrSrcPointX(4) As Long
Dim arrSrcPointY(4) As Long

Private Sub Form_Load()
    'Create graphics to draw on the control
    Set objGraphics = New Graphics
    'objGraphics.Engine = DrawingEngineGdiplus
     
    lngCurPoint = 0
End Sub

Private Sub Form_Resize()
    'Resize BitmapViewer control on form resize
    BitmapViewerSource.Height = Me.ScaleHeight - 48
    BitmapViewerTarget.Height = BitmapViewerSource.Height
    BitmapViewerSource.Width = Me.ScaleWidth \ 2 - 12
    BitmapViewerTarget.Width = BitmapViewerSource.Width
    BitmapViewerTarget.Left = Me.ScaleWidth \ 2 + 4
End Sub

Private Sub CommandLoad_Click()
    'Load image from file
    If FileDialog1.ShowOpen Then
        On Error Resume Next
        BitmapViewerSource.Bitmap.LoadFromFile FileDialog1.FileName
        If Err.Number <> 0 Then
            MsgBox "Error arrised during loading image."
            Exit Sub
        End If
        
        'We need to convert to Format24bppRgb to ensure that
        'Graphics will be able to draw on the bitmap. Currently
        'Graphics (both GDI and GDI+) can work on Format24bppRgb,
        'Format32bppRgb, Format32bppArgb, Format32bppPArgb
        'pixel formats
        BitmapViewerSource.Bitmap.Data.ConvertTo24bppRgb True
    
        'Init source points
        arrSrcPointX(1) = 30
        arrSrcPointY(1) = 30
        arrSrcPointX(2) = BitmapViewerSource.Bitmap.Data.Width - 30
        arrSrcPointY(2) = 30
        arrSrcPointX(3) = BitmapViewerSource.Bitmap.Data.Width - 30
        arrSrcPointY(3) = BitmapViewerSource.Bitmap.Data.Height - 30
        arrSrcPointX(4) = 30
        arrSrcPointY(4) = BitmapViewerSource.Bitmap.Data.Height - 30
    End If
End Sub

Private Sub CommandDewrap_Click()
    
    'Destination points
    Dim arrDestPointX(4) As Long
    Dim arrDestPointY(4) As Long
    
    'Calculate destination points. We need to get a rectangle.
    'To get destination rectangle, we construct four lines
    'through the centers of each edge of source quadrangle,
    'perpendicular to X and Y axis. Concurrence of these lines
    'are the target points.
    arrDestPointY(1) = (arrSrcPointY(1) + arrSrcPointY(2)) \ 2
    arrDestPointY(2) = arrDestPointY(1)
    arrDestPointY(3) = (arrSrcPointY(3) + arrSrcPointY(4)) \ 2
    arrDestPointY(4) = arrDestPointY(3)

    arrDestPointX(1) = (arrSrcPointX(1) + arrSrcPointX(4)) \ 2
    arrDestPointX(4) = arrDestPointX(1)
    arrDestPointX(2) = (arrSrcPointX(2) + arrSrcPointX(3)) \ 2
    arrDestPointX(3) = arrDestPointX(2)

    'Apply projective transform and store the result to the
    'second BitmapViewer.
    BitmapViewerSource.Bitmap.ApplyInPlace = False
    On Error Resume Next
    Set BitmapViewerTarget.Bitmap = BitmapViewerSource.Bitmap.Transforms.ProjectivePoints( _
        arrDestPointX(1), arrDestPointY(1), _
        arrDestPointX(2), arrDestPointY(2), _
        arrDestPointX(3), arrDestPointY(3), _
        arrDestPointX(4), arrDestPointY(4), _
        arrSrcPointX(1), arrSrcPointY(1), _
        arrSrcPointX(2), arrSrcPointY(2), _
        arrSrcPointX(3), arrSrcPointY(3), _
        arrSrcPointX(4), arrSrcPointY(4))
    If Err.Number <> 0 Then
        MsgBox "Can't transform image."
    End If
    BitmapViewerSource.Bitmap.ApplyInPlace = True
End Sub


Private Sub BitmapViewerSource_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    Dim I As Long
    Dim lngX As Long, lngY As Long
    For I = 1 To 4
        lngX = BitmapViewerSource.BitmapToControlXCoord(arrSrcPointX(I))
        lngY = BitmapViewerSource.BitmapToControlYCoord(arrSrcPointY(I))
        If Abs(x - lngX) <= Epsilon And Abs(y - lngY) < Epsilon Then
            lngCurPoint = I
            arrSrcPointX(lngCurPoint) = BitmapViewerSource.ControlToBitmapXCoord(x)
            arrSrcPointY(lngCurPoint) = BitmapViewerSource.ControlToBitmapYCoord(y)
            'FastRefresh method will fire DoubleBufferPaint event. Here we can
            'redraw the shape
            BitmapViewerSource.FastRefresh
        End If
    Next
End Sub

Private Sub BitmapViewerSource_MouseMove(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    If lngCurPoint <> 0 Then
        arrSrcPointX(lngCurPoint) = BitmapViewerSource.ControlToBitmapXCoord(x)
        arrSrcPointY(lngCurPoint) = BitmapViewerSource.ControlToBitmapYCoord(y)
        'FastRefresh method will fire DoubleBufferPaint event. Here we can
        'redraw the shape
        BitmapViewerSource.FastRefresh
    End If
End Sub

Private Sub BitmapViewerSource_MouseUp(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    lngCurPoint = 0
End Sub

Private Sub BitmapViewerSource_DoubleBufferPaint(ByVal Hdc As stdole.OLE_HANDLE)
    If BitmapViewerSource.Bitmap.IsLoaded Then
        'Attach Graphics to the temporary DC (control's double buffer)
        objGraphics.Hdc = Hdc
        'Adjust pen and brush
        objGraphics.Pen.ForeColor = &HFFFF0000
        'Scale pen weight proportionally to zoom
        objGraphics.Pen.Weight = 2
                        
        'Recalculate anchor points from bitmap coordinates to the control ones
        Dim I As Long
        Dim arrControlPointX(4) As Long
        Dim arrControlPointY(4) As Long
        For I = 1 To 4
            arrControlPointX(I) = BitmapViewerSource.BitmapToControlXCoord(arrSrcPointX(I))
            arrControlPointY(I) = BitmapViewerSource.BitmapToControlYCoord(arrSrcPointY(I))
        Next
                
        'Draw fitting quadrangle
        objGraphics.DrawLine arrControlPointX(1), arrControlPointY(1), _
            arrControlPointX(2), arrControlPointY(2)
        objGraphics.DrawLine arrControlPointX(2), arrControlPointY(2), _
            arrControlPointX(3), arrControlPointY(3)
        objGraphics.DrawLine arrControlPointX(3), arrControlPointY(3), _
            arrControlPointX(4), arrControlPointY(4)
        objGraphics.DrawLine arrControlPointX(4), arrControlPointY(4), _
            arrControlPointX(1), arrControlPointY(1)

        'Draw anchor points
        For I = 1 To 4
            objGraphics.DrawRectangle arrControlPointX(I) - 3, arrControlPointY(I) - 3, 7, 7
        Next
    End If
End Sub