Intermediate
Date of registration: Jan 1st 2009
Location: Hanover, Germany
Occupation: Software Engineer
Hobbies: Hilbert Curves
Intermediate
Date of registration: Jan 1st 2009
Location: Hanover, Germany
Occupation: Software Engineer
Hobbies: Hilbert Curves
Intermediate
Date of registration: Jan 1st 2009
Location: Hanover, Germany
Occupation: Software Engineer
Hobbies: Hilbert Curves
Intermediate
Date of registration: Jan 1st 2009
Location: Hanover, Germany
Occupation: Software Engineer
Hobbies: Hilbert Curves
Intermediate
Date of registration: Jan 1st 2009
Location: Hanover, Germany
Occupation: Software Engineer
Hobbies: Hilbert Curves
Jabaco Source |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 |
Option Explicit Private Sub drawAll Dim mx As Integer Dim my As Integer Dim r As Integer Dim p As PictureBox = Picture1 Dim red As Long = RGB(255, 0, 0) Dim yellow As Long = RGB(255, 255, 0) Dim g As Graphics2D = p.getGraphics() Dim phi = 60 g.setRenderingHint(java#awt#RenderingHints.KEY_ANTIALIASING, _ java#awt#RenderingHints.VALUE_ANTIALIAS_ON) mx = p.Width / 2 my = p.Height / 2 r = CInt(0.9 * p.Width / 2) p.Circle(mx - r, my - r, 2*r, 2*r, red) g.setColor(Color.blue) g.fillArc(mx - r, my - r, 2*r, 2*r, -phi - 90, +2*phi) g.setColor(Color.green) g.fillArc(mx - r, my - r, 2*r, 2*r, +phi - 90, +2*phi) g.setColor(Color.red) g.fillArc(mx - r, my - r, 2*r, 2*r, 3*phi - 90, +2*phi) p.Line(mx - 3, my - 3, mx + 3, my + 3, True, yellow) End Sub Private Sub fillTriangle(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, fillColor As color) Dim poly As Polygon Dim g As Graphics2D g = Picture1.getGraphics() poly = New Polygon g.setColor(fillColor) poly.addPoint(x1, y1) poly.addPoint(x2, y2) poly.addPoint(x3, y3) g.fillPolygon(poly) End Sub Private Function isInTriangle(x As Integer, y As Integer, cx() As Integer, cy() As Integer) As Boolean Dim poly As Polygon = New Polygon Dim i As Integer For i = 1 To 3 poly.addPoint cx(i), cy(i) Next i isInTriangle = poly.inside(x, y) End Function Public Sub Form_Load() Picture1.Width = Picture1.Height drawAll End Sub Private Sub trace(msg As String) Label1.Caption = msg End Sub Public Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim p As PictureBox = Picture1 Dim yellow As Long = RGB(255, 255, 0) Dim mx As Integer Dim my As Integer Dim r As Integer Dim cx(1 To 3) As Integer Dim cy(1 To 3) As Integer Dim i As Integer Dim iFarest As Integer Dim phi = 60 mx = p.Width / 2 my = p.Height / 2 r = CInt(0.9 * p.Width / 2) trace "X=" & X & " Y=" & Y & " Button=" & Button & " Shift=" & Shift If Button <> 0 Then If (X - mx)*(X - mx) + (Y - my)*(Y - mx) < (r - 3)^2 Then iFarest = 1 For i = 1 To 3 cx(i) = mx + (i - 2) * (3 ^ 0.5) * r/2 cy(i) = my + IIF(i = 2, -2, 1) * r/2 If (cx(i) - X)^2 + (cy(i) - Y)^2 > (cx(iFarest) - X)^2 + (cy(iFarest) - Y)^2 Then ' remember index of farest corner iFarest = i End If Next i drawAll If isInTriangle(X, Y, cx, cy) Then ' we are within the big triangle; no need to suppress a sub-triangle iFarest = 0 End If If iFarest <> 3 Then fillTriangle(cx(1), cy(1), cx(2), cy(2), X, Y, Color.red) End If If iFarest <> 1 Then fillTriangle(cx(2), cy(2), cx(3), cy(3), X, Y, Color.green) End If If iFarest <> 2 Then fillTriangle(cx(1), cy(1), cx(3), cy(3), X, Y, Color.blue) End If p.Line(X - 3, Y - 3, X + 3, Y + 3, True, yellow) End If End If End Sub |
Jabaco Source |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 |
Option Explicit Import java#lang#Math Import java#awt#color Dim myMouseX As Single Dim myMouseY As Single Dim myRadius As Single Dim myColor1 As Color = Color.red Dim myColor2 As Color = Color.green Dim myColor3 As Color = Color.blue Dim a As Double = 120 'angle in grad Dim s As Double = 90 'startangle in grad Dim ra As Double = toRadians(a) 'angle in rad Public Sub Form_Load() myMouseX = Me.ScaleWidth / 2 myMouseY = Me.ScaleHeight / 2 End Sub Public Sub Form_Resize() myRadius = min(Me.ScaleWidth, Me.ScaleHeight) / 2 myMouseX = myRadius myMouseY = myRadius End Sub Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = vbLeftButton Then myMouseX = X myMouseY = Y Me.Refresh End If End Sub Public Sub Form_Paint(g As Graphics) g.setColor(myColor1) g.fillArc(0, 0, myRadius*2, myRadius*2, s, a) g.setColor(myColor2) g.fillArc(0, 0, myRadius*2, myRadius*2, s + a, a) g.setColor(myColor3) g.fillArc(0, 0, myRadius*2, myRadius*2, s + 2 * a, a) 'we decide which part we got to draw first Dim y As Double = -(myMouseY - myRadius) Dim x As Double = myMouseX - myRadius Dim at As Double = atan2(y, x) 'delivers angles above PI as negative :( If at < 0 Then at = 2*PI + at 'Debug.Print at Select Case True Case IsInT1(at): DrawPolygon1(g): DrawPolygon2(g): DrawPolygon3(g) Case IsInT2(at): DrawPolygon2(g): DrawPolygon3(g): DrawPolygon1(g) Case IsInT3(at): DrawPolygon3(g): DrawPolygon1(g): DrawPolygon2(g) End Select End Sub Function IsInT1(at As Double) As Boolean If (PI/2 <= at) And (at < (PI + 1/6*PI)) Then IsInT1 = True End Function Function IsInT2(at As Double) As Boolean If ((PI + 1/6*PI) <= at) And (at < (PI + 5/6*PI)) Then IsInT2 = True End Function Function IsInT3(at As Double) As Boolean If (((PI + 5/6*PI) <= at) And (at < 2*PI)) Or _ ((0 <= at) And (at < PI/2)) Then IsInT3 = True End Function Sub DrawPolygon1(g As Graphics) g.setColor(myColor1) Dim p1 As New Polygon p1.addPoint(myRadius, 0) p1.addPoint(myMouseX, myMouseY) p1.addPoint(myRadius - myRadius*Sin(ra), myRadius - myRadius*Cos(ra)) g.fillPolygon(p1) End Sub Sub DrawPolygon2(g As Graphics) g.setColor(myColor2) Dim p2 As New Polygon p2.addPoint(myRadius - myRadius*Sin(ra), myRadius - myRadius*Cos(ra)) p2.addPoint(myMouseX, myMouseY) p2.addPoint(myRadius + myRadius*Sin(ra), myRadius - myRadius*Cos(ra)) g.fillPolygon(p2) End Sub Sub DrawPolygon3(g As Graphics) g.setColor(myColor3) Dim p3 As New Polygon p3.addPoint(myRadius + myRadius*Sin(ra), myRadius - myRadius*Cos(ra)) p3.addPoint(myMouseX, myMouseY) p3.addPoint(myRadius, 0) g.fillPolygon(p3) End Sub |