只能畫點的座標繪圖系統

引入: 自定義

 

電腦真是很麻煩的東西，因為她所認知的Y 座標與我們相反。為此，我們建構了一個型別，該型別包含一個不可更動的畫布，並且以執行個體的方式出現。初始化New 的參數為(座標名稱, 整體色彩, 繪圖物件)。其中座標名稱為一個陣列，第一個字元用來當橫軸的名稱，第二個字元用來當縱軸的名稱。

]Dim test As New Coordinate("XY", Color.Black, testPictureBox)

 

要設定該座標的顏色可以在X、Y 屬性裡找到。其中屬性Name 用來設置該軸的名稱，為單一字元。屬性NameColor 為Brush 型別，用來描述描繪該名稱時使用的顏色。屬性AxisColor 設定該軸直線的顏色。Length 屬性請勿更動，這是用來設置該繪圖物件的長或寬。

]MsgBox(test.X.Name) //MsgBox 裡顯示"X"。

]test.Y.NameColor = Brushes.Blue //將縱軸名稱的顏色改成藍色。

]test.Y.AxisColor = Color.Red //將縱軸直線的顏色改成紅色。

 

新增座標點使用函式Push(點)，刪除點使用函式Kill(點)。如果要自行設定中心點可以對Center 做修改。

]test.Push(New Point(1, 2))

]test.Kill(New Point(1, 2))

]test.Center = New Point(test.Center.X * 2, test.Center.Y * 2)

 

要把執行個體內存的「人所認識的資料」轉換成「電腦所了解的資料」使用函式AutoSet，這也是這個型別最重要的部份。開始繪圖使用函式Draw(座標點顏色)。

]test.AutoSet()

]test.Draw(Color.Blue)

 

最後是這個函式的原始碼，其中常數NameSiteMovement 用來設置座標名稱顯示位置，預設值為0.95。

]Structure Coordinate

]Dim Graphic As Graphics

]Dim X As Settings

]Dim Y As Settings

]Dim Points As Point()

]Dim RealPoints As Point()

]

]Const NameSiteMovement = 0.95

]

]Function IndexOf(ByVal ThePoint) As Integer

]If (Points Is Nothing) Then

]Return -1

]End If

]For i1 As Integer = LBound(Points) To UBound(Points) Step 1

]If (Points(i1) = ThePoint) Then

]Return i1

]End If

]Next

]Return -1

]End Function

]

]Function RealPoint(ByVal ThePoint As Point) As Point

]Return New Point(ThePoint.X, Y.Length - ThePoint.Y)

]End Function

]

]Function Draw(ByVal PointColor As Color, Optional ByVal NameSize As Integer = 9, Optional ByVal Width As Integer) As Boolean

]If (RealPoints Is Nothing) Then

]Return False

]End If

]With Graphic

].DrawLine(ArrowPen(X.AxisColor), New Point(0, Center.Y), New Point(X.Length, Center.Y))

].DrawLine(ArrowPen(Y.AxisColor), New Point(Center.X, Y.Length), New Point(Center.X, 0))

].DrawString(X.Name, New Font("微軟正黑體", NameSize), X.NameColor, X.Length * NameSiteMovement, Center.Y)

].DrawString(Y.Name, New Font("微軟正黑體", NameSize), Y.NameColor, Center.X, 0 * NameSiteMovement)

]For Each This In RealPoints

].DrawEllipse(New Pen(PointColor), CInt(This.X - (Width / 2)), CInt(This.Y - (Width / 2)), CInt(Width), CInt(Width))

]Next

]End With

]Return True

]End Function

]

]Sub New(ByVal Names As String, ByVal AllColor As Color, ByVal MainObject As System.Object)

]With X

].Name = KnownIndex(Names, 0)

].NameColor = Brushes.Black

].AxisColor = AllColor

].Length = MainObject.Size.Width

]End With

]With Y

].Name = KnownIndex(Names, 1)

].NameColor = Brushes.Black

].AxisColor = AllColor

].Length = MainObject.Size.Height

]End With

]Graphic = MainObject.CreateGraphics

]Center = New Point(X.Length / 2, Y.Length / 2)

]End Sub

]

]Sub Push(ByVal NewPoint As Point)

]If Not (IndexOf(NewPoint) = -1) Then

]Exit Sub

]End If

]If (Points Is Nothing) Then

]ReDim Points(0)

]Else

]ReDim Points(UBound(Points) + 1)

]End If

]Points(UBound(Points)) = NewPoint

]End Sub

]

]Sub Kill(ByVal ThePoint As Point)

]If (IndexOf(ThePoint) = -1) Then

]Exit Sub

]End If

]For i1 As Integer = IndexOf(ThePoint) To UBound(Points) - 1 Step 1

]Points(i1) = Points(i1 + 1)

]Next

]ReDim Preserve Points(UBound(Points) - 1)

]End Sub

]

]Sub AutoSet(Optional ByVal Movement As Integer = 1)

]With X

].Up += Movement

].Down -= Movement

]If Not (.Up > 0) Then

].Up = 0 + Movement

]End If

]If Not (.Down < 0) Then

].Down = 0 - Movement

]End If

].Pixel = .Length / (.Up - .Down)

]End With

]With Y

].Up += Movement

].Down -= Movement

]If Not (.Up > 0) Then

].Up = 0 + Movement

]End If

]If Not (.Down < 0) Then

].Down = 0 - Movement

]End If

].Pixel = .Length / (.Up - .Down)

]End With

]Center = RealPoint(New Point((0 - X.Down) / (X.Up - X.Down) * X.Length, (0 - Y.Down) / (Y.Up - Y.Down) * Y.Length))

]RealPoints = Points

]For i1 As Integer = LBound(RealPoints) To UBound(RealPoints) Step 1

]RealPoints(i1) = RealPoint(New Point(RealPoints(i1).X * X.Pixel, RealPoints(i1).Y * Y.Pixel))

]RealPoints(i1) = New Point(RealPoints(i1).X + Center.X, RealPoints(i1).Y - (Y.Length - Center.Y))

]Next

]End Sub

]

]Structure Settings

]Dim Name As Char

]Dim NameColor As Brush

]Dim AxisColor As Color

]Dim Length As Integer

]Dim Up As Integer

]Dim Down As Integer

]End Structure

]End Structure

 

這裡說明一下ArrowPen 這個自定義函式，目的是簡短程式碼的，用來取得一個可畫箭頭的Pen 型別個體。

]Function ArrowPen(ByVal TheColor As Color) As Pen

]ArrowPen = New Pen(TheColor)

]ArrowPen.StartCap = Drawing2D.LineCap.Flat

]ArrowPen.EndCap = Drawing2D.LineCap.ArrowAnchor

]Return ArrowPen

]End Function