GetTransformWithDpi Method

Imports Leadtools.WinForms
Imports Leadtools
Imports Leadtools.Codecs
Imports Leadtools.ImageProcessing.Color
Imports Leadtools.Drawing

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