vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#

http://www.vbarchiv.net
Rubrik: Grafik und Font · Grafische Effekte   |   VB-Versionen: VB2005 - VB201519.07.17
Point_nEck mit/ohne runde Ecken

Ein kleines Beispiel, das zeigt, wie man zufällig eine Figur mit/ohne runde Ecken erzeugen kann.

Autor:   Bertram KeilhackBewertung:  Views:  902 
ohne HomepageSystem:  Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Ein kleines Beispiel, das zeigt, wie man zufällig eine Figur mit/ohne runde Ecken erzeugen kann.

Erstellen Sie ein neues Windows-Forms Projekt und fügen nachfolgenden Code ein:

Imports System.Drawing.Drawing2D
 
Public Class Form1
Private Sub Form1_Load(ByVal sender As Object, _
  ByVal e As System.EventArgs) Handles Me.Load
 
  With Me
    .Width = 500
    .Height = 500
    .BackColor = Color.Black
    .Text = "Click mit der Mouse"
  End With
End Sub
Private Sub Form1_MouseClick(ByVal sender As Object, _
  ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseClick
 
  Me.Refresh()
End Sub
Private Sub Form1_Paint(ByVal sender As Object, _
    ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
 
  Dim po() As PointF = po_point(400), pa As GraphicsPath = po_path(po, 20)
  With e.Graphics
    .ResetTransform()
    .TranslateTransform(50, 50)
    .SmoothingMode = SmoothingMode.HighQuality
    .FillPath(Brushes.Blue, pa)
    .DrawPath(Pens.Yellow, pa)
  End With
  Erase po 
  pa.Dispose() 
  pa = Nothing
End Sub
' *** Point_nEck > PointF zufällig erzeugen
Function po_point(ByVal x As UShort) As PointF()
  Dim r As New Random(), p(r.Next(0, 10)) As PointF
  For i As Integer = 0 To UBound(p)
    p(i).X = x * r.NextDouble
    p(i).Y = x * r.NextDouble
  Next
  Return p
End Function
' *** Point_nEck > GraphicsPath erzeugen
Function po_path(ByVal po() As PointF, ByVal radius As UShort) As GraphicsPath
  Dim p As New GraphicsPath, i, j, u As UShort
  If po.Length Then u = UBound(po) Else Return p
 
  Dim c(u, 1), x, y, r, w, a, s, d As Single
  d = Math.PI / 180
  For i = 0 To u
    j = IIf(i = 0, u, i - 1)
    r = radius
    If i = 0 Then
      x = po(i).X - po(j).X
      y = po(i).Y - po(j).Y
      c(j, 0) = wi(Math.Atan2(y, x) / d)
      c(j, 1) = Math.Sqrt(x * x + y * y)
    End If
    If i < u Then
      x = po(i + 1).X - po(i).X
      y = po(i + 1).Y - po(i).Y
      c(i, 0) = wi(Math.Atan2(y, x) / d)
      c(i, 1) = Math.Sqrt(x * x + y * y)
    End If
 
    Select Case u
      Case 0
        a = 0
        s = 360
        x = po(i).X - r
        y = po(i).Y - r
 
      Case 1
        w = c(i, 0)
        a = wi(w + 90)
        s = 180
        x = c(i, 1) / 2
        If r > x Then r = x
        x = po(i).X - r * (1 - Math.Cos(w * d))
        y = po(i).Y - r * (1 - Math.Sin(w * d))
 
      Case Else
        w = wi(c(j, 0) - 180 - c(i, 0))
        If w = 0 Or w = 180 Then r = 0
        If r > 0 Then
          If w < 180 Then
            x = 1
          Else
            x = -1
            w = 360 - w
          End If
          a = wi(c(j, 0) - x * 90)
          s = x * wi(180 - w)
          y = Math.Tan(w / 2 * d)
          x = Math.Min(c(i, 1), c(j, 1)) / 2
          If r / y > x Then r = x * y
          x = po(i).X - r * (Math.Cos(c(j, 0) * d) / y + Math.Cos(a * d) + 1)
          y = po(i).Y - r * (Math.Sin(c(j, 0) * d) / y + Math.Sin(a * d) + 1)
        End If
    End Select
    If r < 0.01 Then
      p.AddLine(po(i), po(i))
    Else
      p.AddArc(x, y, 2 * r, 2 * r, a, s)
    End If
  Next
  p.CloseFigure()
  Erase c
  Return p
End Function
' *** beliebigen +/- Winkel > 0..360 Grad
Function wi(ByVal winkel As Single) As Single
  Return winkel - Math.Floor(winkel / 360) * 360
End Function
End Class



Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
 
Copyright ©2000-2017 vb@rchiv Dieter OtterAlle Rechte vorbehalten.


Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.