GetTransformWithDpi Method

'Declaration
 
Public Function GetTransformWithDpi() As Matrix

Friend Class MyForm4 : Inherits Form
      Private _viewer As RasterImageViewer
      ' Are we currently rubber banding
      Private isRubberBanding As Boolean
      ' The current rubberband rectangle
      Private rubberBandingRectangle As Rectangle
      ' Flag to indicates if the rubber band rectangle is drawn
      Private isRubberBandingRectangleDrawn As Boolean
      ' Did we clicp the cursor?
      Private isCursorClipped As Boolean
      Private saveClipRectangle As Rectangle

      Public Sub New(ByVal title As String)
         Text = title
         Size = New Size(750, 450)

         ' Create the raster viewer
         _viewer = New RasterImageViewer()
         _viewer.DoubleBuffer = True
         _viewer.Dock = DockStyle.Fill

         ' Load an image into the viewer
         Dim codecs As RasterCodecs = New RasterCodecs()
         _viewer.Image = codecs.Load(Path.Combine(LEAD_VARS.ImagesDir, "Sample1.cmp"))
         codecs.Dispose()

         Controls.Add(_viewer)
         _viewer.BringToFront()
         StartRubberBanding()
      End Sub

      ' Call this to start rubber banding on the viewer
      Private Sub StartRubberBanding()
         ' Subclass to the event we need
         AddHandler _viewer.MouseDown, AddressOf _viewer_MouseDown
         AddHandler _viewer.MouseMove, AddressOf _viewer_MouseMove
         AddHandler _viewer.MouseUp, AddressOf _viewer_MouseUp
         AddHandler _viewer.LostFocus, AddressOf _viewer_LostFocus
      End Sub

      ' Call this to stop rubber banding on the viewer
      Private Sub StopRubberBanding()
         ' Un-subclass to the events
         RemoveHandler _viewer.MouseDown, AddressOf _viewer_MouseDown
         RemoveHandler _viewer.MouseMove, AddressOf _viewer_MouseMove
         RemoveHandler _viewer.MouseUp, AddressOf _viewer_MouseUp
         RemoveHandler _viewer.LostFocus, AddressOf _viewer_LostFocus

         isRubberBanding = False
         rubberBandingRectangle = Rectangle.Empty
         isRubberBandingRectangleDrawn = False
         isCursorClipped = False
         saveClipRectangle = Rectangle.Empty
      End Sub

      ' Begins the rubber banding operation
      Private Sub BeginRubberBanding(ByVal x As Integer, ByVal y As Integer)
         rubberBandingRectangle = Rectangle.FromLTRB(x, y, x, y)

         isRubberBanding = True
         _viewer.Capture = True

         ' Clip the cursor
         ClipCursor(True)

         DrawRubberBandRectangle()
      End Sub

      ' Ends the rubber banding
      Private Sub EndRubberBanding()
         _viewer.Capture = False
         isRubberBanding = False

         If isRubberBandingRectangleDrawn Then
            DrawRubberBandRectangle()
         End If

         If isCursorClipped Then
            ClipCursor(False)
         End If
      End Sub

      Private Sub ClipCursor(ByVal clip As Boolean)
         If clip Then
            Dim rect As Rectangle = Rectangle.Intersect(FixRectangle(_viewer.PhysicalViewRectangle), _viewer.ClientRectangle)
            rect = _viewer.RectangleToScreen(rect)
            Dim parent As Control = _viewer.Parent
            Do While Not parent Is Nothing
               rect = Rectangle.Intersect(rect, _viewer.Parent.RectangleToScreen(_viewer.Parent.ClientRectangle))
               If TypeOf parent Is Form Then
                  Dim form As Form = TryCast(parent, Form)
                  If form.IsMdiChild Then
                     If Not form.Owner Is Nothing Then
                        rect = Rectangle.Intersect(rect, form.Owner.RectangleToScreen(form.Owner.ClientRectangle))
                     ElseIf Not form.Parent Is Nothing Then
                        rect = Rectangle.Intersect(rect, form.Parent.RectangleToScreen(form.Parent.ClientRectangle))
                     End If
                  End If
               End If

               parent = parent.Parent
            Loop

            rect.Height += 1
            rect.Width += 1

            saveClipRectangle = Cursor.Clip
            Cursor.Clip = rect
            isCursorClipped = True
         Else
            Cursor.Clip = saveClipRectangle
            isCursorClipped = False
            saveClipRectangle = Rectangle.Empty
         End If
      End Sub

      Private Shared Function FixRectangle(ByVal rect As Rectangle) As Rectangle
         If rect.Left > rect.Right Then
            rect = Rectangle.FromLTRB(rect.Right, rect.Top, rect.Left, rect.Bottom)
         End If
         If rect.Top > rect.Bottom Then
            rect = Rectangle.FromLTRB(rect.Left, rect.Bottom, rect.Right, rect.Top)
         End If

         Return rect
      End Function

      ' Draws the rubberband rectangle on the viewer
      Private Sub DrawRubberBandRectangle()
         Dim rect As Rectangle = FixRectangle(rubberBandingRectangle)
         rect.Width += 1
         rect.Height += 1
         rect = _viewer.RectangleToScreen(rect)
         ControlPaint.DrawReversibleFrame(rect, Color.Transparent, FrameStyle.Thick)

         isRubberBandingRectangleDrawn = Not isRubberBandingRectangleDrawn
      End Sub

      Private Sub _viewer_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
         _viewer.Focus()

         ' Cancel rubber banding if it is on
         If isRubberBanding Then
            EndRubberBanding()
         Else
            If _viewer.IsImageAvailable AndAlso e.Button = MouseButtons.Left Then
               ' See if we click is on the image
               Dim rect As Rectangle = _viewer.PhysicalViewRectangle
               If rect.Contains(e.X, e.Y) Then
                  ' Start the rubber banding
                  BeginRubberBanding(e.X, e.Y)
               End If
            End If
         End If
      End Sub

      Private Sub _viewer_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
         If isRubberBanding Then
            DrawRubberBandRectangle()

            rubberBandingRectangle = Rectangle.FromLTRB(rubberBandingRectangle.Left, rubberBandingRectangle.Top, e.X, e.Y)

            DrawRubberBandRectangle()
         End If
      End Sub

      Private Sub _viewer_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
         If isRubberBanding Then
            ' Save the rubberband rectangle
            Dim rect As Rectangle = rubberBandingRectangle

            EndRubberBanding()

            ' First, convert the rectangle to image coordinates

            rect = FixRectangle(rect)

            ' Must be at least 1 pixel in size
            If rect.Width > 1 AndAlso rect.Height > 1 Then
               ' Get the transform matrix
               ' This works even if the UseDpi property of the viewer is set to true
               Using transform As Matrix = _viewer.GetTransformWithDpi()
                  Dim t As Transformer = New Transformer(transform)
                  rect = Rectangle.Round(t.RectangleToLogical(rect))
                  Dim lrect As LeadRect = New LeadRect(rect.Left, rect.Top, rect.Width, rect.Height)

                  ' Add this rectangle as a region
                  ' Note: no conversion or xform is needed
                  _viewer.Image.AddRectangleToRegion(Nothing, lrect, RasterRegionCombineMode.Set)
               End Using
            End If
         End If
      End Sub

      Private Sub _viewer_LostFocus(ByVal sender As Object, ByVal e As EventArgs)
         If isRubberBanding Then
            EndRubberBanding()
         End If
      End Sub
   End Class

Public NotInheritable Class LEAD_VARS
   Public Const ImagesDir As String = "C:\Users\Public\Documents\LEADTOOLS Images"
End Class