1 #Region "Microsoft.VisualBasic::c91a34f87a4b39b7f5618ef47eb3f0be, Microsoft.VisualBasic.Core\Extensions\Image\GDI+\Layouts\DblRect.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Class DblRect
35     
36     '         Properties: CenterX, CenterY, Height, Rectangle, Width
37     
38     '         Constructor: (+6 OverloadsSub New
39     
40     '         Function: Clone, contains, Equals, intersection, intersectLine
41     '                   ToString
42     
43     '         Sub: add, grow, setRect
44     
45     
46     ' /********************************************************************************/
47
48 #End Region
49
50 Imports System.Drawing
51 Imports sys = System.Math
52
53 ' $Id: mxRectangle.java,v 1.1 2012/11/15 13:26:39 gaudenz Exp $
54 ' Copyright (c) 2007-2010, Gaudenz Alder, David Benson
55
56 Namespace Imaging.LayoutModel
57
58
59     ''' <summary>
60     ''' Implements a 2-dimensional rectangle with double precision coordinates.
61     ''' </summary>
62     Public Class DblRect : Inherits mxPoint
63
64         ''' <summary>
65         ''' Constructs a new rectangle at (0, 0) with the width and height set to 0.
66         ''' </summary>
67         Public Sub New()
68             Me.New(0, 0, 0, 0)
69         End Sub
70
71         ''' <summary>
72         ''' Constructs a copy of the given rectangle.
73         ''' </summary>
74         ''' <param name="rect"> Rectangle to construct a copy of. </param>
75         Public Sub New(ByVal rect As Rectangle)
76             Me.New(rect.X, rect.Y, rect.Width, rect.Height)
77         End Sub
78
79         ''' <summary>
80         ''' Constructs a copy of the given rectangle.
81         ''' </summary>
82         ''' <param name="rect"> Rectangle to construct a copy of. </param>
83         Public Sub New(ByVal rect As RectangleF)
84             Me.New(rect.X, rect.Y, rect.Width, rect.Height)
85         End Sub
86
87         ''' <summary>
88         ''' Constructs a copy of the given rectangle.
89         ''' </summary>
90         ''' <param name="rect"> Rectangle to construct a copy of. </param>
91         Public Sub New(ByVal rect As DblRect)
92             Me.New(rect.X, rect.Y, rect.Width, rect.Height)
93         End Sub
94
95         ''' <summary>
96         ''' Constructs a rectangle using the given parameters.
97         ''' </summary>
98         ''' <param name="x"> X-coordinate of the new rectangle. </param>
99         ''' <param name="y"> Y-coordinate of the new rectangle. </param>
100         ''' <param name="width"> Width of the new rectangle. </param>
101         ''' <param name="height"> Height of the new rectangle. </param>
102         Public Sub New(ByVal x As Double, ByVal y As Double, ByVal width As Double, ByVal height As Double)
103             MyBase.New(x, y)
104
105             width = width
106             height = height
107         End Sub
108
109         Sub New(width%, height%)
110             Call Me.New(0, 0, width, height)
111         End Sub
112
113         ''' <summary>
114         ''' Returns the width of the rectangle.
115         ''' </summary>
116         ''' <returns> Returns the width. </returns>
117         Public Overridable Property Width As Double
118
119         ''' <summary>
120         ''' Returns the height of the rectangle.
121         ''' </summary>
122         ''' <returns> Returns the height. </returns>
123         Public Overridable Property Height As Double
124
125         ''' <summary>
126         ''' Sets this rectangle to the specified values
127         ''' </summary>
128         ''' <param name="x"> the new x-axis position </param>
129         ''' <param name="y"> the new y-axis position </param>
130         ''' <param name="w"> the new width of the rectangle </param>
131         ''' <param name="h"> the new height of the rectangle </param>
132         Public Overridable Sub setRect(ByVal x As Double, ByVal y As Double, ByVal w As Double, ByVal h As Double)
133             Me.X = x
134             Me.Y = y
135             Me.Width = w
136             Me.Height = h
137         End Sub
138
139         ''' <summary>
140         ''' Adds the given rectangle to this rectangle.
141         ''' </summary>
142         Public Overridable Sub add(ByVal rect As DblRect)
143             If rect IsNot Nothing Then
144                 Dim minX As Double = sys.Min(X, rect.X)
145                 Dim minY As Double = sys.Min(Y, rect.Y)
146                 Dim maxX As Double = sys.Max(X + Width, rect.X + rect.Width)
147                 Dim maxY As Double = sys.Max(Y + Height, rect.Y + rect.Height)
148
149                 X = minX
150                 Y = minY
151                 Width = maxX - minX
152                 Height = maxY - minY
153             End If
154         End Sub
155
156         ''' <summary>
157         ''' Returns the x-coordinate of the center.
158         ''' </summary>
159         ''' <returns> Returns the x-coordinate of the center. </returns>
160         Public Overridable ReadOnly Property CenterX As Double
161             Get
162                 Return X + Width / 2
163             End Get
164         End Property
165
166         ''' <summary>
167         ''' Returns the y-coordinate of the center.
168         ''' </summary>
169         ''' <returns> Returns the y-coordinate of the center. </returns>
170         Public Overridable ReadOnly Property CenterY As Double
171             Get
172                 Return Y + Height / 2
173             End Get
174         End Property
175
176         ''' <summary>
177         ''' Grows the rectangle by the given amount, that is, this method subtracts
178         ''' the given amount from the x- and y-coordinates and adds twice the amount
179         ''' to the width and height.
180         ''' </summary>
181         ''' <param name="amount"> Amount by which the rectangle should be grown. </param>
182         Public Overridable Sub grow(ByVal amount As Double)
183             X -= amount
184             Y -= amount
185             Width += 2 * amount
186             Height += 2 * amount
187         End Sub
188
189         ''' <summary>
190         ''' Returns true if the given point is contained in the rectangle.
191         ''' </summary>
192         ''' <param name="x"> X-coordinate of the point. </param>
193         ''' <param name="y"> Y-coordinate of the point. </param>
194         ''' <returns> Returns true if the point is contained in the rectangle. </returns>
195         Public Overridable Function contains(ByVal x As Double, ByVal y As DoubleAs Boolean
196             Return (Me.X <= x AndAlso Me.X + Width >= x AndAlso Me.Y <= y AndAlso Me.Y + Height >= y)
197         End Function
198
199         ''' <summary>
200         ''' Returns the point at which the specified point intersects the perimeter 
201         ''' of this rectangle or null if there is no intersection.
202         ''' </summary>
203         ''' <param name="x0"> the x co-ordinate of the first point of the line </param>
204         ''' <param name="y0"> the y co-ordinate of the first point of the line </param>
205         ''' <param name="x1"> the x co-ordinate of the second point of the line </param>
206         ''' <param name="y1"> the y co-ordinate of the second point of the line </param>
207         ''' <returns> the point at which the line intersects this rectangle, or null
208         '''  if there is no intersection </returns>
209         Public Overridable Function intersectLine(ByVal x0 As Double, ByVal y0 As Double, ByVal x1 As Double, ByVal y1 As DoubleAs mxPoint
210             Dim result As mxPoint = Nothing
211
212             result = intersection(X, Y, X + Width, Y, x0, y0, x1, y1)
213
214             If result Is Nothing Then result = intersection(X + Width, Y, X + Width, Y + Height, x0, y0, x1, y1)
215
216             If result Is Nothing Then result = intersection(X + Width, Y + Height, X, Y + Height, x0, y0, x1, y1)
217
218             If result Is Nothing Then result = intersection(X, Y, X, Y + Height, x0, y0, x1, y1)
219
220             Return result
221         End Function
222
223         ''' <summary>
224         ''' Returns the intersection of two lines as an mxPoint.
225         ''' </summary>
226         ''' <param name="x0">
227         '''            X-coordinate of the first line's startpoint. </param>
228         ''' <param name="y0">
229         '''            Y-coordinate of the first line's startpoint. </param>
230         ''' <param name="x1">
231         '''            X-coordinate of the first line's endpoint. </param>
232         ''' <param name="y1">
233         '''            Y-coordinate of the first line's endpoint. </param>
234         ''' <param name="x2">
235         '''            X-coordinate of the second line's startpoint. </param>
236         ''' <param name="y2">
237         '''            Y-coordinate of the second line's startpoint. </param>
238         ''' <param name="x3">
239         '''            X-coordinate of the second line's endpoint. </param>
240         ''' <param name="y3">
241         '''            Y-coordinate of the second line's endpoint. </param>
242         ''' <returns> Returns the intersection between the two lines. </returns>
243         Public Shared Function intersection(ByVal x0 As Double, ByVal y0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal x3 As Double, ByVal y3 As DoubleAs mxPoint
244             Dim denom As Double = ((y3 - y2) * (x1 - x0)) - ((x3 - x2) * (y1 - y0))
245             Dim nume_a As Double = ((x3 - x2) * (y0 - y2)) - ((y3 - y2) * (x0 - x2))
246             Dim nume_b As Double = ((x1 - x0) * (y0 - y2)) - ((y1 - y0) * (x0 - x2))
247
248             Dim ua As Double = nume_a / denom
249             Dim ub As Double = nume_b / denom
250
251             If ua >= 0.0 AndAlso ua <= 1.0 AndAlso ub >= 0.0 AndAlso ub <= 1.0 Then
252                 Get the intersection point
253                 Dim intersectionX As Double = x0 + ua * (x1 - x0)
254                 Dim intersectionY As Double = y0 + ua * (y1 - y0)
255
256                 Return New mxPoint(intersectionX, intersectionY)
257             End If
258
259             ' No intersection
260             Return Nothing
261         End Function
262
263         ''' <summary>
264         ''' Returns the bounds as a new rectangle.
265         ''' </summary>
266         ''' <returns> Returns a new rectangle for the bounds. </returns>
267         Public Overridable ReadOnly Property Rectangle As RectangleF
268             Get
269                 Dim ix As Integer = CInt(Fix(sys.Round(X)))
270                 Dim iy As Integer = CInt(Fix(sys.Round(Y)))
271                 Dim iw As Integer = CInt(Fix(sys.Round(Width - ix + X)))
272                 Dim ih As Integer = CInt(Fix(sys.Round(Height - iy + Y)))
273
274                 Return New RectangleF(ix, iy, iw, ih)
275             End Get
276         End Property
277
278         ''' 
279         ''' <summary>
280         ''' Returns true if the given object equals this rectangle.
281         ''' </summary>
282         Public Overrides Function Equals(ByVal obj As ObjectAs Boolean
283             If TypeOf obj Is DblRect Then
284                 Dim ___rect As DblRect = CType(obj, DblRect)
285
286                 Return ___rect.X = X AndAlso ___rect.Y = Y AndAlso ___rect.Width = Width AndAlso ___rect.Height = Height
287             End If
288
289             Return False
290         End Function
291
292         ''' <summary>
293         ''' Returns a new instance of the same rectangle.
294         ''' </summary>
295         Public Overrides Function Clone() As Object
296             Dim ___clone As DblRect = CType(MyBase.Clone(), DblRect)
297
298             ___clone.Width = Width
299             ___clone.Height = Height
300
301             Return ___clone
302         End Function
303
304         ''' <summary>
305         ''' Returns the <code>String</code> representation of this
306         ''' <code>mxRectangle</code>. </summary>
307         ''' <returns> a <code>String</code> representing this
308         ''' <code>mxRectangle</code>. </returns>
309         Public Overrides Function ToString() As String
310             Return Me.GetType().Name & "[x=" & X & ",y=" & Y & ",w=" & width & ",h=" & height & "]"
311         End Function
312     End Class
313 End Namespace