CAD Grundgerüst

    • VB.NET

    Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von Loopy.

      CAD Grundgerüst

      hallo,

      ich hab mich mal hingesetzt und versucht ein cad grundgerüst (ein anderer name fällt mir nicht ein) gebastelt.
      den anstoss dazu hat mir loopy
      gegeben.
      zumindest habe ich das so verstanden.

      hier also der code - ihr braucht dazu zwei button

      VB.NET-Quellcode

      1. Public Class Form1
      3. Private mypos As New List(Of Rectangle) 'alle positionen als client koordinaten
      5. Private drawpic As Boolean
      6. Private drawline As Boolean
      7. Private findpic As Boolean
      9. Private lastpos As Point
      10. Private startline As Point
      12. Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
      13. Me.Button1.Text = "Bilder positionieren"
      14. Me.Button2.Text = "Linien zeichnen"
      15. End Sub
      17. Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
      18. drawpic = True
      19. Me.Text = "Bild positionieren"
      20. End Sub
      22. Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
      23. findpic = True
      24. Me.Text = "Legen Sie jetzt fest bei welchem Bild die Linie beginnen soll."
      25. End Sub
      27. Private Sub Form1_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseClick
      28. 'hier das gewählte bild zeichnen
      29. If drawpic = True Then
      30. drawpic = False
      31. 'position speichern
      32. mypos.Add(New Rectangle(e.Location, New Size(30, 30)))
      33. 'alten frame löschen
      34. DrawRFrame(Me.RectangleToScreen(New Rectangle(e.Location, New Size(30, 30))), True)
      35. 'frame fest zeichnen
      36. Graphics.FromHwnd(Me.Handle).DrawRectangle(New Pen(Color.Black, 2), mypos(mypos.Count - 1))
      37. End If
      38. 'hier die linie zeichnen beenden
      39. If drawline = True Then
      40. drawline = False
      41. 'linie wieder entfernen
      42. DrawRLine(Me.PointToScreen(startline), Me.PointToScreen(lastpos))
      43. 'prüfen ob sich die maus wirklich über einem bild befindet
      44. find_pos_arg = e.Location
      45. Dim p As Integer = mypos.FindIndex(AddressOf find_pos)
      46. 'linie zeichnen anstossen
      47. If p <> -1 Then
      48. 'linie fest zeichnen
      49. Graphics.FromHwnd(Me.Handle).DrawLine(New Pen(Color.Black, 2), startline, lastpos)
      50. Me.Text = "Weiter so !"
      51. Else
      52. MessageBox.Show("Sie haben nicht über einem Bild geklickt !")
      53. End If
      54. End If
      55. 'hier prüfen, ob die maus sich über einem gezeichneten rectangle befindet
      56. If findpic = True Then
      57. find_pos_arg = e.Location
      58. Dim p As Integer = mypos.FindIndex(AddressOf find_pos)
      59. 'linie zeichnen anstossen
      60. If p <> -1 Then
      61. drawline = True
      62. startline = mypos(p).Location
      63. lastpos = mypos(p).Location
      64. DrawRLine(Me.PointToScreen(startline), Me.PointToScreen(lastpos))
      65. Me.Text = "Legen Sie jetzt das Bild fest, an welchem die Linie enden soll."
      66. End If
      67. End If
      68. findpic = False
      69. End Sub
      70. Private Sub Form1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
      71. If drawpic = True Then
      72. 'reversible frame zeichnen - bildschirmkoordinaten
      73. DrawRFrame(Me.RectangleToScreen(New Rectangle(e.X, e.Y, 30, 30)))
      74. End If
      75. If drawline = True Then
      76. lastpos = e.Location
      77. 'reversible line zeichnen - bildschirmkoordinaten
      78. DrawRLine(Me.PointToScreen(startline), Me.PointToScreen(lastpos))
      79. End If
      80. End Sub
      81. #Region "Draw Reversible Frame and Line"
      82. Private Sub DrawRFrame(ByVal newR As Rectangle, Optional ByVal cl As Boolean = False)
      83. 'die werte hier müssen in bildschrimkoordinaten angegeben werden
      84. Static oldR As Rectangle
      85. 'alten frame löschen
      86. ControlPaint.DrawReversibleFrame(oldR, Color.Black, FrameStyle.Dashed)
      87. 'neuen frame zeichnen - wenn nicht übermalt werden soll
      88. If cl = False Then
      89. ControlPaint.DrawReversibleFrame(newR, Color.Black, FrameStyle.Dashed)
      90. 'zum übermalen merken
      91. oldR = newR
      92. End If
      93. End Sub
      95. Private Sub DrawRLine(ByVal startL As Point, ByVal endL As Point)
      96. 'die werte hier müssen in bildschrimkoordinaten angegeben werden
      97. Static oldL As Point
      98. 'alte linie löschen - wenn nicht beide punkte gleich sind
      99. If startL <> endL Then
      100. ControlPaint.DrawReversibleLine(startL, oldL, Color.Black)
      101. End If
      102. 'neue linie zeichnen
      103. ControlPaint.DrawReversibleLine(startL, endL, Color.Black)
      104. 'zum übermalen merken
      105. oldL = endL
      106. End Sub
      107. #End Region
      108. #Region "suchen und finden"
      109. Private find_pos_arg As Point
      110. Private Function find_pos(ByVal r As Rectangle) As Boolean
      111. If r.X < find_pos_arg.X And r.Right > find_pos_arg.X And _
      112. r.Y < find_pos_arg.Y And r.Bottom > find_pos_arg.Y Then
      113. Return True
      114. Else
      115. Return False
      116. End If
      117. End Function
      118. #End Region
      119. End Class

      kommentare erwünscht

      gruss

      mikeb69

    Facebook
    Telefonspende