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