Friend Class MyForm4 : Inherits Form
Private _viewer As RasterImageViewer
Private isRubberBanding As Boolean
Private rubberBandingRectangle As Rectangle
Private isRubberBandingRectangleDrawn As Boolean
Private isCursorClipped As Boolean
Private saveClipRectangle As Rectangle
Public Sub New(ByVal title As String)
Text = title
Size = New Size(750, 450)
_viewer = New RasterImageViewer()
_viewer.DoubleBuffer = True
_viewer.Dock = DockStyle.Fill
RasterCodecs.Startup()
Dim codecs As RasterCodecs = New RasterCodecs()
_viewer.Image = codecs.Load(LeadtoolsExamples.Common.ImagesPath.Path + "Sample1.cmp")
codecs.Dispose()
RasterCodecs.Shutdown()
Controls.Add(_viewer)
_viewer.BringToFront()
StartRubberBanding()
End Sub
Private Sub StartRubberBanding()
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
Private Sub StopRubberBanding()
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
Private Sub BeginRubberBanding(ByVal x As Integer, ByVal y As Integer)
rubberBandingRectangle = Rectangle.FromLTRB(x, y, x, y)
isRubberBanding = True
_viewer.Capture = True
ClipCursor(True)
DrawRubberBandRectangle()
End Sub
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
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()
If isRubberBanding Then
EndRubberBanding()
Else
If _viewer.IsImageAvailable AndAlso e.Button = MouseButtons.Left Then
Dim rect As Rectangle = _viewer.PhysicalViewRectangle
If rect.Contains(e.X, e.Y) Then
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
Dim rect As Rectangle = rubberBandingRectangle
EndRubberBanding()
rect = FixRectangle(rect)
If rect.Width > 1 AndAlso rect.Height > 1 Then
Using transform As Matrix = _viewer.GetTransformWithDpi()
Dim t As Transformer = New Transformer(transform)
rect = Rectangle.Round(t.RectangleToLogical(rect))
rect = _viewer.Image.RectangleToImage(RasterViewPerspective.TopLeft, rect)
_viewer.Image.AddRectangleToRegion(Nothing, rect, 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 |